taskwarrior 0.3.0.0 → 0.3.1.0
raw patch · 13 files changed
+500/−461 lines, 13 files
Files
- CHANGELOG.md +4/−0
- README.md +2/−2
- src/Taskwarrior/Annotation.hs +15/−15
- src/Taskwarrior/IO.hs +87/−74
- src/Taskwarrior/Mask.hs +14/−15
- src/Taskwarrior/Priority.hs +20/−21
- src/Taskwarrior/RecurringChild.hs +36/−33
- src/Taskwarrior/Status.hs +51/−47
- src/Taskwarrior/Task.hs +173/−162
- src/Taskwarrior/Time.hs +32/−27
- src/Taskwarrior/UDA.hs +6/−7
- taskwarrior.cabal +8/−8
- test/TaskSpec.hs +52/−50
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Revision history for taskwarrior +## 0.3.1.0++* Add support with the JSON Format of taskwarrior 2.6.+ ## 0.3.0.0 * Only export `id` and `urgency` when non default.
README.md view
@@ -1,8 +1,8 @@ # taskwarrior -[](https://hackage.haskell.org/package/taskwarrior)-[](https://actions-badge.atrox.dev/maralorn/haskell-taskwarrior/goto?ref=master) [](http://packdeps.haskellers.com/reverse/taskwarrior)+[](https://github.com/maralorn/haskell-taskwarrior/actions)+[](https://repology.org/project/haskell:taskwarrior/versions) ## About
src/Taskwarrior/Annotation.hs view
@@ -1,26 +1,26 @@ -- | Provides the 'Annotation' type with 'Data.Aeson.ToJSON' and 'Data.Aeson.FromJSON' instances.-module Taskwarrior.Annotation- ( Annotation(..)- )-where+module Taskwarrior.Annotation (+ Annotation (..),+) where -import qualified Taskwarrior.Time as Time-import Data.Time ( UTCTime )-import Data.Text ( Text )-import Data.Aeson ( (.:)- , (.=)- )-import qualified Data.Aeson as Aeson+import Data.Aeson (+ (.:),+ (.=),+ )+import qualified Data.Aeson as Aeson+import Data.Text (Text)+import Data.Time (UTCTime)+import qualified Taskwarrior.Time as Time -- | A taskwarrior 'Taskwarrior.Task.Task' can have multiple annotations. They contain a timestamp 'entry' and a 'description'.-data Annotation = Annotation { entry :: UTCTime, description :: Text } deriving (Eq, Show, Read, Ord)+data Annotation = Annotation {entry :: UTCTime, description :: Text} deriving (Eq, Show, Read, Ord) instance Aeson.FromJSON Annotation where parseJSON = Aeson.withObject "Annotation" $ \o -> do description <- o .: "description"- entry <- o .: "entry" >>= Time.parse- pure Annotation { .. }+ entry <- o .: "entry" >>= Time.parse+ pure Annotation{..} instance Aeson.ToJSON Annotation where- toJSON Annotation {..} =+ toJSON Annotation{..} = Aeson.object ["description" .= description, "entry" .= Time.toValue entry]
src/Taskwarrior/IO.hs view
@@ -1,106 +1,117 @@--- | This modules contains IO actions to interact with the taskwarrior application.--- The taskwarrior documentation very explicitly disallows accessing the files by itself.--- So all functions here work via calling the @task@ binary which needs to be in the PATH.-module Taskwarrior.IO- ( getTasks- , saveTasks- , createTask- , getUUIDs- , onAdd- , onAddPure- , onModify- , onModifyPure- )-where+{- | This modules contains IO actions to interact with the taskwarrior application.+ The taskwarrior documentation very explicitly disallows accessing the files by itself.+ So all functions here work via calling the @task@ binary which needs to be in the PATH.+-}+module Taskwarrior.IO (+ getTasks,+ saveTasks,+ createTask,+ getUUIDs,+ onAdd,+ onAddPure,+ onModify,+ onModifyPure,+) where -import Taskwarrior.Task ( Task- , makeTask- )-import Data.Text ( Text )-import qualified Data.Text as Text-import qualified Data.ByteString as BS-import qualified Data.ByteString.Lazy as LBS- hiding ( putStrLn )-import qualified Data.ByteString.Lazy.Char8 as LBS-import qualified Data.Aeson as Aeson-import System.Process ( withCreateProcess- , CreateProcess(..)- , proc- , StdStream(..)- , waitForProcess- )-import System.IO ( hClose )-import System.Exit ( ExitCode(..) )-import Control.Monad ( when )-import System.Random ( getStdRandom- , random- )-import Data.Time ( getCurrentTime )-import Data.UUID ( UUID )-import qualified Data.UUID as UUID+import Control.Monad (when)+import qualified Data.Aeson as Aeson+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS hiding (+ putStrLn,+ )+import qualified Data.ByteString.Lazy.Char8 as LBS+import Data.Text (Text)+import qualified Data.Text as Text+import Data.Time (getCurrentTime)+import Data.UUID (UUID)+import qualified Data.UUID as UUID+import System.Exit (ExitCode (..))+import System.IO (hClose)+import System.Process (+ CreateProcess (..),+ StdStream (..),+ proc,+ waitForProcess,+ withCreateProcess,+ )+import System.Random (+ getStdRandom,+ random,+ )+import Taskwarrior.Task (+ Task,+ makeTask,+ ) -- | Uses @task export@ with a given filter like @["description:Milk", "+PENDING"]@. getTasks :: [Text] -> IO [Task] getTasks args = withCreateProcess- ((proc "task" (fmap Text.unpack . (++ ["export"]) $ args))+ ( (proc "task" (fmap Text.unpack . (++ ["export"]) $ args)) { std_out = CreatePipe }- )+ ) $ \_ stdoutMay _ _ -> do- stdout <- maybe+ stdout <-+ maybe (fail "Couldn‘t create stdout handle for `task export`") pure stdoutMay- input <- LBS.hGetContents stdout- either fail return . Aeson.eitherDecode $ input+ input <- LBS.hGetContents stdout+ either fail return . Aeson.eitherDecode $ input -- | Gives all uuids matching the given filter (e.g. @["description:Milk", "+PENDING"]@). This calls the @task@ binary. getUUIDs :: [Text] -> IO [UUID] getUUIDs args = withCreateProcess- ((proc "task" (fmap Text.unpack . (++ ["_uuid"]) $ args)) { std_out = CreatePipe- }- )+ ( (proc "task" (fmap Text.unpack . (++ ["_uuid"]) $ args))+ { std_out = CreatePipe+ }+ ) $ \_ stdoutMay _ _ -> do- stdout <- maybe+ stdout <-+ maybe (fail "Couldn‘t create stdout handle for `task _uuid`") pure stdoutMay- input <- LBS.hGetContents stdout- maybe (fail "Couldn't parse UUIDs") return- . traverse UUID.fromLazyASCIIBytes- . LBS.lines- $ input+ input <- LBS.hGetContents stdout+ maybe (fail "Couldn't parse UUIDs") return+ . traverse UUID.fromLazyASCIIBytes+ . LBS.lines+ $ input -- | Uses @task import@ to save the given tasks. saveTasks :: [Task] -> IO () saveTasks tasks =- withCreateProcess ((proc "task" ["import"]) { std_in = CreatePipe })- $ \stdinMay _ _ process -> do- stdin <- maybe (fail "Couldn‘t create stdin handle for `task import`")- pure- stdinMay- LBS.hPut stdin . Aeson.encode $ tasks- hClose stdin- exitCode <- waitForProcess process- when (exitCode /= ExitSuccess) $ fail . show $ exitCode+ withCreateProcess ((proc "task" ["import"]){std_in = CreatePipe}) $+ \stdinMay _ _ process -> do+ stdin <-+ maybe+ (fail "Couldn‘t create stdin handle for `task import`")+ pure+ stdinMay+ LBS.hPut stdin . Aeson.encode $ tasks+ hClose stdin+ exitCode <- waitForProcess process+ when (exitCode /= ExitSuccess) $ fail . show $ exitCode --- | This will create a @'Task'@. I runs in @'IO'@ to create a @'UUID'@ and get the current time. This will not save the @'Task'@ to taskwarrior.--- If you want to create a task with certain fields and save it you could do that like this:------ @--- newTask <- 'createTask' "Buy Milk"--- 'saveTasks' [newTask { 'Taskwarrior.Task.tags' = ["groceries"] }]--- @+{- | This will create a @'Task'@. I runs in @'IO'@ to create a @'UUID'@ and get the current time. This will not save the @'Task'@ to taskwarrior.+ If you want to create a task with certain fields and save it you could do that like this:++ @+ newTask <- 'createTask' "Buy Milk"+ 'saveTasks' [newTask { 'Taskwarrior.Task.tags' = ["groceries"] }]+ @+-} createTask :: Text -> IO Task createTask description = do- uuid <- getStdRandom random+ uuid <- getStdRandom random entry <- getCurrentTime pure $ makeTask uuid entry description --- | Takes a function @f originalTask modifiedTask = taskToSave@.--- The resulting IO action can be run as the `main :: IO ()` of a taskwarrior on-modify hook.+{- | Takes a function @f originalTask modifiedTask = taskToSave@.+ The resulting IO action can be run as the `main :: IO ()` of a taskwarrior on-modify hook.+-} onModifyPure :: (Task -> Task -> Task) -> IO () onModifyPure f = onModify (\x y -> pure (f x y)) @@ -124,5 +135,7 @@ -- | Like onAddPure with side effects. onAdd :: (Task -> IO Task) -> IO ()-onAdd f = LBS.putStrLn . Aeson.encode =<< f =<< readTaskLine- "OnAdd hook couldn‘t parse task."+onAdd f =+ LBS.putStrLn . Aeson.encode =<< f+ =<< readTaskLine+ "OnAdd hook couldn‘t parse task."
src/Taskwarrior/Mask.hs view
@@ -1,13 +1,12 @@ -- | The Mask module models the state a recurring parent saves about its child tasks.-module Taskwarrior.Mask- ( Mask(..)- , MaskState- )-where+module Taskwarrior.Mask (+ Mask (..),+ MaskState,+) where -import qualified Data.Text as Text-import qualified Data.Aeson as Aeson-import qualified Data.Aeson.Types as Aeson.Types+import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Types as Aeson.Types+import qualified Data.Text as Text -- | Represents the state of a child in a 'Status.Recurring' 'Task.Task'. data MaskState = Pending | Completed | Deleted | Waiting deriving (Eq, Show, Enum, Read, Ord, Bounded)@@ -17,10 +16,10 @@ toChar :: MaskState -> Char toChar = \case- Pending -> '-'+ Pending -> '-' Completed -> '+'- Deleted -> 'X'- Waiting -> 'W'+ Deleted -> 'X'+ Waiting -> 'W' instance Aeson.FromJSON Mask where parseJSON =@@ -28,10 +27,10 @@ parseChar :: Char -> Aeson.Types.Parser MaskState parseChar = \case- '-' -> pure Pending- '+' -> pure Completed- 'X' -> pure Deleted- 'W' -> pure Waiting+ '-' -> pure Pending+ '+' -> pure Completed+ 'X' -> pure Deleted+ 'W' -> pure Waiting char -> fail $ "Not a Mask Char: '" ++ [char] ++ "'" instance Aeson.ToJSON Mask where
src/Taskwarrior/Priority.hs view
@@ -1,23 +1,21 @@ -- | This module provides the type for the 'Priority' of a task.-module Taskwarrior.Priority- ( parseMay- , Priority(..)- )-where--import qualified Data.Aeson as Aeson-import Data.Aeson.Types ( Parser )+module Taskwarrior.Priority (+ parseMay,+ Priority (..),+) where +import qualified Data.Aeson as Aeson+import Data.Aeson.Types (Parser) -- | A 'Taskwarrior.Task.Task' can have the priorities 'High', 'Medium', 'Low' or none, which is modeled via a 'Maybe' 'Priority'. data Priority = High | Medium | Low- deriving (Eq, Show, Read, Enum, Ord, Bounded)+ deriving (Eq, Show, Read, Enum, Ord, Bounded) instance Aeson.ToJSON Priority where toJSON = \case- High -> "H"+ High -> "H" Medium -> "M"- Low -> "L"+ Low -> "L" -- | Parses a JSON string to a 'Maybe' 'Priority', fails on anything else. parseMay :: Aeson.Value -> Parser (Maybe Priority)@@ -25,16 +23,17 @@ "H" -> pure $ Just High "M" -> pure $ Just Medium "L" -> pure $ Just Low- "" -> pure Nothing+ "" -> pure Nothing s ->- fail- $ "parsing Priority failed, unexpected "- ++ show s- ++ " (expected \"H\", \"M\", \"L\", or \"\")"+ fail $+ "parsing Priority failed, unexpected "+ ++ show s+ ++ " (expected \"H\", \"M\", \"L\", or \"\")" instance Aeson.FromJSON Priority where- parseJSON val = parseMay val >>= \case- Nothing ->- fail- "parsing Priority failed, unexpected null (expected \"H\", \"M\", or \"L\")"- Just p -> pure p+ parseJSON val =+ parseMay val >>= \case+ Nothing ->+ fail+ "parsing Priority failed, unexpected null (expected \"H\", \"M\", or \"L\")"+ Just p -> pure p
src/Taskwarrior/RecurringChild.hs view
@@ -1,36 +1,39 @@--- | This Module provides the RecurringChild type with--- FromJSON and ToJSON instances.-module Taskwarrior.RecurringChild- ( RecurringChild(..)- , parseFromObjectMay- , toPairs- )-where+{- | This Module provides the RecurringChild type with+ FromJSON and ToJSON instances.+-}+module Taskwarrior.RecurringChild (+ RecurringChild (..),+ parseFromObjectMay,+ toPairs,+) where -import Control.Applicative ( optional )-import Data.Aeson ( Object- , (.:)- , (.=)- , ToJSON- , FromJSON- , pairs- , object- , withObject- )-import qualified Data.Aeson as Aeson-import Data.Aeson.Types ( Parser- , Pair- )-import Data.Text ( Text )-import Data.UUID ( UUID )+import Control.Applicative (optional)+import Data.Aeson (+ FromJSON,+ Object,+ ToJSON,+ object,+ pairs,+ withObject,+ (.:),+ (.=),+ )+import qualified Data.Aeson as Aeson+import Data.Aeson.Types (+ Pair,+ Parser,+ )+import Data.Text (Text)+import Data.UUID (UUID) --- | The 'RecurringChild' type saves information about how a 'Taskwarrior.Task.Task'--- is child of another 'Taskwarrior.Task.Task' wich is recurring.-data RecurringChild =- RecurringChild {- recur :: Text,- imask :: Integer,- parent :: UUID }+{- | The 'RecurringChild' type saves information about how a 'Taskwarrior.Task.Task'+ is child of another 'Taskwarrior.Task.Task' wich is recurring.+-}+data RecurringChild = RecurringChild+ { recur :: Text+ , imask :: Integer+ , parent :: UUID+ } deriving (Eq, Show, Read, Ord) -- | Gathers all fields for a 'RecurringChild' status.@@ -43,12 +46,12 @@ -- | Can be used to serialize 'RecurringChild' to JSON. toPairs :: RecurringChild -> [Pair]-toPairs RecurringChild {..} =+toPairs RecurringChild{..} = ["recur" .= recur, "imask" .= imask, "parent" .= parent] instance FromJSON RecurringChild where parseJSON = withObject "RecurringChild" parseFromObject instance ToJSON RecurringChild where- toJSON = object . toPairs+ toJSON = object . toPairs toEncoding = pairs . mconcat . map (uncurry (.=)) . toPairs
src/Taskwarrior/Status.hs view
@@ -1,60 +1,64 @@ -- | This module deals with information of a task which is dependent on the status.-module Taskwarrior.Status- ( Status(..)- , parseFromObject- , toPairs- )-where+module Taskwarrior.Status (+ Status (..),+ parseFromObject,+ toPairs,+) where -import Taskwarrior.Mask ( Mask )-import qualified Taskwarrior.Time as Time-import Data.Aeson ( Object- , (.:)- , (.=)- , ToJSON- , FromJSON- , pairs- , object- , withObject- )-import qualified Data.Aeson as Aeson-import Data.Text ( Text )-import Data.Time ( UTCTime )-import Data.Aeson.Types ( Parser- , typeMismatch- , Pair- )+import Data.Aeson (+ FromJSON,+ Object,+ ToJSON,+ object,+ pairs,+ withObject,+ (.:),+ (.=),+ )+import qualified Data.Aeson as Aeson+import Data.Aeson.Types (+ Pair,+ Parser,+ typeMismatch,+ )+import Data.Text (Text)+import Data.Time (UTCTime)+import Taskwarrior.Mask (Mask)+import qualified Taskwarrior.Time as Time --- | A task can be pending, deleted, completed, waiting or recurring.--- It is recommended to access the fields only by pattern matching since the getters are partial.-data Status =- Pending |- Deleted { end :: UTCTime } |- Completed { end :: UTCTime } |- Waiting { wait :: UTCTime } |- Recurring {- recur :: Text,- mask :: Mask}+{- | A task can be pending, deleted, completed, waiting or recurring.+ It is recommended to access the fields only by pattern matching since the getters are partial.+-}+data Status+ = Pending+ | Deleted {end :: UTCTime}+ | Completed {end :: UTCTime}+ | Waiting {wait :: UTCTime}+ | Recurring+ { recur :: Text+ , mask :: Mask+ } deriving (Eq, Show, Read, Ord) -- | Takes all information that is dependent on the status from a JSON object. parseFromObject :: Object -> Parser Status-parseFromObject o = (o .: "status") >>= \case- "pending" -> pure Pending- "deleted" -> Deleted <$> (o .: "end" >>= Time.parse)- "completed" -> Completed <$> (o .: "end" >>= Time.parse)- "waiting" -> Waiting <$> (o .: "wait" >>= Time.parse)- "recurring" -> Recurring <$> o .: "recur" <*> o .: "mask"- str -> typeMismatch "status" (Aeson.String str)+parseFromObject o =+ (o .: "status") >>= \case+ "pending" -> pure Pending+ "deleted" -> Deleted <$> (o .: "end" >>= Time.parse)+ "completed" -> Completed <$> (o .: "end" >>= Time.parse)+ "waiting" -> Waiting <$> (o .: "wait" >>= Time.parse)+ "recurring" -> Recurring <$> o .: "recur" <*> o .: "mask"+ str -> typeMismatch "status" (Aeson.String str) -- | A list of Pairs can be used to construct a JSON object later. The result of 'toPairs' is supposed to be combined with the rest of the fields of a task. toPairs :: Status -> [Pair] toPairs = \case- Pending -> [statusLabel "pending"]- Deleted {..} -> [statusLabel "deleted", "end" .= Time.toValue end]- Completed {..} -> [statusLabel "completed", "end" .= Time.toValue end]- Waiting {..} -> [statusLabel "waiting", "wait" .= Time.toValue wait]- Recurring {..} -> [statusLabel "recurring", "recur" .= recur, "mask" .= mask]+ Pending -> [statusLabel "pending"]+ Deleted{..} -> [statusLabel "deleted", "end" .= Time.toValue end]+ Completed{..} -> [statusLabel "completed", "end" .= Time.toValue end]+ Waiting{..} -> [statusLabel "waiting", "wait" .= Time.toValue wait]+ Recurring{..} -> [statusLabel "recurring", "recur" .= recur, "mask" .= mask] where statusLabel :: Text -> Pair statusLabel = ("status" .=)@@ -63,5 +67,5 @@ parseJSON = withObject "Status" parseFromObject instance ToJSON Status where- toJSON = object . toPairs+ toJSON = object . toPairs toEncoding = pairs . mconcat . map (uncurry (.=)) . toPairs
src/Taskwarrior/Task.hs view
@@ -1,93 +1,98 @@--- | This Module exports the main datatype of this library: Task.--- It is provided with FromJSON and ToJSON instances.----module Taskwarrior.Task- ( Task(..)- , Tag- , makeTask- -- | == Adherence to specification- -- This library uses the [taskwarrior specification for the JSON serialisation format](https://taskwarrior.org/docs/design/task.html).- -- But it deviates in a small number of ways to be more pragmatic.- --- -- * 'Task' has the fields 'id' and 'urgency' although they are technically UDAs.- -- * There are two invalid states which are not prevented via the Haskell type system by the chosen modeling:- --- -- 1. A 'Task' with a 'Just' value for 'recurringChild' should not have the 'Status' 'Taskwarrior.Status.Recurring'.- -- 2. The 'due' field needs to be a 'Just' value on a 'Task' with 'Status' 'Taskwarrior.Status.Recurring'.- )-where+{- | This Module exports the main datatype of this library: Task.+ It is provided with FromJSON and ToJSON instances.+-}+module Taskwarrior.Task (+ Task (..),+ Tag,+ makeTask,+ {-+ | == Adherence to specification+ This library uses the [taskwarrior specification for the JSON serialisation format](https://taskwarrior.org/docs/design/task.html).+ But it deviates in a small number of ways to be more pragmatic. -import Prelude hiding ( id )+ * 'Task' has the fields 'id' and 'urgency' although they are technically UDAs.+ * There are two invalid states which are not prevented via the Haskell type system by the chosen modeling: -import qualified Data.Text as Text-import Data.Text ( Text )-import Data.Time ( UTCTime )-import qualified Data.UUID as UUID-import Data.UUID ( UUID )-import qualified Data.Aeson as Aeson-import qualified Data.Aeson.Types as Aeson.Types-import Data.Aeson ( withObject- , withText- , FromJSON- , ToJSON- , parseJSON- , (.:)- , (.=)- , (.:?)- , Value- )-import qualified Data.Semigroup as Semigroup-import Data.Maybe ( fromMaybe )-import qualified Data.Maybe as Maybe-import Control.Monad ( join )-import qualified Data.Foldable as Foldable-import Taskwarrior.Status ( Status )-import qualified Taskwarrior.Status as Status-import Taskwarrior.RecurringChild ( RecurringChild )-import qualified Taskwarrior.RecurringChild as RecurringChild-import Taskwarrior.Priority ( Priority )-import qualified Taskwarrior.Priority as Priority-import Taskwarrior.UDA ( UDA )-import Taskwarrior.Annotation ( Annotation )-import qualified Taskwarrior.Time as Time-import qualified Data.HashMap.Strict as HashMap-import Data.Set ( Set )-import qualified Data.Set as Set-import Foreign.Marshal.Utils ( fromBool )+ 1. A 'Task' with a 'Just' value for 'recurringChild' should not have the 'Status' 'Taskwarrior.Status.Recurring'.+ 2. The 'due' field needs to be a 'Just' value on a 'Task' with 'Status' 'Taskwarrior.Status.Recurring'.+ -}+) where --- | A 'Task' represents a task from taskwarrior.--- The specification demands, that the existence of some fields is dependent on the status of the task.--- Those fields are therefore bundled in 'Status' as a sum-type.------ All fields in an imported task which are not part of the specification will be put in the 'UDA' (user defined attributes) 'Data.HashMap.Strict.HashMap'.------ Since the json can have multiple semantically equivalent representations of a task first serializing and then deserializing is not identity.--- But deserializing and then serializing should be. (Thus making serializing and deserializing idempotent.)-data Task = Task {- status :: Status,- recurringChild :: Maybe RecurringChild,- uuid :: UUID,- id :: Maybe Integer,- entry :: UTCTime,- description :: Text,- start :: Maybe UTCTime,- modified :: Maybe UTCTime,- due :: Maybe UTCTime,- until :: Maybe UTCTime,- annotations :: Set Annotation,- scheduled :: Maybe UTCTime,- project :: Maybe Text,- priority :: Maybe Priority,- depends :: Set UUID,- tags :: Set Tag,- urgency :: Double,- uda :: UDA-} deriving (Eq, Show, Read)+import Prelude hiding (id) +import Control.Monad (join)+import Data.Aeson (+ FromJSON,+ ToJSON,+ Value,+ parseJSON,+ withObject,+ withText,+ (.:),+ (.:?),+ (.=), withArray+ )+import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Types as Aeson.Types+import qualified Data.Foldable as Foldable+import qualified Data.HashMap.Strict as HashMap+import Data.Maybe (fromMaybe)+import qualified Data.Maybe as Maybe+import qualified Data.Semigroup as Semigroup+import Data.Set (Set)+import qualified Data.Set as Set+import Data.Text (Text)+import qualified Data.Text as Text+import Data.Time (UTCTime)+import Data.UUID (UUID)+import qualified Data.UUID as UUID+import Foreign.Marshal.Utils (fromBool)+import Taskwarrior.Annotation (Annotation)+import Taskwarrior.Priority (Priority)+import qualified Taskwarrior.Priority as Priority+import Taskwarrior.RecurringChild (RecurringChild)+import qualified Taskwarrior.RecurringChild as RecurringChild+import Taskwarrior.Status (Status)+import qualified Taskwarrior.Status as Status+import qualified Taskwarrior.Time as Time+import Taskwarrior.UDA (UDA)+import Data.Foldable (toList)+import Control.Applicative ((<|>))++{- | A 'Task' represents a task from taskwarrior.+ The specification demands, that the existence of some fields is dependent on the status of the task.+ Those fields are therefore bundled in 'Status' as a sum-type.++ All fields in an imported task which are not part of the specification will be put in the 'UDA' (user defined attributes) 'Data.HashMap.Strict.HashMap'.++ Since the json can have multiple semantically equivalent representations of a task first serializing and then deserializing is not identity.+ But deserializing and then serializing should be. (Thus making serializing and deserializing idempotent.)+-}+data Task = Task+ { status :: Status+ , recurringChild :: Maybe RecurringChild+ , uuid :: UUID+ , id :: Maybe Integer+ , entry :: UTCTime+ , description :: Text+ , start :: Maybe UTCTime+ , modified :: Maybe UTCTime+ , due :: Maybe UTCTime+ , until :: Maybe UTCTime+ , annotations :: Set Annotation+ , scheduled :: Maybe UTCTime+ , project :: Maybe Text+ , priority :: Maybe Priority+ , depends :: Set UUID+ , tags :: Set Tag+ , urgency :: Double+ , uda :: UDA+ }+ deriving (Eq, Show, Read)+ -- | A Tag can be basically any string. But beware: Special symbols work but might clash with @task@ cli syntax. As an example you can use a space in a @'Tag'@. But then you cannot use @task +my tag@ on the command line. type Tag = Text - reservedKeys :: [Text] reservedKeys = [ "status"@@ -118,102 +123,108 @@ parseJSON = withObject "Task" $ \object -> do let parseTimeFromFieldMay = parseFromFieldWithMay Time.parse object uda = HashMap.filterWithKey (\k _ -> k `notElem` reservedKeys) object- status <- Status.parseFromObject object+ status <- Status.parseFromObject object recurringChild <- RecurringChild.parseFromObjectMay object- uuid <- object .: "uuid"- idRaw <- object .:? "id"+ uuid <- object .: "uuid"+ idRaw <- object .:? "id" let id = if idRaw == Just 0 then Nothing else idRaw- entry <- object .: "entry" >>= Time.parse+ entry <- object .: "entry" >>= Time.parse description <- object .: "description"- start <- parseTimeFromFieldMay "start"- modified <- parseTimeFromFieldMay "modified"- due <- parseTimeFromFieldMay "due"- until_ <- parseTimeFromFieldMay "until"- scheduled <- parseTimeFromFieldMay "scheduled"+ start <- parseTimeFromFieldMay "start"+ modified <- parseTimeFromFieldMay "modified"+ due <- parseTimeFromFieldMay "due"+ until_ <- parseTimeFromFieldMay "until"+ scheduled <- parseTimeFromFieldMay "scheduled" annotations <- Foldable.fold <$> object .:? "annotations"- project <- object .:? "project"- priority <- join- <$> parseFromFieldWithMay Priority.parseMay object "priority"- depends <- maybe (pure mempty)- parseUuidList- (HashMap.lookup "depends" object)- tags <- Foldable.fold <$> object .:? "tags"+ project <- object .:? "project"+ priority <-+ join+ <$> parseFromFieldWithMay Priority.parseMay object "priority"+ depends <-+ maybe+ (pure mempty)+ parseUuidList+ (HashMap.lookup "depends" object)+ tags <- Foldable.fold <$> object .:? "tags" urgency <- fromMaybe 0 <$> object .:? "urgency"- pure Task { until = until_, .. }+ pure Task{until = until_, ..} -parseFromFieldWithMay- :: (Value -> Aeson.Types.Parser a)- -> Aeson.Object- -> Text- -> Aeson.Types.Parser (Maybe a)+parseFromFieldWithMay ::+ (Value -> Aeson.Types.Parser a) ->+ Aeson.Object ->+ Text ->+ Aeson.Types.Parser (Maybe a) parseFromFieldWithMay parser object name = traverse parser (HashMap.lookup name object) parseUuidList :: Aeson.Value -> Aeson.Types.Parser (Set UUID)-parseUuidList =- withText "Text"- $ fmap Set.fromList- . mapM (parseJSON . Aeson.String)- . Text.splitOn ","+parseUuidList val =+ (withArray "Array of uuid strings" $ fmap Set.fromList . mapM parseJSON . toList) val <|>+ (withText "Comma separated list of uuids" $+ fmap Set.fromList+ . mapM (parseJSON . Aeson.String)+ . Text.splitOn ",") val instance ToJSON Task where- toJSON Task { until = until_, ..} =- Aeson.object- $ Status.toPairs status- <> [ "uuid" .= uuid- , "entry" .= Time.toValue entry- , "description" .= description- ]- <> [ "urgency" .= urgency | urgency /= 0 ]- <> maybe [] RecurringChild.toPairs recurringChild- <> ifNotNullSet annotations ("annotations" .=)- <> Maybe.mapMaybe- (\(name, value) -> (name .=) . Time.toValue <$> value)- [ ("start" , start)- , ("modified" , modified)- , ("due" , due)- , ("scheduled", scheduled)- , ("until" , until_)- ]- <> Maybe.catMaybes- [ ("id" .=) <$> id- , ("project" .=) <$> project- , ("priority" .=) <$> priority+ toJSON Task{until = until_, ..} =+ Aeson.object $+ Status.toPairs status+ <> [ "uuid" .= uuid+ , "entry" .= Time.toValue entry+ , "description" .= description ]- <> ifNotNullSet- depends- ( ("depends" .=)- . Text.intercalate ","- . fmap UUID.toText- . Set.toList- )- <> ifNotNullSet tags ("tags" .=)- <> HashMap.toList uda+ <> ["urgency" .= urgency | urgency /= 0]+ <> maybe [] RecurringChild.toPairs recurringChild+ <> ifNotNullSet annotations ("annotations" .=)+ <> Maybe.mapMaybe+ (\(name, value) -> (name .=) . Time.toValue <$> value)+ [ ("start", start)+ , ("modified", modified)+ , ("due", due)+ , ("scheduled", scheduled)+ , ("until", until_)+ ]+ <> Maybe.catMaybes+ [ ("id" .=) <$> id+ , ("project" .=) <$> project+ , ("priority" .=) <$> priority+ ]+ <> ifNotNullSet+ depends+ ( ("depends" .=)+ . Text.intercalate ","+ . fmap UUID.toText+ . Set.toList+ )+ <> ifNotNullSet tags ("tags" .=)+ <> HashMap.toList uda ifNotNullSet :: (Ord b) => Set b -> (Set b -> a) -> [a] ifNotNullSet set f =- (Semigroup.stimesMonoid . (fromBool :: Bool -> Integer) . not . Set.null $ set- )+ ( Semigroup.stimesMonoid . (fromBool :: Bool -> Integer) . not . Set.null $ set+ ) [f set] -- | Makes a Task with the given mandatory fields uuid, entry time and description. See createTask for a non-pure version which needs less parameters. makeTask :: UUID -> UTCTime -> Text -> Task-makeTask uuid entry description = Task { uuid- , description- , entry- , id = Nothing- , modified = Just entry- , status = Status.Pending- , recurringChild = Nothing- , due = Nothing- , priority = Nothing- , project = Nothing- , start = Nothing- , scheduled = Nothing- , until = Nothing- , annotations = mempty- , depends = mempty- , tags = mempty- , urgency = 0- , uda = HashMap.empty- }+makeTask uuid entry description =+ Task+ { uuid+ , description+ , entry+ , id = Nothing+ , modified = Just entry+ , status = Status.Pending+ , recurringChild = Nothing+ , due = Nothing+ , priority = Nothing+ , project = Nothing+ , start = Nothing+ , scheduled = Nothing+ , until = Nothing+ , annotations = mempty+ , depends = mempty+ , tags = mempty+ , urgency = 0+ , uda = HashMap.empty+ }
src/Taskwarrior/Time.hs view
@@ -1,34 +1,39 @@ -- | This module provides no own time type for taskwarrior rather it only gives deserialisation and serialisation support.-module Taskwarrior.Time- ( parse- , toValue- )-where-import Data.Aeson ( withText )-import qualified Data.Aeson as Aeson-import Data.Aeson.Types ( Parser- , typeMismatch- )-import Data.Time ( UTCTime- , parseTimeM- , defaultTimeLocale- )-import qualified Data.Time.Format as Time.Format-import qualified Data.Text as Text+module Taskwarrior.Time (+ parse,+ toValue,+) where +import Data.Aeson (withText)+import qualified Data.Aeson as Aeson+import Data.Aeson.Types (+ Parser,+ typeMismatch,+ )+import qualified Data.Text as Text+import Data.Time (+ UTCTime,+ defaultTimeLocale,+ parseTimeM,+ )+import qualified Data.Time.Format as Time.Format+ -- | Converts a time to the taskwarrior time format. toValue :: UTCTime -> Aeson.Value-toValue time = Aeson.String . Text.pack $ Time.Format.formatTime- defaultTimeLocale- "%Y%m%dT%H%M%SZ"- time+toValue time =+ Aeson.String . Text.pack $+ Time.Format.formatTime+ defaultTimeLocale+ "%Y%m%dT%H%M%SZ"+ time -- | Parses a JSON string from the taskwarrior time format. parse :: Aeson.Value -> Parser UTCTime-parse value = withText- "Date"- ( maybe (typeMismatch "Date" value) pure- . parseTimeM False defaultTimeLocale "%Y%m%dT%H%M%SZ"- . Text.unpack- )- value+parse value =+ withText+ "Date"+ ( maybe (typeMismatch "Date" value) pure+ . parseTimeM False defaultTimeLocale "%Y%m%dT%H%M%SZ"+ . Text.unpack+ )+ value
src/Taskwarrior/UDA.hs view
@@ -1,12 +1,11 @@ -- | User defined attributes are stored in a 'HashMap' from 'Text' to json 'Value's because we have no type information about them.-module Taskwarrior.UDA- ( UDA- )-where+module Taskwarrior.UDA (+ UDA,+) where -import Data.Text ( Text )-import Data.HashMap.Strict ( HashMap )-import Data.Aeson ( Value )+import Data.Aeson (Value)+import Data.HashMap.Strict (HashMap)+import Data.Text (Text) -- | A field will in practice only be a number or a string. type UDA = HashMap Text Value
taskwarrior.cabal view
@@ -4,7 +4,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.3.0.0+version: 0.3.1.0 synopsis: Types and aeson instances for taskwarrior tasks description: Types and aeson instances for the https://taskwarrior.org task import/export feature@@ -45,14 +45,14 @@ StrictData build-depends:- , aeson ^>=1.4.2.0- , base >=4.11 && <4.15- , bytestring ^>=0.10.8.2- , containers >=0.5.0.0 && <0.7+ , aeson >=1.4.2.0 && < 1.6+ , base >=4.11 && < 4.16+ , bytestring >=0.10.8.2 && < 0.12+ , containers >=0.5.0.0 && < 0.7 , process ^>=1.6.5.0- , random ^>=1.1+ , random >=1.1 && < 1.3 , text ^>=1.2.3.0- , time >=1.8.0.2 && <1.11+ , time >=1.8.0.2 && < 1.13 , unordered-containers ^>=0.2.9.0 , uuid ^>=1.3.13 @@ -69,7 +69,7 @@ build-depends: , aeson , base- , hspec ^>=2.7.1+ , hspec >=2.7.1 && < 2.9 , QuickCheck >=2.13.2 && <2.15 , quickcheck-instances ^>=0.3.22 , taskwarrior
test/TaskSpec.hs view
@@ -1,28 +1,29 @@ {-# LANGUAGE RecordWildCards #-}-module TaskSpec- ( spec- )-where -import Prelude hiding ( id )-import Control.Arrow ( second )+module TaskSpec (+ spec,+) where -import Test.Hspec-import Test.QuickCheck-import Data.Aeson-import Taskwarrior.Task-import Taskwarrior.Mask-import Taskwarrior.Status-import Taskwarrior.RecurringChild-import Taskwarrior.Annotation-import Taskwarrior.Priority-import Data.Time-import qualified Data.HashMap.Strict as HashMap-import Test.QuickCheck.Instances.Text ( )-import Test.QuickCheck.Instances.UUID ( )-import Test.QuickCheck.Instances.UnorderedContainers- ( )+import Control.Arrow (second)+import Prelude hiding (id) +import Data.Aeson+import qualified Data.HashMap.Strict as HashMap+import Data.Time+import Taskwarrior.Annotation+import Taskwarrior.Mask+import Taskwarrior.Priority+import Taskwarrior.RecurringChild+import Taskwarrior.Status+import Taskwarrior.Task+import Test.Hspec+import Test.QuickCheck+import Test.QuickCheck.Instances.Text ()+import Test.QuickCheck.Instances.UUID ()+import Test.QuickCheck.Instances.UnorderedContainers (++ )+ prop_taskDeEncode :: Task -> Property prop_taskDeEncode task = Just task === decode (encode task) @@ -32,8 +33,8 @@ spec :: Spec spec = do it "will be the same after read . show" $ property prop_taskReadShow- it "will be the same after encoding to JSON and decoding"- $ property prop_taskDeEncode+ it "will be the same after encoding to JSON and decoding" $+ property prop_taskDeEncode instance Arbitrary MaskState where arbitrary = arbitraryBoundedEnum@@ -42,52 +43,53 @@ arbitrary = Mask <$> (arbitrary :: Gen [MaskState]) instance Arbitrary Status where- arbitrary = oneof- [ pure Pending- , Deleted <$> arbitrary- , Completed <$> arbitrary- , Waiting <$> arbitrary- , Recurring <$> arbitrary <*> arbitrary- ]+ arbitrary =+ oneof+ [ pure Pending+ , Deleted <$> arbitrary+ , Completed <$> arbitrary+ , Waiting <$> arbitrary+ , Recurring <$> arbitrary <*> arbitrary+ ] instance Arbitrary RecurringChild where arbitrary = RecurringChild <$> arbitrary <*> arbitrary <*> arbitrary instance Arbitrary UTCTime where arbitrary = do- day <- ModifiedJulianDay <$> arbitrary+ day <- ModifiedJulianDay <$> arbitrary dayTime <- secondsToDiffTime <$> choose (0, 86400) pure $ UTCTime day dayTime instance Arbitrary Annotation where arbitrary = do- entry <- arbitrary+ entry <- arbitrary description <- arbitrary- pure Annotation { .. }+ pure Annotation{..} instance Arbitrary Priority where arbitrary = arbitraryBoundedEnum instance Arbitrary Task where arbitrary = do- status <- arbitrary+ status <- arbitrary recurringChild <- case status of Recurring{} -> pure Nothing -- A task cannot be both a parent and child recurrence- _ -> arbitrary- uuid <- arbitrary- id <- arbitrary `suchThat` maybe True (>= 1) -- IDs can't be negative, and 0 is used as "not present"- entry <- arbitrary+ _ -> arbitrary+ uuid <- arbitrary+ id <- arbitrary `suchThat` maybe True (>= 1) -- IDs can't be negative, and 0 is used as "not present"+ entry <- arbitrary description <- arbitrary- start <- arbitrary- modified <- arbitrary- due <- arbitrary- until_ <- arbitrary+ start <- arbitrary+ modified <- arbitrary+ due <- arbitrary+ until_ <- arbitrary annotations <- arbitrary- scheduled <- arbitrary- project <- arbitrary- priority <- arbitrary- depends <- arbitrary- tags <- arbitrary- urgency <- arbitrary- uda <- HashMap.fromList . fmap (second String) <$> arbitrary- pure Task { until = until_, .. }+ scheduled <- arbitrary+ project <- arbitrary+ priority <- arbitrary+ depends <- arbitrary+ tags <- arbitrary+ urgency <- arbitrary+ uda <- HashMap.fromList . fmap (second String) <$> arbitrary+ pure Task{until = until_, ..}