Switch to fourmolu formatting

This commit is contained in:
Malte Brandy 2021-10-10 22:41:00 +02:00
parent c63e125e5b
commit f593b546b7
No known key found for this signature in database
GPG Key ID: 226A2D41EF5378C9
12 changed files with 483 additions and 454 deletions

View File

@ -1,4 +0,0 @@
conf_forward:
options_ghc:
- -XLambdaCase
- -XRecordWildCards

1
fourmolu.yaml Normal file
View File

@ -0,0 +1 @@
indentation: 2

View File

@ -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]

View File

@ -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 "Couldnt 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 "Couldnt 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 "Couldnt 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 "Couldnt 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 @@ onAddPure f = onAdd (pure . f)
-- | Like onAddPure with side effects.
onAdd :: (Task -> IO Task) -> IO ()
onAdd f = LBS.putStrLn . Aeson.encode =<< f =<< readTaskLine
"OnAdd hook couldnt parse task."
onAdd f =
LBS.putStrLn . Aeson.encode =<< f
=<< readTaskLine
"OnAdd hook couldnt parse task."

View File

@ -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 @@ newtype Mask = Mask {mask :: [MaskState]} deriving (Eq, Read, Ord, Show)
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 @@ instance Aeson.FromJSON Mask where
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

View File

@ -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 @@ parseMay = Aeson.withText "Priority" $ \case
"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

View File

@ -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 @@ parseFromObject o =
-- | 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

View File

@ -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 @@ instance FromJSON Status where
parseJSON = withObject "Status" parseFromObject
instance ToJSON Status where
toJSON = object . toPairs
toJSON = object . toPairs
toEncoding = pairs . mconcat . map (uncurry (.=)) . toPairs

View File

@ -1,93 +1,96 @@
-- | 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,
(.:),
(.:?),
(.=),
)
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)
{- | 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 +121,107 @@ 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
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 ","
withText "Text" $
fmap Set.fromList
. mapM (parseJSON . Aeson.String)
. Text.splitOn ","
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_)
toJSON Task{until = until_, ..} =
Aeson.object $
Status.toPairs status
<> [ "uuid" .= uuid
, "entry" .= Time.toValue entry
, "description" .= description
]
<> Maybe.catMaybes
[ ("id" .=) <$> id
, ("project" .=) <$> project
, ("priority" .=) <$> priority
]
<> 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
}

View File

@ -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

View File

@ -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

View File

@ -1,27 +1,28 @@
{-# 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 @@ prop_taskReadShow task = task === (read . show $ task)
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 @@ instance Arbitrary Mask where
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_, ..}