diff options
| -rw-r--r-- | Omni/Task.hs | 25 | ||||
| -rw-r--r-- | Omni/Task/Core.hs | 33 |
2 files changed, 42 insertions, 16 deletions
diff --git a/Omni/Task.hs b/Omni/Task.hs index 117d862..07883ac 100644 --- a/Omni/Task.hs +++ b/Omni/Task.hs @@ -3,9 +3,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NoImplicitPrelude #-} --- : out task -- : dep sqlite-simple --- : modified by benign worker module Omni.Task where import Alpha @@ -21,6 +19,7 @@ import qualified System.Console.Docopt as Docopt import System.Directory (createDirectoryIfMissing, doesFileExist, removeFile) import System.Environment (setEnv) import qualified Test.Tasty as Tasty +import Web.HttpApiData (parseQueryParam) import Prelude (read) main :: IO () @@ -618,7 +617,27 @@ unitTests = -- The test should probably fail if we have multiple tasks that match the same ID case-insensitively. let matches = filter (\t -> matchesId (taskId t) upperId) tasks - length matches Test.@?= 2 + length matches Test.@?= 2, + Test.unit "FromHttpApiData Priority: empty string returns Left" <| do + let result = parseQueryParam "" :: Either Text Priority + case result of + Left _ -> pure () + Right _ -> Test.assertFailure "Empty string should return Left", + Test.unit "FromHttpApiData Priority: valid values parse correctly" <| do + (parseQueryParam "P0" :: Either Text Priority) Test.@?= Right P0 + (parseQueryParam "P1" :: Either Text Priority) Test.@?= Right P1 + (parseQueryParam "P2" :: Either Text Priority) Test.@?= Right P2 + (parseQueryParam "P3" :: Either Text Priority) Test.@?= Right P3 + (parseQueryParam "P4" :: Either Text Priority) Test.@?= Right P4, + Test.unit "FromHttpApiData Status: empty string returns Left" <| do + let result = parseQueryParam "" :: Either Text Status + case result of + Left _ -> pure () + Right _ -> Test.assertFailure "Empty string should return Left", + Test.unit "FromHttpApiData Status: valid values parse correctly" <| do + (parseQueryParam "Open" :: Either Text Status) Test.@?= Right Open + (parseQueryParam "InProgress" :: Either Text Status) Test.@?= Right InProgress + (parseQueryParam "Done" :: Either Text Status) Test.@?= Right Done ] -- | Test CLI argument parsing to ensure docopt string matches actual usage diff --git a/Omni/Task/Core.hs b/Omni/Task/Core.hs index a68f37b..d1d92d5 100644 --- a/Omni/Task/Core.hs +++ b/Omni/Task/Core.hs @@ -19,8 +19,9 @@ import qualified Database.SQLite.Simple.FromField as SQL import qualified Database.SQLite.Simple.Ok as SQLOk import qualified Database.SQLite.Simple.ToField as SQL import GHC.Generics () -import System.Directory (createDirectoryIfMissing, doesFileExist) +import System.Directory (XdgDirectory (..), createDirectoryIfMissing, doesFileExist, getXdgDirectory) import System.Environment (lookupEnv) +import System.FilePath (takeDirectory, (</>)) import System.IO.Unsafe (unsafePerformIO) import Web.HttpApiData (FromHttpApiData (..)) @@ -116,14 +117,18 @@ instance FromJSON RetryContext -- HTTP API Instances (for Servant query params) instance FromHttpApiData Status where - parseQueryParam t = case readMaybe (T.unpack t) of - Just s -> Right s - Nothing -> Left ("Invalid status: " <> t) + parseQueryParam t + | T.null t = Left "" + | otherwise = case readMaybe (T.unpack t) of + Just s -> Right s + Nothing -> Left ("Invalid status: " <> t) instance FromHttpApiData Priority where - parseQueryParam t = case readMaybe (T.unpack t) of - Just p -> Right p - Nothing -> Left ("Invalid priority: " <> t) + parseQueryParam t + | T.null t = Left "" + | otherwise = case readMaybe (T.unpack t) of + Just p -> Right p + Nothing -> Left ("Invalid priority: " <> t) -- SQLite Instances @@ -235,11 +240,12 @@ getTasksDbPath :: IO FilePath getTasksDbPath = do customPath <- lookupEnv "TASK_DB_PATH" testMode <- lookupEnv "TASK_TEST_MODE" - let path = case (testMode, customPath) of - (Just "1", _) -> "_/tmp/tasks-test.db" -- Test mode uses cabdir - (_, Just p) -> p -- Custom path for production - _ -> "_/tmp/tasks.db" -- Default uses cabdir - pure path + case (testMode, customPath) of + (Just "1", _) -> pure "_/tmp/tasks-test.db" + (_, Just p) -> pure p + _ -> do + xdgData <- getXdgDirectory XdgData "jr" + pure (xdgData </> "jr.db") -- DB Helper withDb :: (SQL.Connection -> IO a) -> IO a @@ -252,7 +258,8 @@ withDb action = do -- Initialize the task database initTaskDb :: IO () initTaskDb = do - createDirectoryIfMissing True "_/tmp" + dbPath <- getTasksDbPath + createDirectoryIfMissing True (takeDirectory dbPath) withDb <| \conn -> do SQL.execute_ conn |