diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,33 @@ # Revision history for taskwarrior +## 0.2.0.0 + +### Breaking changes + +* data Status: Removed RecurringChild, renamed RecurringParent to Recurring. + +### Other API changes + +* RecurringChild is now a new Type and a Maybe field of Task. +* Added the fields 'id' and 'urgency' to Task. They were regarded as UDAs before. +* Now exporting the data consructors of Priority +* Added To- and FromJSON for Status +* Add FromJSON for Priority and improved Parser errors for it + +### Documentation + +* Added documentation about adherence to the specification +* Improved linking in the docs +* Expanded README regarding help and contributions + +### Development + +* Github actions will now check formatting and linking in haddocks + +### Thanks + +Thanks to @ryantrinkle and @tom-audm for their contributions, which triggered this release. + ## 0.1.2.4 * Fix a bug where recurring masks where parsed wrong diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -31,4 +31,14 @@ ## Contributions -Any form of issue reports, general feedback or suggestions and of course code contributions are highly welcome. +Any form of issue reports, general feedback, feature requests or suggestions and of course code contributions are highly welcome. + +Also I'd be curious to know what you use this library for. + +This project uses brittany in default configuration as code formatter. +The tests on github will check for hlints, missing docs and unapplied formatting. + +## Help & Contact + +You can always open an issue on GitHub. You can also ask in `#haskell-taskwarrior` on freenode irc. If you don‘t have an irc client you can log in via [the webchat](https://webchat.freenode.net/#haskell-taskwarrior). +Shooting @maralorn a mail is also an option. But of course that won’t be public and therefore not help anyone else. diff --git a/src/Taskwarrior/Annotation.hs b/src/Taskwarrior/Annotation.hs --- a/src/Taskwarrior/Annotation.hs +++ b/src/Taskwarrior/Annotation.hs @@ -1,5 +1,4 @@ -{-# LANGUAGE RecordWildCards, ScopedTypeVariables #-} --- | +-- | Provides the 'Annotation' type with 'Data.Aeson.ToJSON' and 'Data.Aeson.FromJSON' instances. module Taskwarrior.Annotation ( Annotation(..) ) @@ -13,7 +12,7 @@ ) import qualified Data.Aeson as Aeson --- | +-- | 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) instance Aeson.FromJSON Annotation where diff --git a/src/Taskwarrior/IO.hs b/src/Taskwarrior/IO.hs --- a/src/Taskwarrior/IO.hs +++ b/src/Taskwarrior/IO.hs @@ -1,6 +1,6 @@ -- | 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. +-- So all functions here work via calling the @task@ binary which needs to be in the PATH. module Taskwarrior.IO ( getTasks , saveTasks @@ -85,7 +85,7 @@ -- -- @ -- newTask <- 'createTask' "Buy Milk" --- 'saveTasks' [newTask { 'tags' = ["groceries"] }] +-- 'saveTasks' [newTask { 'Taskwarrior.Task.tags' = ["groceries"] }] -- @ createTask :: Text -> IO Task createTask description = do diff --git a/src/Taskwarrior/Mask.hs b/src/Taskwarrior/Mask.hs --- a/src/Taskwarrior/Mask.hs +++ b/src/Taskwarrior/Mask.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE LambdaCase #-} -- | The Mask module models the state a recurring parent saves about its child tasks. module Taskwarrior.Mask ( Mask(..) @@ -10,10 +9,10 @@ import qualified Data.Aeson as Aeson import qualified Data.Aeson.Types as Aeson.Types --- | Represents the state of a child in a recurring task. +-- | 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) --- | The mask is a newtype to provide Aeson instances from and to a JSON string. +-- | The mask is a newtype to provide 'Data.Aeson' instances from and to a JSON string. newtype Mask = Mask {mask :: [MaskState]} deriving (Eq, Read, Ord, Show) toChar :: MaskState -> Char @@ -33,7 +32,7 @@ '+' -> pure Completed 'X' -> pure Deleted 'W' -> pure Waiting - char -> fail $ "Not a Mask Char: '"++[char]++"'" + char -> fail $ "Not a Mask Char: '" ++ [char] ++ "'" instance Aeson.ToJSON Mask where toJSON = Aeson.String . Text.pack . fmap toChar . mask diff --git a/src/Taskwarrior/Priority.hs b/src/Taskwarrior/Priority.hs --- a/src/Taskwarrior/Priority.hs +++ b/src/Taskwarrior/Priority.hs @@ -1,25 +1,40 @@ --- | This module provides the type for the priority of a task. -module Taskwarrior.Priority (parseMay, Priority) where +-- | 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, typeMismatch ) +import Data.Aeson.Types ( Parser ) --- | A task can have the priorities high, medium, low or none, which is modeled via a Maybe Priority. +-- | 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) instance Aeson.ToJSON Priority where - toJSON = \case - High -> "H" - Medium -> "M" - Low -> "L" + toJSON = \case + High -> "H" + Medium -> "M" + Low -> "L" --- | Parses a JSON string to a Maybe Priority, fails on anything else. +-- | Parses a JSON string to a 'Maybe' 'Priority', fails on anything else. parseMay :: Aeson.Value -> Parser (Maybe Priority) -parseMay val = Aeson.withText "Priority" (\case +parseMay = Aeson.withText "Priority" $ \case "H" -> pure $ Just High "M" -> pure $ Just Medium "L" -> pure $ Just Low - "" -> pure Nothing - _ -> typeMismatch "Priority" val) val + "" -> pure Nothing + s -> + 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 diff --git a/src/Taskwarrior/RecurringChild.hs b/src/Taskwarrior/RecurringChild.hs new file mode 100644 --- /dev/null +++ b/src/Taskwarrior/RecurringChild.hs @@ -0,0 +1,54 @@ +-- | 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 ) + +-- | 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. +parseFromObjectMay :: Object -> Parser (Maybe RecurringChild) +parseFromObjectMay = optional . parseFromObject + +parseFromObject :: Object -> Parser RecurringChild +parseFromObject o = + RecurringChild <$> o .: "recur" <*> o .: "imask" <*> o .: "parent" + +-- | Can be used to serialize 'RecurringChild' to JSON. +toPairs :: RecurringChild -> [Pair] +toPairs RecurringChild {..} = + ["recur" .= recur, "imask" .= imask, "parent" .= parent] + +instance FromJSON RecurringChild where + parseJSON = withObject "RecurringChild" parseFromObject + +instance ToJSON RecurringChild where + toJSON = object . toPairs + toEncoding = pairs . mconcat . map (uncurry (.=)) . toPairs diff --git a/src/Taskwarrior/Status.hs b/src/Taskwarrior/Status.hs --- a/src/Taskwarrior/Status.hs +++ b/src/Taskwarrior/Status.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE LambdaCase #-} -- | This module deals with information of a task which is dependent on the status. module Taskwarrior.Status ( Status(..) @@ -12,66 +11,57 @@ import Data.Aeson ( Object , (.:) , (.=) + , ToJSON + , FromJSON + , pairs + , object + , withObject ) import qualified Data.Aeson as Aeson -import Control.Applicative ( (<|>) ) import Data.Text ( Text ) import Data.Time ( UTCTime ) -import Data.UUID ( UUID ) import Data.Aeson.Types ( Parser , typeMismatch , Pair ) + -- | A task can be pending, deleted, completed, waiting or recurring. --- If I task is a recurring child or a recurring parent depends on the existence of the corresponding fields and can not be told from the status field alone. -- 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 } | - RecurringParent { - recur :: Text, - mask :: Mask} | - RecurringChild { + Recurring { recur :: Text, - imask :: Integer, - parent :: UUID } + mask :: Mask} deriving (Eq, Show, Read, Ord) -parseFromObject, parseParentFromObject, parseChildFromObject - :: Object -> Parser Status -- | 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" -> parseParentFromObject o <|> parseChildFromObject o + "recurring" -> Recurring <$> o .: "recur" <*> o .: "mask" str -> typeMismatch "status" (Aeson.String str) --- | Gathers all fields for a RecurringChild status. -parseChildFromObject o = - RecurringChild <$> o .: "recur" <*> o .: "imask" <*> o .: "parent" - --- | Gathers all fields for a RecurringParent status. -parseParentFromObject o = RecurringParent <$> o .: "recur" <*> o .: "mask" - --- | A list of Pairs can be used to construct a JSON object later. The result of Status.toPairs is supposed to be combined with the rest of the fields of a task. +-- | 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] - RecurringParent {..} -> - [statusLabel "recurring", "recur" .= recur, "mask" .= mask] - RecurringChild {..} -> - [ statusLabel "recurring" - , "recur" .= recur - , "imask" .= imask - , "parent" .= parent - ] + Recurring {..} -> [statusLabel "recurring", "recur" .= recur, "mask" .= mask] where statusLabel :: Text -> Pair statusLabel = ("status" .=) + +instance FromJSON Status where + parseJSON = withObject "Status" parseFromObject + +instance ToJSON Status where + toJSON = object . toPairs + toEncoding = pairs . mconcat . map (uncurry (.=)) . toPairs diff --git a/src/Taskwarrior/Task.hs b/src/Taskwarrior/Task.hs --- a/src/Taskwarrior/Task.hs +++ b/src/Taskwarrior/Task.hs @@ -1,13 +1,24 @@ -{-# LANGUAGE NamedFieldPuns #-} -- | 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 +import Prelude hiding ( id ) + import qualified Data.Text as Text import Data.Text ( Text ) import Data.Time ( UTCTime ) @@ -26,11 +37,14 @@ , 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 ) @@ -39,33 +53,36 @@ import qualified Data.HashMap.Strict as HashMap import Foreign.Marshal.Utils ( fromBool ) --- | A Task represents a task from taskwarrior. See for the specification of the fields. +-- | 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. +-- 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) HashMap. +-- 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, - uuid :: UUID, - entry :: UTCTime, - description :: Text, - start :: Maybe UTCTime, - modified :: Maybe UTCTime, - due :: Maybe UTCTime, - until :: Maybe UTCTime, - annotations :: [Annotation], - scheduled :: Maybe UTCTime, - project :: Maybe Text, - priority :: Maybe Priority, - depends :: [UUID], - tags :: [Tag], - uda :: UDA + 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 :: [Annotation], + scheduled :: Maybe UTCTime, + project :: Maybe Text, + priority :: Maybe Priority, + depends :: [UUID], + tags :: [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. +-- | 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 @@ -73,6 +90,7 @@ reservedKeys = [ "status" , "uuid" + , "id" , "description" , "entry" , "modified" @@ -91,14 +109,18 @@ , "imask" , "parent" , "recur" + , "urgency" ] instance FromJSON Task where parseJSON = withObject "Task" $ \object -> do let parseTimeFromFieldMay = parseFromFieldWithMay Time.parse object uda = HashMap.filterWithKey (\k _ -> k `notElem` reservedKeys) object - status <- Status.parseFromObject object - uuid <- object .: "uuid" + status <- Status.parseFromObject object + recurringChild <- RecurringChild.parseFromObjectMay object + uuid <- object .: "uuid" + idRaw <- object .: "id" + let id = if idRaw == 0 then Nothing else Just idRaw entry <- object .: "entry" >>= Time.parse description <- object .: "description" start <- parseTimeFromFieldMay "start" @@ -112,6 +134,7 @@ <$> parseFromFieldWithMay Priority.parseMay object "priority" depends <- maybe (pure []) parseUuidList (HashMap.lookup "depends" object) tags <- Foldable.fold <$> object .:? "tags" + urgency <- object .: "urgency" pure Task { until = until_, .. } parseFromFieldWithMay @@ -131,9 +154,12 @@ Aeson.object $ Status.toPairs status <> [ "uuid" .= uuid + , "id" .= fromMaybe 0 id , "entry" .= Time.toValue entry , "description" .= description + , "urgency" .= urgency ] + <> maybe [] RecurringChild.toPairs recurringChild <> ifNotNullList annotations ("annotations" .=) <> Maybe.mapMaybe (\(name, value) -> (name .=) . Time.toValue <$> value) @@ -161,16 +187,19 @@ makeTask uuid entry description = Task { uuid , description , entry - , modified = Just entry - , status = Status.Pending - , due = Nothing - , priority = Nothing - , project = Nothing - , start = Nothing - , scheduled = Nothing - , until = Nothing - , annotations = [] - , depends = [] - , tags = [] - , uda = HashMap.empty + , id = Nothing + , modified = Just entry + , status = Status.Pending + , recurringChild = Nothing + , due = Nothing + , priority = Nothing + , project = Nothing + , start = Nothing + , scheduled = Nothing + , until = Nothing + , annotations = [] + , depends = [] + , tags = [] + , urgency = 0 + , uda = HashMap.empty } diff --git a/src/Taskwarrior/UDA.hs b/src/Taskwarrior/UDA.hs --- a/src/Taskwarrior/UDA.hs +++ b/src/Taskwarrior/UDA.hs @@ -1,4 +1,4 @@ --- | User defined attributes are stored in a HashMap from Text to json Values because we have no type information about them. +-- | 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 ) diff --git a/taskwarrior.cabal b/taskwarrior.cabal --- a/taskwarrior.cabal +++ b/taskwarrior.cabal @@ -4,7 +4,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.1.2.4 +version: 0.2.0.0 synopsis: Types and aeson instances for taskwarrior tasks description: Types and aeson instances for the https://taskwarrior.org task import/export feature @@ -20,6 +20,10 @@ CHANGELOG.md README.md +source-repository head + type: git + location: git://github.com/maralorn/haskell-taskwarrior.git + library ghc-options: -Wall exposed-modules: @@ -27,6 +31,7 @@ Taskwarrior.IO Taskwarrior.Mask Taskwarrior.Priority + Taskwarrior.RecurringChild Taskwarrior.Status Taskwarrior.Task Taskwarrior.Time @@ -34,6 +39,7 @@ default-extensions: LambdaCase + NamedFieldPuns OverloadedStrings RecordWildCards StrictData diff --git a/test/TaskSpec.hs b/test/TaskSpec.hs --- a/test/TaskSpec.hs +++ b/test/TaskSpec.hs @@ -4,12 +4,16 @@ ) where +import Prelude hiding ( id ) +import Control.Arrow ( second ) + 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 @@ -19,7 +23,6 @@ import Test.QuickCheck.Instances.UnorderedContainers ( ) - prop_taskDeEncode :: Task -> Property prop_taskDeEncode task = Just task === decode (encode task) @@ -44,10 +47,12 @@ , Deleted <$> arbitrary , Completed <$> arbitrary , Waiting <$> arbitrary - , RecurringParent <$> arbitrary <*> arbitrary - , RecurringChild <$> arbitrary <*> arbitrary <*> arbitrary + , Recurring <$> arbitrary <*> arbitrary ] +instance Arbitrary RecurringChild where + arbitrary = RecurringChild <$> arbitrary <*> arbitrary <*> arbitrary + instance Arbitrary UTCTime where arbitrary = do day <- ModifiedJulianDay <$> arbitrary @@ -65,8 +70,12 @@ 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 description <- arbitrary start <- arbitrary @@ -79,5 +88,6 @@ priority <- arbitrary depends <- arbitrary tags <- arbitrary - uda <- HashMap.fromList . fmap (\(x, y) -> (x, String y)) <$> arbitrary + urgency <- arbitrary + uda <- HashMap.fromList . fmap (second String) <$> arbitrary pure Task { until = until_, .. }