Commit ec332515 authored by MrMan's avatar MrMan

lint removal

parent 50835849
......@@ -15,8 +15,7 @@ import Components.TaskStore.Migrations.SQLite (migrations)
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.Functor.Identity (Identity(..), runIdentity)
import Data.List (sort, find)
import Data.UUID (UUID, toText, fromText)
import Data.UUID.V4 (nextRandom)
......@@ -25,7 +24,6 @@ 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
......
......@@ -82,12 +82,12 @@ instance Semigroup PartialAppConfig where
}
where
resolveMaybes :: (PartialAppConfig -> Maybe a) -> Maybe a
resolveMaybes getter = maybe (getter a) Just (getter b)
resolveMaybes getter = getter b <|> getter a
instance Monoid PartialAppConfig where
mempty = AppConfig Nothing Nothing Nothing
data TaskStoreConfig f = TaskStoreConfig { tscDBFilePath :: f FilePath }
newtype TaskStoreConfig f = TaskStoreConfig { tscDBFilePath :: f FilePath }
type CompleteTaskStoreConfig = TaskStoreConfig Identity
deriving instance Generic CompleteTaskStoreConfig
......@@ -111,7 +111,7 @@ instance Semigroup PartialTaskStoreConfig where
a <> b = TaskStoreConfig { tscDBFilePath=resolveMaybes tscDBFilePath }
where
resolveMaybes :: (PartialTaskStoreConfig -> Maybe a) -> Maybe a
resolveMaybes getter = maybe (getter a) Just (getter b)
resolveMaybes getter = getter a <|> getter b
instance Monoid PartialTaskStoreConfig where
mempty = TaskStoreConfig Nothing
......@@ -163,20 +163,14 @@ instance FromENV PartialAppConfig where
, taskStoreConfig=Just $ fromENV pEnv
}
where
env :: [(String, String)]
env = getProcessEnv pEnv
prop :: String -> Maybe String
prop = flip lookup env
prop = flip lookup (getProcessEnv pEnv)
instance FromENV PartialTaskStoreConfig where
fromENV pEnv = TaskStoreConfig { tscDBFilePath=prop "TASK_STORE_FILE_PATH" }
where
env :: [(String, String)]
env = getProcessEnv pEnv
prop :: String -> Maybe String
prop = flip lookup env
prop = flip lookup (getProcessEnv pEnv)
-- | The class of configurations that can absorb partials of themselves to maintain a whole
class AbsorbPartial complete partial where
......@@ -190,7 +184,7 @@ instance AbsorbPartial CompleteAppConfig PartialAppConfig where
}
where
tsc = runIdentity $ taskStoreConfig c
maybeTSC = maybe mempty id $ taskStoreConfig p
maybeTSC = fromMaybe mempty $ taskStoreConfig p
instance AbsorbPartial CompleteTaskStoreConfig PartialTaskStoreConfig where
absorbPartial :: CompleteTaskStoreConfig -> PartialTaskStoreConfig -> CompleteTaskStoreConfig
......
......@@ -35,27 +35,27 @@ makeDefaultStore = construct defaultCompleteTaskStoreConfig
-- generateTask :: IO (Validated NotStartedTask)
generateTask :: IO (Validated (Task Identity TaskState))
generateTask = rightOrThrow $ validate $ Task { tName = Identity $ TaskName "example"
, tDescription = Identity $ TaskDesc "this is a example task"
, tState = Identity NotStarted
}
generateTask = rightOrThrow $ validate Task { tName = Identity $ TaskName "example"
, tDescription = Identity $ TaskDesc "this is a example task"
, tState = Identity NotStarted
}
main :: IO ()
main = hspec spec
spec :: Spec
spec = do
describe "task store creation" $ do
describe "task store creation" $
it "works with the default config" $ \_ -> liftIO makeDefaultStore
>>= (`shouldBe` True) . isRight
describe "task store migration" $ do
describe "task store migration" $
it "migrates with the default config (0 -> 1)" $ \_ -> liftIO makeDefaultStore
>>= rightOrThrow
>>= liftIO . migrate
>>= shouldBe (Right ())
describe "task store persistTask" $ do
describe "task store persistTask" $
it "works with default config" $ \_ -> liftIO makeDefaultStore
>>= rightOrThrow
>>= \store -> migrate store
......
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