Commit 722f3103 authored by MrMan's avatar MrMan

It compiles, with some things undefined still

parent 81bfb54f
......@@ -310,7 +310,7 @@ buildInsertQuery :: forall (ident :: Identifier) entity.
-> Maybe QueryWithParams
buildInsertQuery e = case (getInsertInfo :: EntityInsertInfo 'SQL (WithID ident (Complete entity))) of
(SQLEII tblName cols valueGetters) -> Just $ makeInsertQuery tblName cols valueGetters e
_ -> Nothing
-- _ -> Nothing -- GHC knows this is impossible (!)
makeInsertQuery :: Insertable 'SQL entity => TableName -> SQLColumnNames -> SQLValueGetters entity -> entity -> QueryWithParams
makeInsertQuery (TN tbl) (SQLCN colNames) (SQLVG valueGetters) entity = QWP insertQuery params
......@@ -339,7 +339,7 @@ getEntityByUUID :: forall entity.
-> IO (Either EntityStoreError (WithID 'UUIDID entity))
getEntityByUUID conn uuid = maybe invalidEntityError doQuery $ case (getInsertInfo :: EntityInsertInfo 'SQL entity) of
(SQLEII tblName _ _) -> Just tblName
_ -> Nothing
-- _ -> Nothing -- GHC knows this is impossible (!)
where
invalidEntityError :: IO (Either EntityStoreError (WithID 'UUIDID entity))
invalidEntityError = pure $ Left $ UnexpectedErrorES "Failed to generate entity name"
......@@ -357,7 +357,7 @@ makeSelectByUUIDQuery (TN tbl) uuid = QWP query ["uuid" := uuid]
query = Query $ [text| SELECT * FROM $tbl WHERE uuid = $uuidTxt |]
-- | Generalized typeclass for entity storage.
instance EntityStore 'SQL SQLiteEntityStore where
instance EntityStore FromRow 'SQL SQLiteEntityStore where
create store (Validated entity) = withActiveConn store _work
where
_work c = ensureUUID entity
......@@ -365,6 +365,7 @@ instance EntityStore 'SQL SQLiteEntityStore where
-- | Generate an insert query for the `WithID entity`
>>= insertAndReturnEntity c
>>= rightOrThrow
-- | Need to obscure the ident type here because ghc knows it can only be UUID
>>= pure . Right . makeGenericIdent
-- | Get an entity by ID
......
......@@ -12,10 +12,11 @@
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
module Types where
import Data.Kind(Type)
import Data.Kind(Type, Constraint)
import Config (CompleteTaskStoreConfig)
import Control.Exception (throw, Exception)
import Data.Either (isRight)
......@@ -284,12 +285,13 @@ data EntityInsertInfo (p :: DBParadigm) entity where
DocumentStoreEII :: TableName -> EntityInsertInfo 'DocumentStore entity
-- | Generalized typeclass for entity storage.
class EntityStore (paradigm :: DBParadigm) store where
class EntityStore (readable :: Type -> Constraint) (paradigm :: DBParadigm) store where
create :: forall (entity :: FBounded) (ident :: Identifier).
Insertable paradigm (Complete entity) =>
store
-> Validated (Complete entity)
-> IO (Either EntityStoreError (WithID ident (Complete entity)))
(Insertable paradigm (Complete entity),
readable (Complete entity))
=> store
-> Validated (Complete entity)
-> IO (Either EntityStoreError (WithID ident (Complete entity)))
-- | Get an entity by ID
get :: forall entity. store -> Complete entity -> IO (Either EntityStoreError (Complete entity))
......
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