Commit e51d5c3f authored by MrMan's avatar MrMan

Remove all recursively defined instances

parent 443ea52d
......@@ -5,6 +5,7 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Components.TaskStore.SQLite
(SQLiteTaskStore)
......@@ -24,6 +25,7 @@ import Database.SQLite.Simple.FromField (fieldData, ResultError(Conver
import Database.SQLite.Simple.FromRow (RowParser)
import Database.SQLite.Simple.ToField (ToField(..))
import Types
import Data.Functor.Identity
import Util (rightOrThrow)
import qualified Data.Text as DT
......@@ -54,19 +56,19 @@ instance ToField TaskState where
toField = SQLText . DT.pack . show
instance ToField TaskName where
toField = toField
toField = SQLText . getTName
instance FromField TaskName where
fromField = fromField
fromField = (TaskName <$>) . (fromField :: FieldParser DT.Text)
instance FromField TaskDesc where
fromField = fromField
fromField = (TaskDesc <$>) . (fromField :: FieldParser DT.Text)
instance ToField TaskDesc where
toField = toField
toField = SQLText . getTDesc
instance ToField a => ToField (Identity a) where
toField = toField
toField = toField . runIdentity
-- | ToRow (WithID a) can be generically performed if we just always put the ID first
-- this introduces the requirement that ids should always come first.
......@@ -93,10 +95,10 @@ instance FromRow a => FromRow (WithID a) where
_ -> throw $ ConversionFailed (show sqldata) "???" "Unrecognized contents in ID field (no valid WithID GADT constructor)"
instance FromRow a => FromRow (Identity a) where
fromRow = fromRow
fromRow = Identity <$> (fromRow :: RowParser a)
instance FromField a => FromField (Identity a) where
fromField = fromField
fromField = (Identity <$>) . (fromField :: FieldParser a)
instance FromField TaskState where
fromField f = case fieldData f of
......@@ -144,7 +146,7 @@ instance TaskStore SQLiteTaskStore where
deleteTask = undefined
instance FromRow SQLMigrationVersion where
fromRow = fromRow
fromRow = SQLMigrationVersion <$> field
-- | Helper function for making migration failed errors
makeMigrationFailedError :: SQLMigration -> SomeException -> IO (Either MigrationError a)
......@@ -193,7 +195,7 @@ instance HasMigratableDB SQLiteTaskStore where
unexpectedMigrationErr = pure $ Left $ UnexpectedMigrationError "Failed to retrieve DB connection"
convertToUnexpectedError :: SomeException -> IO (Either MigrationError ())
convertToUnexpectedError = const $ pure $ Left $ UnexpectedMigrationError ""
convertToUnexpectedError = pure . Left . UnexpectedMigrationError . DT.pack . show
tryHandler :: Connection -> IO (Either MigrationError ())
tryHandler conn = catch (handler conn) convertToUnexpectedError
......@@ -227,7 +229,7 @@ instance Constructable SQLiteTaskStore CompleteTaskStoreConfig TaskStoreError wh
construct cfg = catch makeStore connectionFailure
where
dbPath :: String
dbPath = show $ runIdentity $ tscDBFilePath cfg
dbPath = runIdentity $ tscDBFilePath cfg
makeStore :: IO (Either TaskStoreError SQLiteTaskStore)
makeStore = open dbPath
......
......@@ -27,4 +27,4 @@ spec = do
>>= rightOrThrow
-- migrate migrates to `desiredVersion`
>>= liftIO . migrate
>>= (`shouldBe` True) . isRight
>>= shouldBe (Right ())
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