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
import qualified Data.ByteString.Lazy.Char8 as LBSC
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,
)
getTasks :: [Text] -> IO [Task]
getTasks :: [Text] -> IO [Task]
getTasks [Text]
args =
forall a.
CreateProcess
-> (Maybe Handle
-> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess
( (FilePath -> [FilePath] -> CreateProcess
proc FilePath
"task" (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> FilePath
Text.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++ [Text
"export"]) forall a b. (a -> b) -> a -> b
$ [Text]
args))
{ std_out :: StdStream
std_out = StdStream
CreatePipe
}
)
forall a b. (a -> b) -> a -> b
$ \Maybe Handle
_ Maybe Handle
stdoutMay Maybe Handle
_ ProcessHandle
_ -> do
Handle
stdout <-
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Couldn‘t create stdout handle for `task export`")
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Maybe Handle
stdoutMay
ByteString
input <- Handle -> IO ByteString
LBS.hGetContents Handle
stdout
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => ByteString -> Either FilePath a
Aeson.eitherDecode forall a b. (a -> b) -> a -> b
$ ByteString
input
getUUIDs :: [Text] -> IO [UUID]
getUUIDs :: [Text] -> IO [UUID]
getUUIDs [Text]
args =
forall a.
CreateProcess
-> (Maybe Handle
-> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess
( (FilePath -> [FilePath] -> CreateProcess
proc FilePath
"task" (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> FilePath
Text.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++ [Text
"_uuid"]) forall a b. (a -> b) -> a -> b
$ [Text]
args))
{ std_out :: StdStream
std_out = StdStream
CreatePipe
}
)
forall a b. (a -> b) -> a -> b
$ \Maybe Handle
_ Maybe Handle
stdoutMay Maybe Handle
_ ProcessHandle
_ -> do
Handle
stdout <-
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Couldn‘t create stdout handle for `task _uuid`")
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Maybe Handle
stdoutMay
ByteString
input <- Handle -> IO ByteString
LBS.hGetContents Handle
stdout
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Couldn't parse UUIDs") forall (m :: * -> *) a. Monad m => a -> m a
return
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ByteString -> Maybe UUID
UUID.fromLazyASCIIBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
LBSC.lines
forall a b. (a -> b) -> a -> b
$ ByteString
input
saveTasks :: [Task] -> IO ()
saveTasks :: [Task] -> IO ()
saveTasks [Task]
tasks =
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}) forall a b. (a -> b) -> a -> b
$
\Maybe Handle
stdinMay Maybe Handle
_ Maybe Handle
_ ProcessHandle
process -> do
Handle
stdin <-
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Couldn‘t create stdin handle for `task import`")
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Maybe Handle
stdinMay
Handle -> ByteString -> IO ()
LBS.hPut Handle
stdin forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
Aeson.encode forall a b. (a -> b) -> a -> b
$ [Task]
tasks
Handle -> IO ()
hClose Handle
stdin
ExitCode
exitCode <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
process
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ExitCode
exitCode forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show forall a b. (a -> b) -> a -> b
$ ExitCode
exitCode
createTask :: Text -> IO Task
createTask :: Text -> IO Task
createTask Text
description = do
UUID
uuid <- forall (m :: * -> *) a. MonadIO m => (StdGen -> (a, StdGen)) -> m a
getStdRandom forall a g. (Random a, RandomGen g) => g -> (a, g)
random
UTCTime
entry <- IO UTCTime
getCurrentTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ UUID -> UTCTime -> Text -> Task
makeTask UUID
uuid UTCTime
entry Text
description
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 -> 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."
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 ()
LBSC.putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
Aeson.encode 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 =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
errorMsg) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => ByteString -> Maybe a
Aeson.decode' forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.fromStrict forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO ByteString
BS.getLine
onAddPure :: (Task -> Task) -> IO ()
onAddPure :: (Task -> Task) -> IO ()
onAddPure Task -> Task
f = (Task -> IO Task) -> IO ()
onAdd (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Task -> Task
f)
onAdd :: (Task -> IO Task) -> IO ()
onAdd :: (Task -> IO Task) -> IO ()
onAdd Task -> IO Task
f =
ByteString -> IO ()
LBSC.putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
Aeson.encode forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Task -> IO Task
f
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO Task
readTaskLine
FilePath
"OnAdd hook couldn‘t parse task."