Update documentation a bit.
[todos:todos.git] / Todos / CmdLine.hs
1 {-# LANGUAGE UnicodeSyntax, PatternGuards #-}
2
3 -- | Module for parsing command line options and build queries
4 module Todos.CmdLine
5   (parseCmdLine',
6    glob,
7    buildQuery,
8    compose,
9    usage)
10   where
11
12 import Prelude hiding (putStrLn,readFile,getContents,print)
13 import Todos.IO
14 import System (getArgs)
15 import System.Console.GetOpt
16 import System.FilePath.Glob
17 import Data.Maybe
18 import Data.List (sort)
19 import Control.Monad.Reader
20
21 import Todos.Unicode
22 import Todos.Types
23 import Todos.Tree
24 import Todos.Config
25 import Todos.Dates (parseDate)
26
27 -- | Compose predicate from Composed
28 compose โˆท DateTime       -- ^ Current date/time
29         โ†’ Composed       -- ^ Composed query
30         โ†’ (TodoItem โ†’ ๐”น)
31 compose _ Empty             = const True
32 compose _ (Pred NoFilter)   = const True
33 compose _ (Pred (Tag s))    = tagPred s
34 compose _ (Pred (Name s))   = grepPred s
35 compose _ (Pred (Description s))   = descPred s
36 compose _ (Pred (Status s)) = statusPred s
37 compose _ (Pred (IdIs s)) = idPred s
38 compose dt (Pred (StartDateIs d)) = datePred startDate dt d
39 compose dt (Pred (EndDateIs d)) = datePred endDate dt d
40 compose dt (Pred (DeadlineIs d)) = datePred deadline dt d
41 compose dt (Not p)           = not โˆ˜ (compose dt p)
42 compose dt (And (Pred NoFilter) p) = compose dt p
43 compose dt (And p (Pred NoFilter)) = compose dt p
44 compose dt (And p1 p2)      = \item โ†’ (compose dt p1 item) โˆง (compose dt p2 item)
45 compose dt (Or (Pred NoFilter) p) = compose dt p
46 compose dt (Or p (Pred NoFilter)) = compose dt p
47 compose dt (Or p1 p2)       = \item โ†’ (compose dt p1 item) โˆจ (compose dt p2 item)
48 compose _ x = error $ show x
49
50 appendC โˆท Composed โ†’ QueryFlag โ†’ Composed
51 appendC (Not (Pred NoFilter))   f = Not (Pred f)
52 appendC Empty OrCons              = (Pred NoFilter) `Or` (Pred NoFilter)
53 appendC Empty AndCons             = (Pred NoFilter) `And` (Pred NoFilter)
54 appendC Empty NotCons             = Not (Pred NoFilter)
55 appendC Empty f                   = Pred f
56 appendC c NoFilter                = c
57 appendC c AndCons                 = c `And` (Pred NoFilter)
58 appendC c OrCons                  = c `Or`  (Pred NoFilter)
59 appendC c NotCons                 = c `And` (Pred NoFilter)
60 appendC (And c (Pred NoFilter)) f = c `And` (Pred f) 
61 appendC (And (Pred NoFilter) c) f = c `And` (Pred f) 
62 appendC c@(And _ _)             f = c `And` (Pred f)
63 appendC (Or c (Pred NoFilter))  f = c `Or`  (Pred f)
64 appendC (Or (Pred NoFilter) c)  f = c `Or`  (Pred f)
65 appendC c@(Or _ _)              f = c `Or`  (Pred f)
66 appendC c@(Pred _)              f = c `And` (Pred f)
67 appendC c                       f = c `And` (Pred f)
68
69 appendF (O q m o l) (QF f) = O (f:q) m o l
70 appendF (O q m o l) (MF f) = O q (f:m) o l
71 appendF (O q m o l) (OF f) = O q m (f:o) l
72 appendF (O q m o l) (LF f) = O q m o (f:l)
73 appendF _ HelpF = Help
74
75 parseFlags โˆท [CmdLineFlag] โ†’ Options
76 parseFlags lst | HelpF โˆˆ lst = Help
77 parseFlags [] = O [] [] [] []
78 parseFlags (f:fs) = (parseFlags fs) `appendF` f
79
80 -- | Build DefaultConfig (with query etc) from Options
81 buildQuery โˆท BaseConfig    -- ^ Default config
82            โ†’ Options       -- ^ Cmdline options
83            โ†’ DefaultConfig
84 buildQuery dc (O qflags mflags oflags lflags) =
85     DConfig {
86       baseConfig = BConfig {
87           outOnlyFirst = update outOnlyFirst onlyFirst,
88           outColors    = update outColors    colors,
89           outIds       = update outIds       showIds,
90           outHighlight = update outHighlight highlight,
91           sorting      = update sorting      srt,
92           pruneL       = update pruneL       limitP,
93           minL         = update minL         limitM,
94           commandToRun = update commandToRun command,
95           prefix       = update prefix       aprefix,
96           descrFormat  = update descrFormat  dformat,
97           skipStatus   = update skipStatus   noStatus,
98           groupByFile  = update groupByFile  doGroupByFile,
99           groupByTag   = update groupByTag   doGroupByTag,
100           groupByStatus = update groupByStatus doGroupByStatus,
101           forcedStatus = update forcedStatus setStatus,
102           topStatus    = update topStatus    setTopStatus },
103       query        = fromMaybe Empty composedFlags }
104   where
105     update fn Nothing  = fn dc
106     update _  (Just x) = x
107
108     x ? lst | x โˆˆ lst   = Just True
109             | otherwise = Nothing
110
111     composedFlags | null qflags = Nothing
112                   | otherwise   = Just $ parseQuery qflags
113     (limitP,limitM) | null lflags = (Nothing, Nothing)
114                     | otherwise   = parseLimits (unLimit $ pruneL dc) (unLimit $ minL dc) lflags
115
116     onlyFirst = OnlyFirst ? oflags
117     colors    = Colors    ? oflags
118     highlight = Highlight ? oflags
119     showIds   = Ids       ? oflags
120
121     srtFlags = filter isSort oflags
122     srt | null srtFlags = Nothing
123         | otherwise     = Just $ getSorting (last srtFlags)
124
125     doGroupByFile   = GroupByFile   ? mflags
126     doGroupByTag    = GroupByTag    ? mflags
127     doGroupByStatus = GroupByStatus ? mflags
128
129     cmdFlags  = filter isCommand mflags
130     command | DotExport โˆˆ oflags = Just $ ShowAsDot
131             | null cmdFlags      = Nothing
132             | otherwise          = Just $ SystemCommand $ unExecute (last cmdFlags)
133
134     prefixFlags = filter isPrefix mflags
135     aprefix | null prefixFlags = Nothing
136             | otherwise        = Just $ Just $ unPrefix (last prefixFlags)
137
138     dflags = filter isDescribe mflags
139     dformat | null dflags = Nothing
140             | otherwise   = Just $unDescribe $ last dflags
141
142     noStatus = DoNotReadStatus ? mflags
143     newStatusFlags = filter isSetStatus mflags
144     setStatus | null newStatusFlags = Nothing
145               | otherwise           = Just $ Just $ newStatus $ last newStatusFlags
146
147     topStatusFlags = filter isTopStatus mflags
148     setTopStatus | null topStatusFlags = Nothing
149                  | otherwise           = Just $ Just $ newTopStatus $ last topStatusFlags
150
151     isSort (Sort _) = True
152     isSort _        = False
153     isDescribe (Describe _) = True
154     isDescribe _            = False
155     isCommand (Execute _) = True
156     isCommand _           = False
157     isPrefix (Prefix _) = True
158     isPrefix _          = False
159     isNoStatus DoNotReadStatus = True
160     isNoStatus _               = False
161     isSetStatus (SetStatus _)  = True
162     isSetStatus _              = False
163     isTopStatus (SetTopStatus _) = True
164     isTopStatus _                = False
165
166 parseLimits โˆท โ„ค โ†’ โ„ค โ†’ [LimitFlag] โ†’ (Maybe Limit,Maybe Limit)
167 parseLimits dlp dlm flags = (Just limitP, Just limitM)
168   where
169     pruneFlags = filter isPrune flags
170     minFlags   = filter isMin flags
171
172     limitP'       = foldl min Unlimited $ map (Limit โˆ˜ unPrune) pruneFlags
173     limitP | Unlimited โ† limitP' = Limit dlp
174            | otherwise           = limitP'
175
176     limitM'       = foldl max (Limit 0) $ map (Limit โˆ˜ unMin) minFlags
177     limitM | Unlimited โ† limitM' = Limit dlm
178            | otherwise           = limitM'
179
180     isPrune (Prune _) = True
181     isPrune _         = False
182
183     isMin   (Start x) = True
184     isMin   _         = False
185
186 parseQuery โˆท [QueryFlag] โ†’ Composed
187 parseQuery flags = foldl appendC Empty flags
188
189 -- | Parse command line
190 parseCmdLine' โˆท DateTime             -- ^ Current date/time
191              โ†’ [String]              -- ^ Command line args
192              โ†’ Either String (Options, [FilePath]) -- ^ Error message or (Options, list of files)
193 parseCmdLine' currDate args = 
194   case getOpt Permute (options currDate) (map decodeString args) of
195         (flags, [],      [])     โ†’ Right (parseFlags flags, ["TODO"])
196         (flags, nonOpts, [])     โ†’ Right (parseFlags flags, nonOpts)
197         (_,     _,       msgs)   โ†’ Left $ concat msgs โงบ usage
198
199 isPattern s = ('*' โˆˆ s) || ('?' โˆˆ s)
200
201 -- | For given list of glob masks, return list of matching files
202 glob โˆท [FilePath] โ†’ IO [FilePath]
203 glob list = do
204   let patterns = filter isPattern list
205       files = filter (not โˆ˜ isPattern) list
206   (matches, _) โ† globDir (map compile patterns) "." 
207   return $ sort $ files โงบ concat matches
208
209 -- | Usage help for default command line options
210 usage โˆท  String
211 usage = usageInfo header (options undefined)
212   where 
213     header = "Usage: todos [OPTION...] [INPUT FILES]"
214
215 options โˆท DateTime โ†’ [OptDescr CmdLineFlag]
216 options currDate = [
217     Option "1" ["only-first"] (NoArg (OF OnlyFirst))                 "show only first matching entry",
218     Option "c" ["color"]      (NoArg (OF Colors))                    "show colored output",
219     Option "H" ["highlight"]  (NoArg (OF Highlight))                 "instead of filtering TODOs, just highlight matching the query",
220     Option "I" ["show-ids"]   (NoArg (OF Ids))                       "show IDs of todos",
221     Option "A" ["prefix"]     (OptArg mkPrefix "PREFIX")             "use alternate parser: read only lines starting with PREFIX",
222     Option ""  ["dot"]        (NoArg (OF DotExport))                 "output entries in DOT (graphviz) format",
223     Option "D" ["describe"]   (OptArg mkDescribe "FORMAT")           "use FORMAT for descriptions",
224     Option "w" ["no-status"]  (NoArg (MF DoNotReadStatus))           "do not read status field from TODOs",
225     Option ""  ["set-status"] (ReqArg mkSetStatus "STRING")          "force all TODOs status to be equal to STRING",
226     Option ""  ["set-root-status"] (ReqArg mkTopStatus "STRING")     "force statuses of root TODOs to be equal to STRING",
227     Option "F" ["by-file"]    (NoArg (MF GroupByFile))               "group TODOs by source file",
228     Option "T" ["by-tag"]     (NoArg (MF GroupByTag))                "group TODOs by tag",
229     Option "Z" ["by-status"]  (NoArg (MF GroupByStatus))             "group TODOs by status",
230     Option "p" ["prune"]      (ReqArg mkPrune "N")                   "limit tree height to N",
231     Option "m" ["min-depth"]  (ReqArg mkMin "N")                     "show first N levels of tree unconditionally",
232     Option "t" ["tag"]        (ReqArg mkTag "TAG")                   "find items marked with TAG",
233     Option "g" ["grep"]       (ReqArg mkName "PATTERN")              "find items with PATTERN in name",
234     Option "G" ["description"] (ReqArg mkDescr "PATTERN")            "find items with PATTERN in description",
235     Option "s" ["status"]     (ReqArg mkStatus "STRING")             "find items with status equal to STRING",
236     Option "i" ["id"]         (ReqArg mkIdQ "STRING")                "find items with ID equal to STRING",
237     Option "a" ["and"]        (NoArg (QF AndCons))                   "logical AND",
238     Option "o" ["or"]         (NoArg (QF OrCons))                    "logical OR",
239     Option "n" ["not"]        (NoArg (QF NotCons))                   "logical NOT",
240     Option ""  ["sort"]       (ReqArg mkSort "FIELD")                "specify sorting",
241     Option "e" ["exec"]       (OptArg mkExecute "COMMAND")           "run COMMAND on each matching entry",
242     Option "S" ["start-date"] (ReqArg (mkStartDate currDate) "DATE") "find items with start date bounded with DATE",
243     Option "E" ["end-date"]   (ReqArg (mkEndDate currDate) "DATE")   "find items with end date bounded with DATE",
244     Option "d" ["deadline"]   (ReqArg (mkDeadline currDate) "DATE")  "find items with deadline bounded with DATE",
245     Option "h" ["help"]       (NoArg HelpF)                          "display this help"
246   ]
247
248 mkSort s = OF $ Sort $ readSort s
249
250 mkTag โˆท  String โ†’ CmdLineFlag
251 mkTag t = QF $ Tag t
252
253 mkName โˆท  String โ†’ CmdLineFlag
254 mkName n = QF $ Name n
255
256 mkStatus โˆท  String โ†’ CmdLineFlag
257 mkStatus s = QF $ Status s
258
259 mkIdQ โˆท  String โ†’ CmdLineFlag
260 mkIdQ s = QF $ IdIs s
261
262 mkDescr โˆท  String โ†’ CmdLineFlag
263 mkDescr s = QF $ Description s
264
265 forceEither โˆท  (Show t) โ‡’ Either t b โ†’ b
266 forceEither (Right x) = x
267 forceEither (Left x) = error $ show x
268
269 mkStartDate โˆท  DateTime โ†’ String โ†’ CmdLineFlag
270 mkStartDate dt s = QF $ StartDateIs $ forceEither $ parseDate undefined dt s
271
272 mkEndDate โˆท  DateTime โ†’ String โ†’ CmdLineFlag
273 mkEndDate dt s = QF $ EndDateIs $ forceEither $ parseDate undefined dt s
274
275 mkDeadline โˆท  DateTime โ†’ String โ†’ CmdLineFlag
276 mkDeadline dt s = QF $ DeadlineIs $ forceEither $ parseDate undefined dt s
277
278 mkDescribe โˆท  Maybe String โ†’ CmdLineFlag
279 mkDescribe Nothing = MF $ Describe "%d"
280 mkDescribe (Just f) = MF $ Describe f
281
282 mkSetStatus โˆท String โ†’ CmdLineFlag
283 mkSetStatus st = MF $ SetStatus st
284
285 mkTopStatus โˆท String โ†’ CmdLineFlag
286 mkTopStatus st = MF $ SetTopStatus st
287
288 mkPrune โˆท  String โ†’ CmdLineFlag
289 mkPrune s = LF $ Prune (read s)
290
291 mkMin โˆท  String โ†’ CmdLineFlag
292 mkMin s = LF $ Start (read s)
293
294 mkPrefix โˆท  Maybe [Char] โ†’ CmdLineFlag
295 mkPrefix = MF โˆ˜ Prefix โˆ˜ fromMaybe "TODO:"
296
297 mkExecute โˆท  Maybe [Char] โ†’ CmdLineFlag
298 mkExecute = MF โˆ˜ Execute โˆ˜ fromMaybe "echo %n %d"