{- | 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 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 :: [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."