Commit 6b385bdc authored by MrMan's avatar MrMan

Compiles, with nothing undefined.... What have I done

parent 722f3103
......@@ -18,6 +18,7 @@ module Components.EntityStore.SQLite
(SQLiteEntityStore)
where
import Control.Monad (ap)
import Data.Proxy (Proxy)
import Control.Applicative((<|>))
import Components.EntityStore.Migrations.SQLite (migrations)
......@@ -285,27 +286,37 @@ makeGenericIdent (WUUID uuid v) = WID (Left uuid) v
instance Insertable 'SQL (Complete (Task state)) where
getInsertInfo = SQLEII (TN "tasks") (SQLCN ["something"]) (SQLVG [])
instance forall (ident :: Identifier) e. Insertable 'SQL e => Insertable 'SQL (WithID ident e) where
-- | Generate insertion information for an element with an ID on it by prepending the id column
getInsertInfo = SQLEII (TN "") (SQLCN []) (SQLVG [])
-- TODO: FIX
-- getInsertInfo = SQLEII tbl colsWithId vgs
-- where
-- (SQLEII tbl (SQLCN cols) vgs) = (getInsertInfo :: EntityInsertInfo 'SQL e)
-- colsWithId = SQLCN $ ["uuid"] ++ cols -- TODO: how do we know whether it's id or uuid?
-- | If some value e is Insertable in the SQL paradigm, then the same value with a UUID is insertable
-- All we do is ensure the columns include a "uuid" column at the beginning
instance forall e. Insertable 'SQL e => Insertable 'SQL (WithID 'UUIDID e) where
-- | Generate insertion information for an element with an ID on it by prepending the id column
getInsertInfo = SQLEII tbl cols' (SQLVG [])
where
(SQLEII tbl (SQLCN cols) _ ) = (getInsertInfo :: EntityInsertInfo 'SQL e)
cols' = SQLCN $ ["uuid"] ++ cols
-- | If some value e is insertable in the SQL paradigm, then the same value with an ID is insertable
-- All we do is ensure teh columns include an "id" at the beginning
instance forall e. Insertable 'SQL e => Insertable 'SQL (WithID 'INT64ID e) where
-- | Generate insertion information for an element with an ID on it by prepending the id column
getInsertInfo = SQLEII tbl cols' (SQLVG [])
where
(SQLEII tbl (SQLCN cols) _ ) = (getInsertInfo :: EntityInsertInfo 'SQL e)
cols' = SQLCN $ ["id"] ++ cols
instance forall (ident :: Identifier) e. Insertable 'SQL (WithID ident e) => Insertable 'SQL (Proxy (WithID ident e)) where
getInsertInfo = SQLEII (TN "") (SQLCN []) (SQLVG [])
-- TODO: FIX
-- getInsertInfo = (getInsertInfo :: EntityInsertInfo 'SQL (WithID e))
-- | If we know how to insert some type e in the SQL paradigm, we know how to insert it's proxy
-- This enables us to get the insert info for any type despite not having an instance of it
instance forall (ident :: Identifier) e. Insertable 'SQL e => Insertable 'SQL (Proxy e) where
getInsertInfo = SQLEII tbl cols (SQLVG [])
where
(SQLEII tbl cols _ ) = (getInsertInfo :: EntityInsertInfo 'SQL e)
data QueryWithParams = QWP Query [NamedParam]
data QueryWithParams = QWP Query [SQLData]
buildInsertQuery :: forall (ident :: Identifier) entity.
(Insertable 'SQL (WithID ident (Complete entity)),
Insertable 'SQL (Complete entity))
-- | Build the insertion SQL query for a given entity with it's ID
buildInsertQuery :: forall (ident :: Identifier) (entity :: FBounded). -- | polymorphic over entities and identifiers (uuid/int64)
Insertable 'SQL (WithID ident (Complete entity)) -- | entity must be insertable under SQL & complete w/ an ID
=> WithID ident (Complete entity)
-> Maybe QueryWithParams
buildInsertQuery e = case (getInsertInfo :: EntityInsertInfo 'SQL (WithID ident (Complete entity))) of
......@@ -316,9 +327,9 @@ makeInsertQuery :: Insertable 'SQL entity => TableName -> SQLColumnNames -> SQLV
makeInsertQuery (TN tbl) (SQLCN colNames) (SQLVG valueGetters) entity = QWP insertQuery params
where
insertQuery = Query $ [text| INSERT INTO $tbl ( $columnPhrase ) VALUES ( $valueQs ) |]
columnPhrase = undefined
valueQs = undefined
params = undefined
columnPhrase = DT.intercalate "," colNames
valueQs = DT.intercalate "," $ take (length colNames) $ repeat "?"
params = valueGetters `ap` [entity]
insertEntity :: forall (ident :: Identifier) entity.
(Insertable 'SQL (WithID ident (Complete entity)),
......@@ -329,7 +340,7 @@ insertEntity :: forall (ident :: Identifier) entity.
insertEntity conn (WINT64 _ _) = pure $ Left $ UnexpectedErrorES "entities must be UUID-identified"
insertEntity conn e@(WUUID uuid _) = case buildInsertQuery e of
Nothing -> pure $ Left $ UnexpectedErrorES "Failed to generate insert query"
Just (QWP query params) -> Right <$> executeNamed conn query params
Just (QWP query params) -> Right <$> execute conn query params
getEntityByUUID :: forall entity.
(Insertable 'SQL entity,
......@@ -345,13 +356,13 @@ getEntityByUUID conn uuid = maybe invalidEntityError doQuery $ case (getInsertIn
invalidEntityError = pure $ Left $ UnexpectedErrorES "Failed to generate entity name"
doQuery tbl = pure (makeSelectByUUIDQuery tbl uuid)
>>= \(QWP q p) -> queryNamed conn q p
>>= \(QWP q p) -> query conn q p
>>= \case
(x:_) -> pure $ Right x
_ -> pure $ Left $ NoSuchEntityES (Left uuid) "Failed to find task with given UUID"
makeSelectByUUIDQuery :: TableName -> UUID -> QueryWithParams
makeSelectByUUIDQuery (TN tbl) uuid = QWP query ["uuid" := uuid]
makeSelectByUUIDQuery (TN tbl) uuid = QWP query (toRow (Only uuid))
where
uuidTxt = toText uuid
query = Query $ [text| SELECT * FROM $tbl WHERE uuid = $uuidTxt |]
......
......@@ -267,7 +267,10 @@ instance Exception EntityStoreError
newtype TableName = TN { getTableName :: DT.Text } deriving (Eq, Show, Read)
newtype SQLColumnNames = SQLCN { getColumnNames :: [DT.Text] } deriving (Eq, Show, Read)
newtype SQLValueGetters entity = SQLVG { getValueGetters :: [entity -> Maybe SQLData] }
-- | These getters will be applied to the object when we need to pull values out to insert
-- Should be the same length as SQLColumnNames
newtype SQLValueGetters entity = SQLVG { getValueGetters :: [entity -> SQLData] }
-- | Alias for the kind of types with f bounded type polymorphism applied to one or more fields
-- ex. data T f = T { name :: f DT.Text }, where f might be a type like `Maybe a` or `Identity a`
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment