Type-safe SQL select queries

safesql.hs

{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ConstraintKinds #-}

module Main where

import GHC.Exts
import GHC.TypeLits

data HasColumn = HasColumn | NoSuchColumn

type family Elem (x :: k) (xs :: [k]) :: Constraint
type instance Elem x xs = (Elem' x xs ~ 'HasColumn)

type family Elem' (x :: k) (xs :: [k]) :: HasColumn where
    Elem' x '[] = NoSuchColumn
    Elem' x (x ': xs) = 'HasColumn
    Elem' x (y ': xs) = Elem' x xs

data Column (name :: Symbol) :: * where
    Column :: Column name

data Table (name :: Symbol) (columns :: [Symbol]) :: * where
    Table :: Table name columns

data Query where
    Select :: Elem c cs => Table n cs -> Column c -> Query

select :: Elem c cs => Table n cs -> Column c -> Query
select = Select

firstName :: Column "first_name"
lastName :: Column "last_name"
(firstName, lastName) = (Column, Column)

type Users = Table "users" ["first_name", "last_name"]
users = Table :: Users

goodQuery :: Query
goodQuery = select users firstName

email :: Column "email"
email = Column

badQuery :: Query
badQuery = select users email

main :: IO ()
main = return ()