Created
November 13, 2016 23:26
-
-
Save FrigoEU/7454917fe03cad0f59fe6af674405494 to your computer and use it in GitHub Desktop.
Fun Deps for SQL
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| module Lovefield where | |
| import Data.Array (snoc) | |
| import Data.Foreign (Foreign) | |
| import Data.Lens (Lens, lens) | |
| import Data.Tuple (Tuple(..)) | |
| import Prelude (class Show, show, (#), ($), (<>), (>>>)) | |
| -- Your implementation of polymorphic labels starts here | |
| data Label (l :: Symbol) = Label | |
| class HasField l s t a b | l s -> a, l b -> t where | |
| field :: Label l -> Lens s t a b | |
| data HNil = HNil | |
| data HCons (l :: Symbol) head tail = HCons head tail | |
| instance showHNil :: Show HNil where | |
| show _ = "HNil" | |
| instance showHCons :: (Show a, Show b) => Show (HCons l a b) where | |
| show (HCons a b) = "(HCons " <> show a <> " " <> show b <> ")" | |
| cons :: forall l a b. Label l -> a -> b -> HCons l a b | |
| cons _ = HCons | |
| infix 4 cons as := | |
| head :: forall l a b c. Lens (HCons l a b) (HCons l c b) a c | |
| head = lens (\(HCons h _) -> h) \(HCons _ t) h -> HCons h t | |
| tail :: forall l a b c. Lens (HCons l a b) (HCons l a c) b c | |
| tail = lens (\(HCons _ t) -> t) \(HCons h _) t -> HCons h t | |
| instance hasFieldHead :: HasField l (HCons l head1 tail) (HCons l head2 tail) head1 head2 where | |
| field _ = head | |
| instance hasFieldTail :: HasField l s t a b => HasField l (HCons l1 head s) (HCons l1 head t) a b where | |
| field l = field l >>> tail | |
| -- Your implementation of polymorphic labels ends here | |
| -- Tables & Columns | |
| data Table a = Table String | |
| data Column a = Column | |
| newtype TableName = TableName String | |
| newtype ColumnName = ColumnName String | |
| newtype Operator = Operator String | |
| -- Side note: Is there a better way to do this? | |
| class KnownLabel (l :: Symbol) where reifyLabel :: Label l -> String | |
| instance knownLabelId :: KnownLabel "id" where reifyLabel l = "id" | |
| instance knownLabelPrice :: KnownLabel "price" where reifyLabel l = "price" | |
| -- An example table | |
| products :: Table (HCons "id" (Column Int) | |
| (HCons "price" (Column Int) | |
| HNil)) | |
| products = Table "products" | |
| -- project / select | |
| -- the Select type is a big datastructure that we build up, and make a SQL query out of | |
| -- in the type parameter I want to track what columns will come out when the query is executed | |
| -- This way of building up a query is a bit cluncky, but I don't know how to do it when passing | |
| -- eg. an array of Labels | |
| project :: forall cols cols' col col' l a. (HasField l cols cols' col col', KnownLabel l) => | |
| Table cols -> (Label l) -> Select a -> Select (HCons l col a) | |
| project (Table tn) l (Select s) = | |
| Select $ s {projections = snoc s.projections (Tuple (TableName tn) (ColumnName (reifyLabel l)))} | |
| emptySelect :: Select HNil | |
| emptySelect = Select {projections: [], predicates: [], joins: []} | |
| selectAll :: Select (HCons "price" (Column Int) | |
| (HCons "id" (Column Int) | |
| HNil)) | |
| selectAll = project products (Label :: Label "id") emptySelect # | |
| project products (Label :: Label "price") | |
| -- THE BIG QUESTION: | |
| -- Now how can I write an "execute" function, that would have as type for (execute selectAll :: Aff e {price :: Int, id :: Int})? | |
| -- Extra: this is the type of a Select query, it's quite easy to make a valid | |
| -- Lovefield query from this. It's probably quite naive, but works for now | |
| newtype Select a = Select { projections :: Array (Tuple TableName ColumnName) | |
| , predicates :: Array { op :: Operator | |
| , tn :: TableName | |
| , cn :: ColumnName | |
| , v :: Foreign} | |
| , joins :: Array { op :: Operator | |
| , tn1 :: TableName | |
| , cn1 :: ColumnName | |
| , tn2 :: TableName | |
| , cn2 :: ColumnName} | |
| } |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment