Commit 67110e2c authored by MrMan's avatar MrMan

Add constructor for SQLiteTaskStore

parent 8f9809b2
......@@ -3,16 +3,19 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
module Components.TaskStore.SQLite
(SQLiteTaskStore)
where
import Components.TaskStore.Migrations.SQLite (migrations)
import Config (CompleteTaskStoreConfig)
import Config (CompleteTaskStoreConfig, TaskStoreConfig(..))
import Control.Exception (SomeException(..), throw, catch, try)
import Data.Either (Either)
import Data.Functor.Identity (Identity)
import Data.Functor.Identity (runIdentity)
import Data.List (sort, find)
import Data.UUID (UUID, toText, fromText)
import Data.UUID.V4 (nextRandom)
......@@ -218,3 +221,17 @@ instance HasMigratableDB SQLiteTaskStore where
-- *one* migration between every version (i.e. v1->v2, v2->v3, etc). This is a bad assumption to make generally,
-- but I'm OK with it since this is generally how most people make migrations in my mind, implementation can change later if need be
findNextMigration ms current = find ((current+1==) . smFrom) ms
instance Constructable SQLiteTaskStore CompleteTaskStoreConfig TaskStoreError where
construct :: CompleteTaskStoreConfig -> IO (Either TaskStoreError SQLiteTaskStore)
construct cfg = catch makeStore connectionFailure
where
dbPath :: String
dbPath = show $ runIdentity $ tscDBFilePath cfg
makeStore :: IO (Either TaskStoreError SQLiteTaskStore)
makeStore = open dbPath
>>= \conn -> pure (Right (SQLiteTaskStore cfg (Just conn)))
connectionFailure :: SomeException -> IO (Either TaskStoreError SQLiteTaskStore)
connectionFailure = pure . Left . ConnectionFailure . ("Failed to connect to DB: "<>) . DT.pack . show
......@@ -210,6 +210,10 @@ appConfigDefault = mempty
defaultCompleteAppConfig :: CompleteAppConfig
defaultCompleteAppConfig = mempty
-- | The default configuration *is* a fully specified complete app config @ mempty state
defaultCompleteTaskStoreConfig :: CompleteTaskStoreConfig
defaultCompleteTaskStoreConfig = mempty
-- | The default partially specified configuration is mempty
defaultPartialAppConfig :: PartialAppConfig
defaultPartialAppConfig = mempty
......
......@@ -158,6 +158,7 @@ class Component c => Constructable c cfg err where
data TaskStoreError = NoSuchTask TaskID
| UnexpectedError DT.Text
| Disconnected DT.Text
| ConnectionFailure DT.Text
deriving (Eq, Show, Read)
instance Exception TaskStoreError
......
module Components.TaskStore.SQLiteSpec (spec) where
import Components.TaskStore.SQLite
import Components.TaskStore.SQLite (SQLiteTaskStore)
import Types (Constructable(..), HasMigratableDB(..), TaskStore(..))
import Config (defaultCompleteTaskStoreConfig)
import Data.Either (isRight)
import Control.Monad.IO.Class (liftIO)
import Test.Hspec
......@@ -9,6 +13,6 @@ main = hspec spec
spec :: Spec
spec = do
describe "defaults" $ do
it "works" $
True `shouldBe` True
describe "task store creation" $ do
it "works" $ \_ -> liftIO (construct defaultCompleteTaskStoreConfig)
>> shouldBe True True
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