Commit 29ce99e9 authored by MrMan's avatar MrMan

Rewrite to use simpler SQLEntityStore

parent c0a76b9b
This diff is collapsed.
......@@ -27,7 +27,7 @@ import Data.Maybe (isJust, fromJust)
import Data.Monoid ((<>))
import Data.UUID (UUID, toText, fromText)
import qualified Data.Text as DT
import Database.SQLite.Simple (SQLData)
import Database.SQLite.Simple (SQLData, ToRow, FromRow)
-- Task state for abstracting over TaskState
data TaskState = Finished
......@@ -265,45 +265,46 @@ data EntityStoreError = NoSuchEntityES EntityID DT.Text
instance Exception EntityStoreError
newtype TableName = TN { getTableName :: DT.Text } deriving (Eq, Show, Read)
newtype SQLColumnNames = SQLCN { getColumnNames :: [DT.Text] } deriving (Eq, Show, Read)
newtype TableName entity = TN { getTableName :: DT.Text } deriving (Eq, Show, Read)
newtype SQLColumnNames entity = SQLCN { getColumnNames :: [DT.Text] } deriving (Eq, Show, Read)
-- | 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] }
class ToRow entity => SQLInsertable entity where
tableName :: TableName entity
columnNames :: SQLColumnNames entity
-- | Alias for the kind of types with f bounded type polymorphism applied to one or more fields
-- | Alias for the kind of types with a functor applied to one or more fields (this is be F bounded polymorphism, I think)
-- ex. data T f = T { name :: f DT.Text }, where f might be a type like `Maybe a` or `Identity a`
type FBounded = (Type -> Type) -> Type
-- | Kind (w/ help of DataKinds) that is used to parametrize over the storage paradigm of an EntityStore
data DBParadigm = SQL
| DocumentStore
deriving (Eq, Show, Read)
-- | Types that are insertable under some database paradigm p
class Insertable (p :: DBParadigm) entity where
getInsertInfo :: EntityInsertInfo p entity
-- | Insertion information for some type that is insertable under database paradigm p
data EntityInsertInfo (p :: DBParadigm) entity where
SQLEII :: TableName -> SQLColumnNames -> SQLValueGetters entity -> EntityInsertInfo 'SQL entity
DocumentStoreEII :: TableName -> EntityInsertInfo 'DocumentStore entity
-- | Generalized typeclass for entity storage.
class EntityStore (readable :: Type -> Constraint) (paradigm :: DBParadigm) store where
create :: forall (entity :: FBounded) (ident :: Identifier).
(Insertable paradigm (Complete entity),
readable (Complete entity))
=> store
class SQLEntityStore store where
-- | Create an entity
create :: forall (ident :: Identifier) (entity :: FBounded).
( SQLInsertable (Complete entity)
, FromRow (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))
getByID :: forall (ident :: Identifier) (entity :: FBounded).
FromRow (Complete entity)
=> store
-> EntityID
-> IO (Either EntityStoreError (WithID ident (Complete entity)))
-- | Update an existing entity by ID
update :: forall entity. store -> Partial entity -> IO (Either EntityStoreError (Complete entity))
updateByID :: forall (ident :: Identifier) (entity :: FBounded).
FromRow (Complete entity)
=> store
-> EntityID
-> Validated (Partial entity)
-> IO (Either EntityStoreError (WithID ident (Complete entity)))
-- | Delete an entity by ID
delete :: forall entity. store -> Complete entity -> IO (Either EntityStoreError (Complete entity))
deleteByID :: forall (ident :: Identifier) (entity :: FBounded).
FromRow (Complete entity)
=> store
-> EntityID
-> IO (Either EntityStoreError (WithID ident (Complete entity)))
{-# LANGUAGE OverloadedStrings #-}
module Components.TaskStore.SQLiteSpec (spec) where
module Components.EntityStore.SQLiteSpec (spec) where
import Components.TaskStore.SQLite (SQLiteTaskStore)
import Components.EntityStore.SQLite (SQLiteEntityStore)
import Types ( Constructable(..)
, HasMigratableDB(..)
, ValidationError
, TaskStore(..)
, TaskStoreError
, EntityStore(..)
, EntityStoreError
, SQLMigrationVersion(..)
, Validated
, Validatable(..)
......@@ -23,15 +23,15 @@ import Types ( Constructable(..)
, getValidatedObj
)
import Data.Functor.Identity
import Config (defaultCompleteTaskStoreConfig)
import Config (defaultCompleteEntityStoreConfig)
import Data.Either (isRight)
import Control.Monad.IO.Class (liftIO)
import Util (rightOrThrow)
import Test.Hspec
makeDefaultStore :: IO (Either TaskStoreError SQLiteTaskStore)
makeDefaultStore = construct defaultCompleteTaskStoreConfig
makeDefaultStore :: IO (Either EntityStoreError SQLiteEntityStore)
makeDefaultStore = construct defaultCompleteEntityStoreConfig
-- generateTask :: IO (Validated NotStartedTask)
generateTask :: IO (Validated (Task Identity TaskState))
......
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