Commit 3e229344 authored by MrMan's avatar MrMan

Simple lexical EntityStore typeclass specification

- refactor `Task f state` to `Task state f` to fit FBounded type alias
parent 8ba324ce
......@@ -250,15 +250,15 @@ instance Constructable SQLiteEntityStore CompleteEntityStoreConfig EntityStoreEr
connectionFailure :: SomeException -> IO (Either EntityStoreError SQLiteEntityStore)
connectionFailure = pure . Left . ConnectionFailureES . ("Failed to connect to DB: "<>) . DT.pack . show
instance EntityStore SQLiteEntityStore where
create :: forall entity. SQLiteEntityStore -> Complete entity -> IO (Either EntityStoreError (Complete entity))
create = undefined
-- instance EntityStore SQLiteEntityStore where
-- create :: forall entity. SQLiteEntityStore -> Complete entity -> IO (Either EntityStoreError (Complete entity))
-- create = undefined
get :: forall entity. SQLiteEntityStore -> Complete entity -> IO (Either EntityStoreError (Complete entity))
get = undefined
-- get :: forall entity. SQLiteEntityStore -> Complete entity -> IO (Either EntityStoreError (Complete entity))
-- get = undefined
update :: forall entity. SQLiteEntityStore -> Partial entity -> IO (Either EntityStoreError (Complete entity))
update = undefined
-- update :: forall entity. SQLiteEntityStore -> Partial entity -> IO (Either EntityStoreError (Complete entity))
-- update = undefined
delete :: forall entity. SQLiteEntityStore -> Complete entity -> IO (Either EntityStoreError (Complete entity))
delete = undefined
-- delete :: forall entity. SQLiteEntityStore -> Complete entity -> IO (Either EntityStoreError (Complete entity))
-- delete = undefined
......@@ -11,6 +11,7 @@
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
module Types where
......@@ -25,6 +26,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)
-- Task state for abstracting over TaskState
data TaskState = Finished
......@@ -38,18 +40,18 @@ newtype TaskDesc = TaskDesc { getTDesc :: DT.Text } deriving (Eq, Show)
newtype TaskStateValue = TaskStateValue { getTStateLiteral :: DT.Text } deriving (Eq, Show)
-- The beefy task class
data Task f (state :: TaskState) where
FinishedT :: f TaskName -> f TaskDesc -> Task f 'Finished
InProgressT :: f TaskName -> f TaskDesc -> Task f 'InProgress
NotStartedT :: f TaskName -> f TaskDesc -> Task f 'NotStarted
data Task (state :: TaskState) f where
FinishedT :: f TaskName -> f TaskDesc -> Task 'Finished f
InProgressT :: f TaskName -> f TaskDesc -> Task 'InProgress f
NotStartedT :: f TaskName -> f TaskDesc -> Task 'NotStarted f
-- | The case where we don't know what the state actually is
-- Ex. when we pull a value from the DB, we can't be polymorphic over state with the other constructors
-- but the database *has* to know what was stored forthe state.
-- Once we have an UnknownStateT we can write functions that try to translate to what we expect/require and fail otherwise.
UnknownStateT :: f TaskName -> f TaskDesc -> TaskStateValue -> Task f state
UnknownStateT :: f TaskName -> f TaskDesc -> TaskStateValue -> Task state f
resolveFinishedT :: forall (state :: TaskState) (f :: Type -> Type). Task f state -> Either ValidationError (Task f 'Finished)
resolveFinishedT :: forall (state :: TaskState) (f :: Type -> Type). Task state f -> Either ValidationError (Task 'Finished f)
resolveFinishedT (t@FinishedT{}) = Right t
resolveFinishedT (UnknownStateT name desc stateValue) = case stateValue of
(TaskStateValue "Finished") -> Right (FinishedT name desc)
......@@ -57,19 +59,19 @@ resolveFinishedT (UnknownStateT name desc stateValue) = case stateValue of
resolveFinishedT _ = Left $ WrongState "Task state is incompatible (not in finished state)"
-- Completed tasks
type CompletedTask = Task Identity 'Finished
type CompletedTask = Task 'Finished Identity
-- InProgress, partially specified tasks
type InProgressPartialTask = Task Maybe 'InProgress
type InProgressPartialTask = Task 'InProgress Maybe
-- InProgress, fully specified tasks
type InProgressTask = Task Identity 'InProgress
type InProgressTask = Task 'InProgress Identity
-- Not started, partially specified tasks
type NotStartedPartialTask = Task Maybe 'NotStarted
type NotStartedPartialTask = Task 'NotStarted Maybe
-- Not started, completely specified tasks
type NotStartedTask = Task Identity 'NotStarted
type NotStartedTask = Task 'NotStarted Identity
type Partial a = a Maybe
type Complete a = a Identity
......@@ -106,8 +108,8 @@ class Validatable t where
-- | List of validation checks to run on the type (any of which could produce an error)
validationChecks :: [ValidationCheck t]
type FullySpecifiedTask = Task Identity
type PartialTask = Task Maybe
type FullySpecifiedTask state = Task state Identity
type PartialTask state = Task state Maybe
taskNameField :: FieldName
taskNameField = FieldName "name"
......@@ -115,7 +117,7 @@ taskNameField = FieldName "name"
taskDescField :: FieldName
taskDescField = FieldName "description"
showState :: forall (state :: TaskState) (f :: Type -> Type). Task f state -> String
showState :: forall (state :: TaskState) (f :: Type -> Type). Task state f -> String
showState (FinishedT _ _) = "Finished"
showState (InProgressT _ _) = "InProgress"
showState (NotStartedT _ _) = "NotStarted"
......@@ -272,10 +274,27 @@ data EntityStoreError = NoSuchEntityES EntityID
| ConnectionFailureES DT.Text
deriving (Eq, Show, Read)
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] }
class SQLEntityStore store => SQLInsertable store entity where
tableName :: TableName
columnNames :: SQLColumnNames
columnValues :: SQLValueGetters entity
-- | 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`
type FBounded = (Type -> Type) -> Type
-- | Generalized typeclass for entity storage.
class EntityStore store where
class SQLEntityStore store where
-- | Create an entity
create :: forall entity. store -> Complete entity -> IO (Either EntityStoreError (Complete entity))
create :: forall (entity :: FBounded).
SQLInsertable store (Complete entity)
=> store
-> Validated (Complete entity)
-> IO (Either EntityStoreError (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