Commit 94422e19 authored by MrMan's avatar MrMan

More progress

parent 49c7aaa4
This diff is collapsed.
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-}
module Components.TaskStore.Migrations.SQLite where
import NeatInterpolation (text)
import Types (SQLMigration(..), SQLMigrationQuery(..))
migrations :: [SQLMigration]
migrations =
[SQLMigration
{ smFrom=0
, smTo=1
, smQuery=
SQLMigrationQuery
[text|
CREATE TABLE tasks(
uuid TEXT PRIMARY KEY NOT NULL,
name TEXT NOT NULL,
description TEXT NOT NULL,
state TEXT NOT NULL
);
|]
}
]
This diff is collapsed.
......@@ -179,34 +179,22 @@ class Component c where
class Component c => Constructable c cfg err where
construct :: cfg -> IO (Either err c)
data TaskStoreError = NoSuchTask TaskID
| UnexpectedError DT.Text
| Disconnected DT.Text
| ConnectionFailure DT.Text
deriving (Eq, Show, Read)
data Identifier = UUIDID
| INT64ID deriving (Eq, Show, Read)
instance Exception TaskStoreError
data WithID (ident :: Identifier) a where
WUUID :: UUID -> a -> WithID 'UUIDID a
WINT64 :: Int64 -> a -> WithID 'INT64ID a
newtype TaskID = TaskID { getTaskID :: Int } deriving (Eq, Show, Read)
WID :: Either UUID Int64 -> a -> WithID ident a
class Component c => TaskStore c where
persistTask :: forall (state :: TaskState). c -> Validated (FullySpecifiedTask state) -> IO (Either TaskStoreError (WithID (FullySpecifiedTask state)))
completeTask :: c -> TaskID -> IO (Either TaskStoreError (WithID CompletedTask))
getTask :: forall (state :: TaskState). c -> TaskID -> IO (Either TaskStoreError (WithID (FullySpecifiedTask state)))
updateTask :: forall (state :: TaskState). c -> TaskID -> PartialTask state -> IO (Either TaskStoreError (WithID (FullySpecifiedTask state)))
deleteTask :: forall (state :: TaskState). c -> TaskID -> IO (Either TaskStoreError (WithID (FullySpecifiedTask state)))
withoutID :: forall (ident :: Identifier) a. WithID ident a -> a
withoutID (WUUID _ a) = a
withoutID (WINT64 _ a) = a
data WithID a where
UUIDID :: UUID -> a -> WithID a
Int64ID :: Int64 -> a -> WithID a
withoutID :: WithID a -> a
withoutID (UUIDID _ a) = a
withoutID (Int64ID _ a) = a
showID :: WithID a -> String
showID (UUIDID v _) = show v
showID (Int64ID v _) = show v
showID :: forall (ident :: Identifier) a. WithID ident a -> String
showID (WUUID v _) = show v
showID (WINT64 v _) = show v
-- | A typeclass consisting of types that can produce an ID usable by a SQL library to represent itself.
-- for example, if SQL library a can take `Int` for numeric IDs as well as `String`s for UUIDs, and id is an abstraction over both forms of ID,
......@@ -268,7 +256,7 @@ class HasMigratableDB store where
type EntityID = Either UUID Int
data EntityStoreError = NoSuchEntityES EntityID
data EntityStoreError = NoSuchEntityES EntityID DT.Text
| UnexpectedErrorES DT.Text
| DisconnectedES DT.Text
| ConnectionFailureES DT.Text
......@@ -288,20 +276,20 @@ data DBParadigm = SQL
| DocumentStore
deriving (Eq, Show, Read)
class Insertable (paradigm :: DBParadigm) entity where
getInsertInfo :: EntityInsertInfo paradigm
class Insertable (p :: DBParadigm) entity where
getInsertInfo :: EntityInsertInfo p entity
data EntityInsertInfo (p :: DBParadigm) where
SQLEII :: TableName -> SQLColumnNames -> SQLValueGetters entity -> EntityInsertInfo 'SQL
DocumentStoreEII :: TableName -> EntityInsertInfo 'DocumentStore
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 (paradigm :: DBParadigm) store where
create :: forall (entity :: FBounded).
Insertable paradigm entity =>
create :: forall (entity :: FBounded) (ident :: Identifier).
Insertable paradigm (Complete entity) =>
store
-> Validated (Complete entity)
-> IO (Either EntityStoreError (WithID (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