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

import           Taskwarrior.Task               ( Task
                                                , makeTask
                                                )
import           Data.Text                      ( Text )
import qualified Data.Text                     as Text
import qualified Data.ByteString.Lazy          as LBS
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 args :: [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 "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]
++ ["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
$ \_ stdoutMay :: Maybe Handle
stdoutMay _ _ -> 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 "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 args :: [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 "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]
++ ["_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
$ \_ stdoutMay :: Maybe Handle
stdoutMay _ _ -> 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 "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 "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 tasks :: [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 "task" ["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
$ \stdinMay :: Maybe Handle
stdinMay _ _ process :: 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 "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 description :: Text
description = do
  UUID
uuid  <- (StdGen -> (UUID, StdGen)) -> IO UUID
forall a. (StdGen -> (a, StdGen)) -> IO 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