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,
)
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
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
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
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
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."
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
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)
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."