Test2.hs

{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies  #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE AllowAmbiguousTypes  #-}

module Test2 where

data Proxy a = Proxy

data Query s a = Query [String]

data Table a = Table [String]

data Col s a = C String

type family Cols s a where
  Cols () (a :*: b) = Col () a :*: Cols Bool b
  Cols s (a :*: b) = Col s a :*: Cols s b
  Cols s a = Col s a

data a :*: b = a :*: b deriving Show

infixr :*:

class Result r where
  type Res r
  toRes :: Proxy r -> [String] -> Res r

class Columns a where
  toTup :: [String] -> a
  fromTup :: a -> [String]

instance Columns b => Columns (Col s a :*: b) where
  toTup (x:xs) = C x :*: toTup xs
  toTup _ = error "Too few elements to toTup"
  fromTup (C x :*: xs) = x : fromTup xs

instance Columns (Col s a) where
  toTup [x] = C x
  toTup [] = error "Too few elements to toTup"

  fromTup (C x) = [x]

data Var a = Var String deriving Show

instance Result b => Result (Col s a :*: b) where
  type Res (Col s a :*: b) = Var a :*: Res b
  toRes _ (s:ss) = Var s :*: toRes (Proxy :: Proxy b) ss

instance Result (Col s a) where
  type Res (Col s a) = Var a
  toRes _ [s] = Var s

select :: Columns (Cols s a) => Table a -> Query s (Cols s a)
select (Table as) = Query as

query :: forall a s. Result a => Query s a -> Res a
query (Query as) = toRes (Proxy :: Proxy a) as



--list
--  :: (Result (Cols s a), Columns (Cols s a)) =>
--     Table a -> Res (Cols s a)
list table = query (select table)

categories :: Table (String :*: Int :*: Bool)
categories = Table ["foo", "bar", "baz"]

strange = list categories