Skip to content

Instantly share code, notes, and snippets.

@tomjaguarpaw
Created April 23, 2018 16:30
Show Gist options
  • Save tomjaguarpaw/f4db46671e2f39b790a25b8907dc53a3 to your computer and use it in GitHub Desktop.
Save tomjaguarpaw/f4db46671e2f39b790a25b8907dc53a3 to your computer and use it in GitHub Desktop.
{-# 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment