1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
|
{-# LANGUAGE TemplateHaskell #-}
module Taskell.IO where
import ClassyPrelude
import Control.Monad.Reader (runReader)
import Data.FileEmbed (embedFile)
import Data.Text.Encoding (decodeUtf8With)
import System.Directory (doesFileExist, getCurrentDirectory)
import Data.Time.Zones (TZ)
import Taskell.Config (usage, version)
import Taskell.Data.Lists (Lists, analyse, initial)
import Taskell.IO.Config (Config, general, github, markdown, trello)
import Taskell.IO.Config.General (filename)
import qualified Taskell.IO.Config.GitHub as GitHub (token)
import qualified Taskell.IO.Config.Trello as Trello (token)
import Taskell.IO.Markdown (MarkdownInfo (MarkdownInfo), parse, serialize)
import qualified Taskell.IO.HTTP.GitHub as GitHub (GitHubIdentifier, getLists)
import qualified Taskell.IO.HTTP.Trello as Trello (TrelloBoardID, getLists)
import Taskell.UI.CLI (PromptYN (PromptYes), promptYN)
data IOInfo = IOInfo
{ ioTZ :: TZ
, ioConfig :: Config
}
type ReaderConfig a = ReaderT IOInfo IO a
data Next
= Output Text
| Error Text
| Load FilePath
Lists
| Exit
parseArgs :: [Text] -> ReaderConfig Next
parseArgs ["-v"] = pure $ Output version
parseArgs ["-h"] = pure $ Output usage
parseArgs ["-t", boardID, file] = loadTrello boardID file
parseArgs ["-g", identifier, file] = loadGitHub identifier file
parseArgs ["-i", file] = fileInfo file
parseArgs [file] = loadFile file
parseArgs [] = (pack . filename . general <$> asks ioConfig) >>= loadFile
parseArgs _ = pure $ Error (unlines ["Invalid options", "", usage])
load :: ReaderConfig Next
load = getArgs >>= parseArgs
colonic :: FilePath -> Text -> Text
colonic path = ((pack path <> ": ") <>)
loadFile :: Text -> ReaderConfig Next
loadFile filepath = do
mPath <- exists filepath
case mPath of
Nothing -> pure Exit
Just path -> either (Error . colonic path) (Load path) <$> readData path
loadRemote :: (token -> FilePath -> ReaderConfig Next) -> token -> Text -> ReaderConfig Next
loadRemote createFn identifier filepath = do
let path = unpack filepath
exists' <- fileExists path
if exists'
then pure $ Error (filepath <> " already exists")
else createFn identifier path
loadTrello :: Trello.TrelloBoardID -> Text -> ReaderConfig Next
loadTrello = loadRemote createTrello
loadGitHub :: GitHub.GitHubIdentifier -> Text -> ReaderConfig Next
loadGitHub = loadRemote createGitHub
fileInfo :: Text -> ReaderConfig Next
fileInfo filepath = do
let path = unpack filepath
exists' <- fileExists path
if exists'
then either (Error . colonic path) (Output . analyse filepath) <$> readData path
else pure $ Error (filepath <> " does not exist")
createRemote ::
(Config -> Maybe token)
-> Text
-> (token -> ReaderT token IO (Either Text Lists))
-> token
-> FilePath
-> ReaderConfig Next
createRemote tokenFn missingToken getFn identifier path = do
config <- asks ioConfig
tz <- asks ioTZ
case tokenFn config of
Nothing -> pure $ Error missingToken
Just token -> do
lists <- lift $ runReaderT (getFn identifier) token
case lists of
Left txt -> pure $ Error txt
Right ls ->
promptCreate path >>=
bool (pure Exit) (Load path ls <$ lift (writeData tz config ls path))
createTrello :: Trello.TrelloBoardID -> FilePath -> ReaderConfig Next
createTrello =
createRemote
(Trello.token . trello)
(decodeUtf8 $(embedFile "templates/trello-token.txt"))
Trello.getLists
createGitHub :: GitHub.GitHubIdentifier -> FilePath -> ReaderConfig Next
createGitHub =
createRemote
(GitHub.token . github)
(decodeUtf8 $(embedFile "templates/github-token.txt"))
GitHub.getLists
exists :: Text -> ReaderConfig (Maybe FilePath)
exists filepath = do
let path = unpack filepath
exists' <- fileExists path
if exists'
then pure $ Just path
else promptCreate path >>= bool (pure Nothing) (Just path <$ createPath path)
fileExists :: FilePath -> ReaderConfig Bool
fileExists path = lift $ doesFileExist path
promptCreate :: FilePath -> ReaderConfig Bool
promptCreate path = do
cwd <- lift $ pack <$> getCurrentDirectory
lift $ promptYN PromptYes $ concat ["Create ", cwd, "/", pack path, "?"]
-- creates taskell file
createPath :: FilePath -> ReaderConfig ()
createPath path = do
config <- asks ioConfig
tz <- asks ioTZ
lift (writeData tz config initial path)
-- writes Tasks to json file
writeData :: TZ -> Config -> Lists -> FilePath -> IO ()
writeData tz config tasks path = void (writeFile path output)
where
output = encodeUtf8 $ runReader (serialize tasks) (MarkdownInfo tz (markdown config))
-- reads json file
decodeError :: String -> Maybe Word8 -> Maybe Char
decodeError _ _ = Just '\65533'
readData :: FilePath -> ReaderConfig (Either Text Lists)
readData path =
parse <$> (markdown <$> asks ioConfig) <*> (decodeUtf8With decodeError <$> readFile path)
|
