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

-- | Uses @task export@ with a given filter like @["description:Milk", "+PENDING"]@.
getTasks :: [Text] -> IO [Task]
getTasks :: [Text] -> IO [Task]
getTasks [Text]
args =
  CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO [Task])
-> IO [Task]
forall a.
CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess
      ((FilePath -> [FilePath] -> CreateProcess
proc FilePath
"task" ((Text -> FilePath) -> [Text] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> FilePath
Text.unpack ([Text] -> [FilePath])
-> ([Text] -> [Text]) -> [Text] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"export"]) ([Text] -> [FilePath]) -> [Text] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [Text]
args))
        { std_out :: StdStream
std_out = StdStream
CreatePipe
        }
      )
    ((Maybe Handle
  -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO [Task])
 -> IO [Task])
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO [Task])
-> IO [Task]
forall a b. (a -> b) -> a -> b
$ \Maybe Handle
_ Maybe Handle
stdoutMay Maybe Handle
_ ProcessHandle
_ -> do
        Handle
stdout <- IO Handle -> (Handle -> IO Handle) -> Maybe Handle -> IO Handle
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          (FilePath -> IO Handle
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Couldn‘t create stdout handle for `task export`")
          Handle -> IO Handle
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          Maybe Handle
stdoutMay
        ByteString
input <- Handle -> IO ByteString
LBS.hGetContents Handle
stdout
        (FilePath -> IO [Task])
-> ([Task] -> IO [Task]) -> Either FilePath [Task] -> IO [Task]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> IO [Task]
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail [Task] -> IO [Task]
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath [Task] -> IO [Task])
-> (ByteString -> Either FilePath [Task])
-> ByteString
-> IO [Task]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either FilePath [Task]
forall a. FromJSON a => ByteString -> Either FilePath a
Aeson.eitherDecode (ByteString -> IO [Task]) -> ByteString -> IO [Task]
forall a b. (a -> b) -> a -> b
$ ByteString
input

-- | Gives all uuids matching the given filter (e.g. @["description:Milk", "+PENDING"]@). This calls the @task@ binary.
getUUIDs :: [Text] -> IO [UUID]
getUUIDs :: [Text] -> IO [UUID]
getUUIDs [Text]
args =
  CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO [UUID])
-> IO [UUID]
forall a.
CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess
      ((FilePath -> [FilePath] -> CreateProcess
proc FilePath
"task" ((Text -> FilePath) -> [Text] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> FilePath
Text.unpack ([Text] -> [FilePath])
-> ([Text] -> [Text]) -> [Text] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"_uuid"]) ([Text] -> [FilePath]) -> [Text] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [Text]
args)) { std_out :: StdStream
std_out = StdStream
CreatePipe
                                                                }
      )
    ((Maybe Handle
  -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO [UUID])
 -> IO [UUID])
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO [UUID])
-> IO [UUID]
forall a b. (a -> b) -> a -> b
$ \Maybe Handle
_ Maybe Handle
stdoutMay Maybe Handle
_ ProcessHandle
_ -> do
        Handle
stdout <- IO Handle -> (Handle -> IO Handle) -> Maybe Handle -> IO Handle
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          (FilePath -> IO Handle
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Couldn‘t create stdout handle for `task _uuid`")
          Handle -> IO Handle
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          Maybe Handle
stdoutMay
        ByteString
input <- Handle -> IO ByteString
LBS.hGetContents Handle
stdout
        IO [UUID] -> ([UUID] -> IO [UUID]) -> Maybe [UUID] -> IO [UUID]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> IO [UUID]
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Couldn't parse UUIDs") [UUID] -> IO [UUID]
forall (m :: * -> *) a. Monad m => a -> m a
return
          (Maybe [UUID] -> IO [UUID])
-> (ByteString -> Maybe [UUID]) -> ByteString -> IO [UUID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Maybe UUID) -> [ByteString] -> Maybe [UUID]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ByteString -> Maybe UUID
UUID.fromLazyASCIIBytes
          ([ByteString] -> Maybe [UUID])
-> (ByteString -> [ByteString]) -> ByteString -> Maybe [UUID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
LBS.lines
          (ByteString -> IO [UUID]) -> ByteString -> IO [UUID]
forall a b. (a -> b) -> a -> b
$ ByteString
input

-- | Uses @task import@ to save the given tasks.
saveTasks :: [Task] -> IO ()
saveTasks :: [Task] -> IO ()
saveTasks [Task]
tasks =
  CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO ())
-> IO ()
forall a.
CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess ((FilePath -> [FilePath] -> CreateProcess
proc FilePath
"task" [FilePath
"import"]) { std_in :: StdStream
std_in = StdStream
CreatePipe })
    ((Maybe Handle
  -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO ())
 -> IO ())
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ \Maybe Handle
stdinMay Maybe Handle
_ Maybe Handle
_ ProcessHandle
process -> do
        Handle
stdin <- IO Handle -> (Handle -> IO Handle) -> Maybe Handle -> IO Handle
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> IO Handle
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Couldn‘t create stdin handle for `task import`")
                       Handle -> IO Handle
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                       Maybe Handle
stdinMay
        Handle -> ByteString -> IO ()
LBS.hPut Handle
stdin (ByteString -> IO ()) -> ([Task] -> ByteString) -> [Task] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Task] -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode ([Task] -> IO ()) -> [Task] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Task]
tasks
        Handle -> IO ()
hClose Handle
stdin
        ExitCode
exitCode <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
process
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ExitCode
exitCode ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO ()) -> (ExitCode -> FilePath) -> ExitCode -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExitCode -> FilePath
forall a. Show a => a -> FilePath
show (ExitCode -> IO ()) -> ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ ExitCode
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"] }]
-- @
createTask :: Text -> IO Task
createTask :: Text -> IO Task
createTask Text
description = do
  UUID
uuid  <- (StdGen -> (UUID, StdGen)) -> IO UUID
forall (m :: * -> *) a. MonadIO m => (StdGen -> (a, StdGen)) -> m a
getStdRandom StdGen -> (UUID, StdGen)
forall a g. (Random a, RandomGen g) => g -> (a, g)
random
  UTCTime
entry <- IO UTCTime
getCurrentTime
  Task -> IO Task
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Task -> IO Task) -> Task -> IO Task
forall a b. (a -> b) -> a -> b
$ UUID -> UTCTime -> Text -> Task
makeTask UUID
uuid UTCTime
entry Text
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.
onModifyPure :: (Task -> Task -> Task) -> IO ()
onModifyPure :: (Task -> Task -> Task) -> IO ()
onModifyPure Task -> Task -> Task
f = (Task -> Task -> IO Task) -> IO ()
onModify (\Task
x Task
y -> Task -> IO Task
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Task -> Task -> Task
f Task
x Task
y))

onModifyError :: String
onModifyError :: FilePath
onModifyError = FilePath
"OnModify hook couldn‘t parse task."

-- | Like onModifyPure but with side effects.
onModify :: (Task -> Task -> IO Task) -> IO ()
onModify :: (Task -> Task -> IO Task) -> IO ()
onModify Task -> Task -> IO Task
f = do
  Task
original <- FilePath -> IO Task
readTaskLine FilePath
onModifyError
  Task
modified <- FilePath -> IO Task
readTaskLine FilePath
onModifyError
  ByteString -> IO ()
LBS.putStrLn (ByteString -> IO ()) -> (Task -> ByteString) -> Task -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Task -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode (Task -> IO ()) -> IO Task -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Task -> Task -> IO Task
f Task
original Task
modified

readTaskLine :: String -> IO Task
readTaskLine :: FilePath -> IO Task
readTaskLine FilePath
errorMsg =
  IO Task -> (Task -> IO Task) -> Maybe Task -> IO Task
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> IO Task
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
errorMsg) Task -> IO Task
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Task -> IO Task)
-> (ByteString -> Maybe Task) -> ByteString -> IO Task
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe Task
forall a. FromJSON a => ByteString -> Maybe a
Aeson.decode' (ByteString -> Maybe Task)
-> (ByteString -> ByteString) -> ByteString -> Maybe Task
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.fromStrict (ByteString -> IO Task) -> IO ByteString -> IO Task
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO ByteString
BS.getLine

-- | Like onModifyPure but for the onAdd hook.
onAddPure :: (Task -> Task) -> IO ()
onAddPure :: (Task -> Task) -> IO ()
onAddPure Task -> Task
f = (Task -> IO Task) -> IO ()
onAdd (Task -> IO Task
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Task -> IO Task) -> (Task -> Task) -> Task -> IO Task
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Task -> Task
f)

-- | Like onAddPure with side effects.
onAdd :: (Task -> IO Task) -> IO ()
onAdd :: (Task -> IO Task) -> IO ()
onAdd Task -> IO Task
f = ByteString -> IO ()
LBS.putStrLn (ByteString -> IO ()) -> (Task -> ByteString) -> Task -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Task -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode (Task -> IO ()) -> IO Task -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Task -> IO Task
f (Task -> IO Task) -> IO Task -> IO Task
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO Task
readTaskLine
  FilePath
"OnAdd hook couldn‘t parse task."