todos (empty) → 0.1
raw patch · 21 files changed
+1824/−0 lines, 21 filesdep +Globdep +ansi-terminaldep +basesetup-changed
Dependencies added: Glob, ansi-terminal, base, containers, directory, filepath, haskell98, mtl, parsec, process, regex-pcre, syb, time, utf8-string
Files
- CmdLine.hs +232/−0
- CommandParser.hs +26/−0
- Config.hs +88/−0
- ConstrSet.hs +40/−0
- Dates.hs +300/−0
- IO.hs +20/−0
- LICENSE +30/−0
- Makefile +8/−0
- README +91/−0
- README.ru +96/−0
- Setup.hs +2/−0
- TODO +62/−0
- TodoLoader.hs +99/−0
- TodoParser.hs +139/−0
- TodoTree.hs +134/−0
- Types.hs +328/−0
- Unicode.hs +13/−0
- test.hs +23/−0
- test.txt +11/−0
- todos.cabal +30/−0
- todos.hs +52/−0
+ CmdLine.hs view
@@ -0,0 +1,232 @@+{-# LANGUAGE UnicodeSyntax, PatternGuards #-}++-- | Module for parsing command line options and build queries+module CmdLine+ (parseCmdLine,+ glob,+ buildQuery,+ composeAll,+ usage)+ where++import Prelude hiding (putStrLn,readFile,getContents,print)+import IO+import Codec.Binary.UTF8.String+import System (getArgs)+import System.Console.GetOpt+import System.FilePath.Glob+import Data.Maybe+import Data.List (sort)+import Control.Monad.Reader++import Unicode+import Types+import TodoTree+import Dates (parseDate)++-- | Default limit for tree height+pruneByDefault ∷ Limit+pruneByDefault = Limit 20++-- | Compose predicate from Composed+compose ∷ DateTime -- ^ Current date/time+ → Composed -- ^ Composed query+ → (TodoItem → 𝔹)+compose _ Empty = const True+compose _ (Pred NoFilter) = const True+compose _ (Pred (Tag s)) = tagPred s+compose _ (Pred (Name s)) = grepPred s+compose _ (Pred (Status s)) = statusPred s+compose dt (Pred (StartDateIs d)) = datePred startDate dt d+compose dt (Pred (EndDateIs d)) = datePred endDate dt d+compose dt (Pred (DeadlineIs d)) = datePred deadline dt d+compose dt (Not p) = not ∘ (compose dt p)+compose dt (And (Pred NoFilter) p) = compose dt p+compose dt (And p (Pred NoFilter)) = compose dt p+compose dt (And p1 p2) = \item → (compose dt p1 item) ∧ (compose dt p2 item)+compose dt (Or (Pred NoFilter) p) = compose dt p+compose dt (Or p (Pred NoFilter)) = compose dt p+compose dt (Or p1 p2) = \item → (compose dt p1 item) ∨ (compose dt p2 item)+compose _ x = error $ show x++concatMapM ∷ (Monad m) ⇒ m (t → [t]) → m ([t] → [t])+concatMapM = liftM concatMap++-- | Make a list transformer+composeAll ∷ DateTime → ListTransformer+composeAll date = do+ pred ← asks ((compose date) ∘ query)+ concatMapM (pruneSelector pred)++appendC ∷ Composed → QueryFlag → Composed+appendC (Not (Pred NoFilter)) f = Not (Pred f)+appendC Empty OrCons = (Pred NoFilter) `Or` (Pred NoFilter)+appendC Empty AndCons = (Pred NoFilter) `And` (Pred NoFilter)+appendC Empty NotCons = Not (Pred NoFilter)+appendC Empty f = Pred f+appendC c NoFilter = c+appendC c AndCons = c `And` (Pred NoFilter)+appendC c OrCons = c `Or` (Pred NoFilter)+appendC c NotCons = c `And` (Pred NoFilter)+appendC (And c (Pred NoFilter)) f = c `And` (Pred f) +appendC (And (Pred NoFilter) c) f = c `And` (Pred f) +appendC c@(And _ _) f = c `And` (Pred f)+appendC (Or c (Pred NoFilter)) f = c `Or` (Pred f)+appendC (Or (Pred NoFilter) c) f = c `Or` (Pred f)+appendC c@(Or _ _) f = c `Or` (Pred f)+appendC c@(Pred _) f = c `And` (Pred f)+appendC c f = c `And` (Pred f)++appendF (O q m o l) (QF f) = O (f:q) m o l+appendF (O q m o l) (MF f) = O q (f:m) o l+appendF (O q m o l) (OF f) = O q m (f:o) l+appendF (O q m o l) (LF f) = O q m o (f:l)+appendF _ HelpF = Help++parseFlags ∷ [CmdLineFlag] → Options+parseFlags lst | HelpF ∈ lst = Help+parseFlags [] = O [] [] [] []+parseFlags (f:fs) = (parseFlags fs) `appendF` f++-- | Build Config (with query etc) from Options+buildQuery ∷ Options → Config+buildQuery (O qflags mflags oflags lflags) = Config onlyFirst colors srt limitP limitM command aprefix dformat composedFlags + where+ composedFlags = parseQuery qflags+ (limitP,limitM) = parseLimits lflags++ onlyFirst = OnlyFirst ∈ oflags+ colors = Colors ∈ oflags+ srtFlags = filter isSort oflags+ srt | null srtFlags = DoNotSort + | otherwise = getSorting (last srtFlags)++ cmdFlags = filter isCommand mflags+ command | null cmdFlags = Nothing+ | otherwise = Just $ unExecute (last cmdFlags)++ prefixFlags = filter isPrefix mflags+ aprefix | null prefixFlags = Nothing+ | otherwise = Just $ unPrefix (last prefixFlags)++ dflags = filter isDescribe mflags+ dformat | null dflags = "%d"+ | otherwise = unDescribe $ last dflags++ isSort (Sort _) = True+ isSort _ = False+ isDescribe (Describe _) = True+ isDescribe _ = False+ isCommand (Execute _) = True+ isCommand _ = False+ isPrefix (Prefix _) = True+ isPrefix _ = False++parseLimits ∷ [LimitFlag] → (Limit,Limit)+parseLimits flags = (limitP,limitM)+ where+ pruneFlags = filter isPrune flags+ minFlags = filter isMin flags++ limitP' = foldl min Unlimited $ map (Limit ∘ unPrune) pruneFlags+ limitP | Unlimited ← limitP' = pruneByDefault+ | otherwise = limitP'++ limitM' = foldl max (Limit 0) $ map (Limit ∘ unMin) minFlags+ limitM | Unlimited ← limitM' = pruneByDefault+ | otherwise = limitM'++ isPrune (Prune _) = True+ isPrune _ = False++ isMin (Start x) = True+ isMin _ = False++parseQuery ∷ [QueryFlag] → Composed+parseQuery flags = foldl appendC Empty flags++-- | Parse command line+parseCmdLine ∷ DateTime -- ^ Current date/time+ → [String] -- ^ Command line args+ → (Options, [FilePath]) -- ^ (Options, list of files)+parseCmdLine currDate args = + case getOpt Permute (options currDate) (map decodeString args) of+ (flags, [], []) → (parseFlags flags, ["TODO"])+ (flags, nonOpts, []) → (parseFlags flags, nonOpts)+ (_, _, msgs) → error $ concat msgs ⧺ usage++isPattern s = ('*' ∈ s) || ('?' ∈ s)++glob ∷ [FilePath] → IO [FilePath]+glob list = do+ let patterns = filter isPattern list+ files = filter (not ∘ isPattern) list+ (matches, _) ← globDir (map compile patterns) "." + return $ sort $ files ⧺ concat matches++usage ∷ String+usage = usageInfo header (options undefined)+ where + header = "Usage: todos [OPTION...] [INPUT FILES]"++options ∷ DateTime → [OptDescr CmdLineFlag]+options currDate = [+ Option "1" ["only-first"] (NoArg (OF OnlyFirst)) "show only first matching entry",+ Option "c" ["color"] (NoArg (OF Colors)) "show colored output",+ Option "A" ["prefix"] (OptArg mkPrefix "PREFIX") "use alternate parser: read only lines starting with PREFIX",+ Option "D" ["describe"] (OptArg mkDescribe "FORMAT") "use FORMAT for descriptions",+ Option "p" ["prune"] (ReqArg mkPrune "N") "limit tree height to N",+ Option "m" ["min-depth"] (ReqArg mkMin "N") "show first N levels of tree unconditionally",+ Option "t" ["tag"] (ReqArg mkTag "TAG") "find items marked with TAG",+ Option "g" ["grep"] (ReqArg mkName "PATTERN") "find items with PATTERN in name",+ Option "s" ["status"] (ReqArg mkStatus "STRING") "find items with status equal to STRING",+ Option "a" ["and"] (NoArg (QF AndCons)) "logical AND",+ Option "o" ["or"] (NoArg (QF OrCons)) "logical OR",+ Option "n" ["not"] (NoArg (QF NotCons)) "logical NOT",+ Option "" ["sort"] (ReqArg mkSort "FIELD") "specify sorting",+ Option "e" ["exec"] (OptArg mkExecute "COMMAND") "run COMMAND on each matching entry",+ Option "S" ["start-date"] (ReqArg (mkStartDate currDate) "DATE") "find items with start date bounded with DATE",+ Option "E" ["end-date"] (ReqArg (mkEndDate currDate) "DATE") "find items with end date bounded with DATE",+ Option "d" ["deadline"] (ReqArg (mkDeadline currDate) "DATE") "find items with deadline bounded with DATE",+ Option "h" ["help"] (NoArg HelpF) "display this help"+ ]++mkSort s = OF $ Sort $ readSort s++mkTag ∷ String → CmdLineFlag+mkTag t = QF $ Tag t++mkName ∷ String → CmdLineFlag+mkName n = QF $ Name n++mkStatus ∷ String → CmdLineFlag+mkStatus s = QF $ Status s++forceEither ∷ (Show t) ⇒ Either t b → b+forceEither (Right x) = x+forceEither (Left x) = error $ show x++mkStartDate ∷ DateTime → String → CmdLineFlag+mkStartDate dt s = QF $ StartDateIs $ forceEither $ parseDate dt s++mkEndDate ∷ DateTime → String → CmdLineFlag+mkEndDate dt s = QF $ EndDateIs $ forceEither $ parseDate dt s++mkDeadline ∷ DateTime → String → CmdLineFlag+mkDeadline dt s = QF $ DeadlineIs $ forceEither $ parseDate dt s++mkDescribe ∷ Maybe String → CmdLineFlag+mkDescribe Nothing = MF $ Describe "%d"+mkDescribe (Just f) = MF $ Describe f++mkPrune ∷ String → CmdLineFlag+mkPrune s = LF $ Prune (read s)++mkMin ∷ String → CmdLineFlag+mkMin s = LF $ Start (read s)++mkPrefix ∷ Maybe [Char] → CmdLineFlag+mkPrefix = MF ∘ Prefix ∘ fromMaybe "TODO:"++mkExecute ∷ Maybe [Char] → CmdLineFlag+mkExecute = MF ∘ Execute ∘ fromMaybe "echo %n %d"
+ CommandParser.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE UnicodeSyntax #-}++module CommandParser where++import Unicode+import Types++-- | Format item info+printfItem ∷ String -- ^ Format string+ → TodoItem + → String+printfItem pattern item = printf pattern+ where+ printf "" = ""+ printf [x] = [x]+ printf ('%':c:xs) = (itemPart c) ⧺ printf xs+ printf (x:xs) = x:printf xs++ itemPart 'L' = show $ itemLevel item+ itemPart 'n' = itemName item+ itemPart 't' = unwords $ itemTags item+ itemPart 's' = itemStatus item+ itemPart 'd' = itemDescr item+ itemPart 'f' = fileName item+ itemPart 'l' = show $ lineNr item+ itemPart x = [x]
+ Config.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE UnicodeSyntax #-}++-- | Module for parsing config files+module Config+ (readConfig)+ where++import Prelude hiding (putStrLn,readFile,getContents,print)+import IO+import System.Environment+import System.FilePath +import System.Directory (doesFileExist)+import Data.Maybe+import Data.Either+import Text.ParserCombinators.Parsec++import Unicode+import Types++word ∷ Parser String+word = choice $ map try [quotedOption, simpleOption, quoted, simpleWord]++simpleWord = many1 $ noneOf " \t\r\n=\"'"++quotedOption = (try quotedLongOption) <|> quotedShortOption++quotedLongOption ∷ Parser String+quotedLongOption = do+ string "--"+ o ← simpleWord+ char '='+ v ← quoted+ return ("--" ⧺ o ⧺ "=" ⧺ v)++quotedShortOption ∷ Parser String+quotedShortOption = do+ string "-"+ o ← simpleWord+ v ← quoted+ return ("-" ⧺ o ⧺ v)++simpleOption = do+ o ← simpleWord+ optional $ char '='+ v ← simpleWord+ return (o ⧺ "=" ⧺ v)++quoted = quoted1 <|> quoted2++quoted1 = do+ char '\''+ s ← many1 $ noneOf "'"+ char '\''+ return s++quoted2 = do+ char '"'+ s ← many1 $ noneOf "\""+ char '"'+ return s++pConfig ∷ Parser [String]+pConfig = word `sepBy` space++parseConfig ∷ String → [String]+parseConfig str = + case parse pConfig "config file" str of+ Right lst → lst+ Left err → error $ show err++readFile' ∷ FilePath → IO [String]+readFile' path = + do b ← doesFileExist path+ if not b+ then return []+ else do+ str ← readFile path+ return $ parseConfig (unwords $ lines str)++-- | Read list of options from config files+readConfig ∷ IO [String]+readConfig = do+ home ← getEnv "HOME"+ let homepath = home </> ".config" </> "todos"+ homecfg ← readFile' homepath+ localcfg ← readFile' ".todos.conf"+ return $ homecfg ⧺ localcfg+
+ ConstrSet.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE UnicodeSyntax, DeriveDataTypeable, NoMonomorphismRestriction #-}++module ConstrSet + (CSet,+ empty,+ fromList, toList,+ insert, append,+ elemC,+ selectByConstrOf,+ selectByConstrOf'+ ) where++import Data.Generics+import Data.Function (on)+import Data.List (nubBy)+import Data.Maybe (fromMaybe)++teq = (==) `on` toConstr++data (Data a) ⇒ CSet a = CSet [a]++empty = CSet []++fromList lst = CSet $ nubBy teq lst+toList (CSet lst) = lst++insert item (CSet []) = CSet [item]+insert item (CSet lst) = CSet $ nubBy teq (item:lst)++selectByConstrOf (CSet []) _ = Nothing+selectByConstrOf (CSet (x:xs)) y | x `teq` y = Just x+ | otherwise = selectByConstrOf (CSet xs) y++selectByConstrOf' def cset x = fromMaybe def $ selectByConstrOf cset x++elemC _ (CSet []) = False+elemC x (CSet (y:ys)) | x `teq` y = True+ | otherwise = elemC x (CSet ys)++append (CSet xs) (CSet ys) = CSet $ nubBy teq (xs++ys)
+ Dates.hs view
@@ -0,0 +1,300 @@+{-# LANGUAGE UnicodeSyntax #-}+-- | Operations with dates+module Dates+ (parseDate, getCurrentDateTime,+ pSpecDates)+ where++import Data.Char (toUpper)+import Data.Function (on)+import Data.List+import Data.Time.Calendar+import Data.Time.Clock+import Data.Time.LocalTime+import Text.ParserCombinators.Parsec++import Types+import Unicode++getCurrentDateTime ∷ IO DateTime+getCurrentDateTime = do+ zt ← getZonedTime+ let lt = zonedTimeToLocalTime zt+ ld = localDay lt+ ltod = localTimeOfDay lt+ (y,m,d) = toGregorian ld+ h = todHour ltod+ min = todMin ltod+ s = round $ todSec ltod+ return $ DateTime (fromIntegral y) m d h min s++uppercase ∷ String → String+uppercase = map toUpper++isPrefixOfI ∷ String → String → Bool+p `isPrefixOfI` s = (uppercase p) `isPrefixOf` (uppercase s)++lookupS ∷ String → [(String,a)] → Maybe a+lookupS _ [] = Nothing+lookupS k ((k',v):other) | k `isPrefixOfI` k' = Just v+ | otherwise = lookupS k other++monthsN ∷ [(String,Int)]+monthsN = zip months [1..]++lookupMonth ∷ String → Maybe Int+lookupMonth n = lookupS n monthsN++date ∷ Int → Int → Int → DateTime+date y m d = DateTime y m d 0 0 0++addTime ∷ DateTime → Time → DateTime+addTime dt t = dt {+ hour = tHour t + hour dt,+ minute = tMinute t + minute dt,+ second = tSecond t + second dt }++times ∷ Int → Parser t → Parser [t]+times 0 _ = return []+times n p = do+ ts ← times (n-1) p+ t ← optionMaybe p+ case t of+ Just t' → return (ts ++ [t'])+ Nothing → return ts+ +number ∷ Int → Int → Parser Int+number n m = do+ t ← read `fmap` (n `times` digit)+ if t > m+ then fail "number too large"+ else return t++pYear ∷ Parser Int+pYear = do+ y ← number 4 10000+ if y < 2000+ then return (y+2000)+ else return y++pMonth ∷ Parser Int+pMonth = number 2 12++pDay ∷ Parser Int+pDay = number 2 31++euroNumDate ∷ Parser DateTime+euroNumDate = do+ d ← pDay+ char '.'+ m ← pMonth+ char '.'+ y ← pYear+ return $ date y m d++americanDate ∷ Parser DateTime+americanDate = do+ y ← pYear+ char '/'+ m ← pMonth+ char '/'+ d ← pDay+ return $ date y m d++euroNumDate' ∷ Int → Parser DateTime+euroNumDate' year = do+ d ← pDay+ char '.'+ m ← pMonth+ return $ date year m d++americanDate' ∷ Int → Parser DateTime+americanDate' year = do+ m ← pMonth+ char '/'+ d ← pDay+ return $ date year m d++strDate ∷ Parser DateTime+strDate = do+ d ← pDay+ space+ ms ← many1 letter+ case lookupMonth ms of+ Nothing → fail $ "unknown month: "++ms+ Just m → do+ space+ y ← pYear+ notFollowedBy $ char ':'+ return $ date y m d++strDate' ∷ Int → Parser DateTime+strDate' year = do+ d ← pDay+ space+ ms ← many1 letter+ case lookupMonth ms of+ Nothing → fail $ "unknown month: "++ms+ Just m → return $ date year m d++time24 ∷ Parser Time+time24 = do+ h ← number 2 23+ char ':'+ m ← number 2 59+ x ← optionMaybe $ char ':'+ case x of+ Nothing → return $ Time h m 0+ Just _ → do+ s ← number 2 59+ notFollowedBy letter+ return $ Time h m s++ampm ∷ Parser Int+ampm = do+ s ← many1 letter+ case map toUpper s of+ "AM" → return 0+ "PM" → return 12+ _ → fail "AM/PM expected"++time12 ∷ Parser Time+time12 = do+ h ← number 2 12+ char ':'+ m ← number 2 59+ x ← optionMaybe $ char ':'+ s ← case x of+ Nothing → return 0+ Just s' → number 2 59+ optional space+ hd ← ampm+ return $ Time (h+hd) m s++pAbsDate ∷ Int → Parser DateTime+pAbsDate year = do+ date ← choice $ map try $ map ($ year) $ [+ const euroNumDate,+ const americanDate,+ const strDate,+ strDate',+ euroNumDate',+ americanDate']+ optional $ char ','+ s ← optionMaybe space+ case s of+ Nothing → return date+ Just _ → do+ t ← choice $ map try [time12,time24]+ return $ date `addTime` t++data DateIntervalType = Day | Week | Month | Year+ deriving (Eq,Show,Read)++data DateInterval = Days ℤ+ | Weeks ℤ+ | Months ℤ+ | Years ℤ+ deriving (Eq,Show)++convertTo ∷ DateTime → Day+convertTo dt = fromGregorian (fromIntegral $ year dt) (month dt) (day dt)++convertFrom ∷ Day → DateTime+convertFrom dt = + let (y,m,d) = toGregorian dt+ in date (fromIntegral y) m d++modifyDate ∷ (t → Day → Day) → t → DateTime → DateTime+modifyDate fn x dt = convertFrom $ fn x $ convertTo dt++addInterval ∷ DateTime → DateInterval → DateTime+addInterval dt (Days ds) = modifyDate addDays ds dt+addInterval dt (Weeks ws) = modifyDate addDays (ws*7) dt+addInterval dt (Months ms) = modifyDate addGregorianMonthsClip ms dt+addInterval dt (Years ys) = modifyDate addGregorianYearsClip ys dt++maybePlural ∷ String → Parser String+maybePlural str = do+ r ← string str+ optional $ char 's'+ return (capitalize r)++pDateInterval ∷ Parser DateIntervalType+pDateInterval = do+ s ← choice $ map maybePlural ["day", "week", "month", "year"]+ return $ read s++pRelDate ∷ DateTime → Parser DateTime+pRelDate date = do+ offs ← (try futureDate) <|> (try passDate) <|> (try today) <|> (try tomorrow) <|> yesterday+ return $ date `addInterval` offs++futureDate ∷ Parser DateInterval+futureDate = do+ string "in "+ n ← many1 digit+ char ' '+ tp ← pDateInterval+ case tp of+ Day → return $ Days (read n)+ Week → return $ Weeks (read n)+ Month → return $ Months (read n)+ Year → return $ Years (read n)++passDate ∷ Parser DateInterval+passDate = do+ n ← many1 digit+ char ' '+ tp ← pDateInterval+ string " ago"+ case tp of+ Day → return $ Days $ - (read n)+ Week → return $ Weeks $ - (read n)+ Month → return $ Months $ - (read n)+ Year → return $ Years $ - (read n)++today ∷ Parser DateInterval+today = do+ string "today"+ return $ Days 0++tomorrow ∷ Parser DateInterval+tomorrow = do+ string "tomorrow"+ return $ Days 1++yesterday ∷ Parser DateInterval+yesterday = do+ string "yesterday"+ return $ Days (-1)++pDate ∷ DateTime → Parser DateTime+pDate date = (try $ pRelDate date) <|> (try $ pAbsDate $ year date)++dateType ∷ String → DateType+dateType "start" = StartDate+dateType "end" = EndDate+dateType "deadline" = Deadline+dateType _ = error "unknown date type"++pSpecDate ∷ DateTime → Parser (DateType, DateTime)+pSpecDate date = do+ tp ← choice $ map string ["start","end","deadline"]+ string ": "+ dt ← pDate date+ return (dateType tp, dt)++pSpecDates ∷ DateTime → Parser [(DateType, DateTime)]+pSpecDates date = do+ char '('+ pairs ← (pSpecDate date) `sepBy1` (string "; ")+ string ") "+ return pairs++-- | Parse date/time+parseDate ∷ DateTime -- ^ Current date/time+ → String -- ^ String to parse+ → Either ParseError DateTime+parseDate date s = parse (pDate date) "" s+
+ IO.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE CPP #-}+-- | Wrapper to support unicode IO with GHC 6.10 and 6.12+module IO +#if __GLASGOW_HASKELL__ < 612+ (module System.IO.UTF8)+#else+ (module Prelude)+#endif+ where++#if __GLASGOW_HASKELL__ < 612++ import Prelude hiding (putStr, putStrLn,readFile,getContents,print)+ import System.IO.UTF8++#else++ import Prelude++#endif
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Ilya V. Portnov 2010++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of me nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Makefile view
@@ -0,0 +1,8 @@+GHC=ghc+GHCFLAGS=-O2++todos: *.hs+ $(GHC) $(GHCFLAGS) --make todos.hs++clean:+ rm -f *.hi *.o *~
+ README view
@@ -0,0 +1,91 @@+todos README+============+Ilya V. Portnov <portnov84@rambler.ru>++todos is a simple TODO manager. TODO records theirself are described in+plain-text file, and todos allows you to show only needed of them. So, todos+works as specialized `grep' utility.++By default, output format is the same as input; so, you can combine several+`todos' instances into unix pipes. ++If source files are not given in the commandline, file with name "TODO" in+current directory is used. If "-" is given as file name, todos will read+standart input.++todos supports two formats of input files. In first case, file contains TODOS+records and only them. In «alternative» format, source files can contain any+text, but it's ignored; only lines starting with given prefix ("TODO: " by+default) are parsed. So, alternative format enable you to grep TODO records+from any files, for example, program source files.++Following is format of TODO record:++ [spaces]status (dates) [TAGS] title (depends) description++Here [spaces] is optional indent with spaces, «status» — is status of record+(for example, URGENT or DONE; can be any word), «dates» give info about dates+(see below), «TAGS» is a comma-separated list of tags in brackets, «title» is+title of record, «depends» — comma-separated list of depends (titles of other+records) in parenthesis, «description» is description of the record. All fields+except status and title are optional. Description is separated from title with+not less than 2 spaces.++Using different indents one can create sub-records (and, so, trees of records).+Moreover, depends are interpreted in same way as sub-records. So, one can+create not only trees of records, but arbitrary graphs of records (even+cycled). When cycled graphs are used, user should control for rational level of+hierarchy (for example, one can bound height of output tree using -p option).++Dates information is described in parenthesis, as not more than 3 records,+separated with semicolon. Each records has format «date type: date». Date type+can be one of: start, end, deadline. For dates, many formats are supported; for+example, «18 Feb», или «02/18/2010», «2010/02/18» are all valid dates. One can+even use relative dates specification here, such as «in 2 weeks» or «2 days+ago», but there is no point to this: all dates are counted from program start+date.++Next commandline options are supported:++ -1 --only-first show only first matching entry+ -c --color show colored output+ -A[PREFIX] --prefix[=PREFIX] use alternate parser: read only lines starting with PREFIX+ -D[FORMAT] --describe[=FORMAT] use FORMAT for descriptions+ -p N --prune=N limit tree height to N+ -m N --min-depth=N show first N levels of tree unconditionally+ -t TAG --tag=TAG find items marked with TAG+ -g PATTERN --grep=PATTERN find items with PATTERN in name+ -s STRING --status=STRING find items with status equal to STRING+ -a --and logical AND+ -o --or logical OR+ -n --not logical NOT+ --sort=FIELD specify sorting+ -e[COMMAND] --exec[=COMMAND] run COMMAND on each matching entry+ -S DATE --start-date=DATE find items with start date bounded with DATE+ -E DATE --end-date=DATE find items with end date bounded with DATE+ -d DATE --deadline=DATE find items with deadline bounded with DATE+ -h --help display this help++Dates in the commandline are specified in any of supported formats. There+relative dates specifications are useful: how about something like «todos+--deadline=yesterday»? ;)++For --describe and --exec options, printf-style format strings should be+specified. Following substitution sequences are supported:++%n :: title of the record+%t :: list of record's tags+%s :: status of the record+%d :: description of the record+%f :: name of file, in which record was found+%l :: number of line in source file++For example, «todos -tBUG -e"vi %f +%l"» command for each record with «BUG» tag+will open vi with corresponding file on corresponding line.++todos can read configuration files: ~/.config/todos («global») and+./.todos.conf («local»). Config files contain command line options, in the same+format as in the commandline. Resulting commandline is composed as: (options in+global config) + (options in local config) + (options in the actual command+line). If there is no one of configs, todos will ignore it.+
+ README.ru view
@@ -0,0 +1,96 @@+todos README+============+Ilya V. Portnov <portnov84@rambler.ru>++todos — это простой TODO-менеджер. Сами записи TODO описываются в простом+текстовом файле, а todos позволяет показывать из них только нужные, работая как+специализированная утилита grep. При этом формат вывода по умолчанию совпадает+с форматом входных файлов, поэтому вывод todos можно опять подавать на вход+todos через конвейер. Если входные файлы не указаны в командной строке,+читается файл TODO в текущей директории. Если вместо имени файла указано «-»,+читается стандартный ввод.++todos поддерживает два формата входных файлов. В первом случае файл содержит+только сами записи TODO и ничего больше. В «альтернативном» формате входные+файлы могут содержать произвольный текст, но он игнорируется, а читаются только+строки, начинающиеся с заданного префикса (по умолчанию TODO:), при этом формат+строки после префикса тот же, что в первом случае. Альтернативный формат+позволяет отбирать записи TODO из произвольных файлов, например исходных+текстов программы.++Формат записи TODO следующий:++ [spaces]status (dates) [TAGS] title (depends) description++Здесь [spaces] — это необязательный отступ пробелами, status — статус записи+(например URGENT или DONE, но может быть произвольным словом), dates —+информация о датах (см. ниже), TAGS — список тегов через пробел в квадратных+скобках, title — заголовок записи, depends — список зависимостей (заголовков+других записей) в скобках через запятую, description — описание записи. Все+поля кроме статуса и заголовка необязательны. Описание отделяется от заголовка+не менее чем двумя пробелами.++С помощью разных отступов можно создавать вложенные записи. Кроме того,+зависимости интерпретируются также как вложенные записи; они позволяют+создавать не только дерево записей, но и произвольный граф, в том числе и с+циклами. В случае наличия циклов (когда задача A зависит от B, а B — от A)+контроль за разумным выводом программы возлагается на пользователя (например,+можно ограничить высоту выводимого дерева опцией -p).++Информация о датах записывается в скобках, в виде не более чем трёх записей+через точку с запятой, каждая запись имеет вид «тип_даты: дата». Тип даты может+быть start, end, или deadline (предполагается, что так обозначаются+соответственно дата начала выполнения задачи, планируемая дата окончания и+дедлайн соответственно). Для дат поддерживается довольно много форматов;+например, «18 Feb», или «02/18/2010», и мн. др. Тут могут указываться и+относительные даты (вида «in 2 weeks», «2 days ago» или просто «tomorrow»), но+это имеет мало смысла — относительные даты считаются от момента запуска+программы.++Поддерживаются следующие опции командной строки:++-1, --only-first :: показывать только первую запись из всех, что должны быть показаны+-c, --color :: раскрашивать вывод todos (заголовки записей — полужирным, некоторые статусы выделяются цветом)+-A, --prefix= :: использовать альтернативный формат файлов, тут же указывается префикс+-D, --describe :: можно указать формат для выводимого описания (см. ниже)+-p, --prune :: ограничить максимальную высоту дерева (для каждой из отобранных записей будет показано не более чем N уровней вложенности)+-m, --min-depth :: ограничить минимальную высоту дерева+-t, --tag :: вывести только записи с заданным тегом и их вложенные записи+-g, --grep :: искать по заголовкам записей+-s, --status :: искать по статусам записей+-a, --and :: логическое И; например, todos -s! -a -tBUG — искать записи со статусом «!» и тегом «BUG»+-o, --or :: логическое ИЛИ;+-n, --not :: логическое НЕ;+-e, --exec :: вместо того, чтобы показывать записи, для каждой записи выполнить заданную команду; в строке для команды можно использовать символы подстановки, см. ниже+-S, --start-date :: искать по дате начала+-E, --end-date :: искать по планируемой дате завершения+-d, --deadline :: искать по дедлайну+-h, --help :: показать краткую справку по опциям командной строки++Даты в командной строке могут быть во всех тех же форматах, что и во входных+файлах. Тут как раз обычно более удобны относительные даты. Если указана дата в+прошлом, записи ищутся по признаку «больше или равно», например, todos+--deadline=yesterday будет искать записи с дедлайном вчера, сегодня или где+угодно в будущем. Если указана дата в будущем, записи ищутся по признаку+«меньше или равно»; например, todos --start-date="in 2 weeks" будет искать+записи с датой начала через 2 недели или раньше (в т.ч. и в прошлом).++Для опций --describe и --exec указываются строки формата с символами+подстановки в стиле printf. Поддерживаются следующие символы подстановки:++%n :: заменяется на заголовок записи+%t :: список тегов записи+%s :: статус записи+%d :: описание записи+%f :: имя файла, в котором встретилась запись+%l :: номер строки в файле, где встретилась запись++Например, todos -tBUG -e"vi %f +%l" для каждой записи с тегом BUG откроет vi на+строчке с этой записью.++todos может читать конфигурационные файлы: ~/.config/todos (глобальный) и+.todos.conf в текущей директории (локальный). Конфигурационные файлы содержат+ключи командной строки. «Эффективная командная строка» составляется как (ключи+в глобальном конфиге) + (ключи в локальном конфиге) + ключи в командной строке.+Если какого-то из конфигов нет, todos это проигнорирует.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ TODO view
@@ -0,0 +1,62 @@+X [TODO] Написать TodoManager todos.hs+ ? (start: 13 Feb) [TODO] Даты Поддержка дат+ - Дата начала, предполагаемая дата завершения, дедлайн+ + все даты опциональны+ + разные форматы дат+ + (end: 15 Feb) отбор по датам+ ? Какую-нибудь более умную логику для дат в будущем/прошлом+ ? вычисление недостающих дат по зависимостям+ ? Поддержка ресурсов+ ? Формат описания в тудушках+ ? Тогда уж и распределение по ресурсам+ + [queries] Запросы TodoTree.hs+ + По глубине вложенности+ + По тегам+ + По тексту+ + в т.ч. по регэкспам+ + По статусу+ * комбинации Комбинации запросов (and/or/not)+ * Тогда надо какие-то комбинаторы делать для selector-ов+ DONE Отрефакторить слишком много промежуточных стадий+ DONE Not ещё приделать+ - улучшить поведение -a, -o+ - или нормально задокументировать текущее+ DONE научить пропускать первые N уровней чтобы первые уровни показывать, а остальные только по условию+ ? Язык запросов (комбинации)+ + или ключи ком.строки+ - Отключение -A итп с ком. строки+ + Всякие сортировки+ + Раскраски+ + Сделать раскраску отключаемой+ : Формат тудушек (Даты)+ DONE всё кроме описания сделать необязательным+ - [BUG] баги с синтаксисом+ FIXED spaces Trailing spaces !?+ : [BUG TODO] Баги+ - [BUG] синтаксис (spaces)+ FIXED [BUG] ссылки на произвольное место+ INVALID [BUG] grep не ищет по верхнему уровню+ ? [BUG] что-то странное с grep-ом видимо, из-за юникода.+ - Prune не работает, если не задано условие+: First+ Y [Tag2] Second'+ + [Tag2] THird+ Y [Tag1] Second +DONE [НГ Tag1] Купить конфет+X [Tag1] Fyy+ ! [Tag2] Sxx + X [TODO] Tyy+ Y [Tag1] Tzz+X [Tag2] Last+o [Test] Test Todo+ o Test 1 (Баги)+ o Test 2+ o [Test] Test 21+ T Todo test+ T Yet another Todo test+ o [Test] Subtest 1+ o [Test] Subtest 11+ o [Test] Subtest 12+ o [Test] Subtest 2+ o [Test] Subtest 21+ T [Test] Test 3
+ TodoLoader.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE UnicodeSyntax, PatternGuards #-}+-- | Read TODOs from files and construct corresponding ADTs.+module TodoLoader+ (loadTodo)+ where++import Prelude hiding (putStrLn,readFile,getContents,print)+import IO+import Control.Monad (forM)+import qualified Data.Map as M+import Text.ParserCombinators.Parsec+import Data.Maybe+import Data.Tree++import Unicode+import Types+import TodoParser++todoName ∷ Todo → String+todoName todo = itemName ⋄ rootLabel todo++getDepends ∷ TodoMap → TodoItem → [Todo]+getDepends m item = catMaybes [M.lookup name m | name ← depends item] ++normalizeItem ∷ TodoMap → TodoItem → Todo+normalizeItem m item = Node item (map (normalize m) ⋄ getDepends m item)++normalize ∷ TodoMap → Todo → Todo +normalize m todo = Node item' ((map (normalize m) subTodos) ⧺ (map (normalize m) deps))+ where+ item ∷ TodoItem+ item = rootLabel todo++ item' ∷ TodoItem+ item' = item {depends=[]}++ subTodos ∷ [Todo]+ subTodos = subForest todo++ deps ∷ [Todo]+ deps = getDepends m item++normalizeList ∷ TodoMap → [Todo] → [Todo]+normalizeList m todos = map (normalize m) todos++readFile' ∷ FilePath → IO String+readFile' "-" = getContents+readFile' file = readFile file++loadFile ∷ Maybe String → DateTime → FilePath → IO [TodoItem]+loadFile Nothing year path = do+ text ← readFile' path+ return $ parsePlain year path text+loadFile (Just p) year path = do+ text ← readFile' path+ return $ parseAlternate 2 p year path text++(~-) ∷ TodoItem → ℤ → TodoItem+i@(Item {itemLevel=n}) ~- k = i {itemLevel=n-k}++iszero ∷ TodoItem → 𝔹+iszero item = (itemLevel item)==0++group' ∷ [TodoItem] → [[TodoItem]]+group' [] = []+group' (x:xs) = let (one,other) = break iszero xs+ in (x:one):group' other++mkTodo ∷ [TodoItem] → [Todo]+mkTodo = (map mkTodo') ∘ group'++mkTodo' ∷ [TodoItem] → Todo+mkTodo' (x:xs) = Node x other+ where other = mkTodo ⋄ map (~-lvl) xs+ lvl = itemLevel (head xs)+ +consTodoMap ∷ [Todo] → TodoMap+consTodoMap todos = M.fromList (cons1 100 todos)+ where+ cons1 ∷ Int → [Todo] → [(String,Todo)]+ cons1 0 _ = []+ cons1 max trees = [(todoName todo, todo) | todo ← trees] ⧺ cons1 (max-1) (children trees)+ children ∷ [Todo] → [Todo]+ children trees = concatMap subForest trees++stitchTodos ∷ [TodoItem] → [Todo]+stitchTodos items = + let m = consTodoMap t+ t = mkTodo items+ in normalizeList m t++-- | Load list of TODO trees from files+loadTodo ∷ Maybe String -- ^ Nothing for plain format, Just prefix for alternate format+ → DateTime -- ^ Current date/time+ → [FilePath] -- ^ List of files+ → IO [Todo]+loadTodo maybePrefix date paths = do+ tss ← forM paths (loadFile maybePrefix date)+ return $ stitchTodos (concat tss)
+ TodoParser.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE UnicodeSyntax, NoMonomorphismRestriction, TypeSynonymInstances, DeriveDataTypeable #-}+module TodoParser+ (parsePlain, parseAlternate)+ where++import Prelude hiding (putStrLn,readFile,getContents,print)+import IO+import Control.Monad+import Data.List+import Text.ParserCombinators.Parsec+import qualified Data.Map as M+import Data.Tree+import Data.Maybe+import Data.Char+import Data.Function++import Unicode+import Types+import Dates++strip ∷ String → String+strip = reverse ∘ p ∘ reverse ∘ p+ where+ p = dropWhile isSpace++pSpace ∷ Parser Char+pSpace = oneOf " \t"++pSpace' ∷ Parser String+pSpace' = do+ pSpace+ return " "++pSpaces ∷ Parser String+pSpaces = many pSpace++pDeps ∷ Parser [String]+pDeps = do+ string "("+ ws ← (many1 ⋄ noneOf ",)\n\r") `sepBy` (char ',')+ string ")"+ return $ map strip ws++pTags ∷ Parser [String]+pTags = do+ ts ← between (char '[') (char ']') $ word `sepBy1` pSpace+ pSpaces+ return ts+ where+ word = many1 (noneOf " \t\n\r]")++pItem ∷ DateTime → Parser TodoItem+pItem date = do+ pos ← getPosition+ s ← pSpaces+ stat ← pWord+ dates ← (try (pSpecDates date) <|> return [])+ tags ← (try pTags <|> return [])+ namew ← many1 pWord+ pSpaces+ deps ← (try pDeps <|> return [])+ pSpaces+ descr ← many (noneOf "\n\r")+ pSpaces+ many ⋄ oneOf "\n\r"+ return ⋄ Item {+ itemLevel = fromIntegral $ length s,+ itemName = unwords namew,+ itemTags = tags,+ depends = deps,+ itemStatus = stat,+ itemDescr = descr,+ startDate = lookup StartDate dates,+ endDate = lookup EndDate dates,+ deadline = lookup Deadline dates,+ fileName = sourceName pos,+ lineNr = sourceLine pos }++pWord ∷ Parser String+pWord = do+ w ← many1 (noneOf " \t\n\r")+ (try pSpace') <|> (return w)+ return w++pItems ∷ DateTime → Parser [TodoItem]+pItems date = do+ its ← many (pItem date)+ eof+ return its++unwords' ∷ String → [String] → String+unwords' prefix lst =+ let (hd:tl) = map (filter (/='\r')) lst+ addLines = filter (not ∘ (prefix `isPrefixOf`)) tl+ in case addLines of+ [] → hd+ _ → hd ⧺ " {" ++ (unwords addLines) ++ "}"++filterN ∷ (Num a, Enum a) ⇒ Int → String → [String] → ([a], [String])+filterN n prefix lst = + let zipped = zip [0..] lst+ good = filter (isGood ∘ snd) zipped+ lns = map fst good+ sub k l = (take l) ∘ (drop k)+ ans = map (unwords' prefix) [sub j n lst | j ← lns]+ isGood x = prefix `isPrefixOf` x+ cut = drop (1+length prefix) + in (map (+1) lns, map cut ans)++filterJoin ∷ Int → String → String → ([Int], String)+filterJoin n prefix str = + let (ns, lns) = filterN n prefix (lines str)+ in (ns, unlines lns)++-- | Read list of TODO items from plain format +parsePlain ∷ DateTime -- ^ Current date/time+ → SourceName -- ^ Source file name+ → String -- ^ String to parse+ → [TodoItem]+parsePlain date path text = + case parse (pItems date) path text of+ Right items → items+ Left e → error $ show e++-- | Read list of TODO items from alternate format+parseAlternate ∷ Int -- ^ Number of lones after matching to include to item's description+ → String -- ^ Prefix to match+ → DateTime -- ^ Current date/time+ → SourceName -- ^ Source file name+ → String -- ^ String to parse+ → [TodoItem]+parseAlternate next prefix date path text = + let (ns, filtered) = filterJoin next prefix text+ renumber lst = zipWith renumber1 ns lst+ renumber1 n item = item {lineNr=n}+ in case parse (pItems date) path filtered of+ Right items → renumber items+ Left e → error $ show e+
+ TodoTree.hs view
@@ -0,0 +1,134 @@+{-# LANGUAGE UnicodeSyntax, NoMonomorphismRestriction, FlexibleInstances, TypeSynonymInstances #-}+module TodoTree + (delTag,+ pruneSelector,+ tagPred, statusPred, grepPred, datePred,+ forT, mapT,+ printTodos)+ where++import Prelude hiding (putStrLn,readFile,getContents,print)+import IO+import Control.Monad+import Control.Monad.Reader+import qualified Data.Map as M+import Data.Generics+import Data.List+import Data.Function (on)+import Data.Tree+import Data.Maybe+import Text.Regex.PCRE++import Types+import TodoLoader+import Unicode++sortBy' s | s == DoNotSort = id+ | otherwise = sortBy sorter+ where+ sorter = compare `on` (f ∘ rootLabel)+ f = case s of+ ByTitle → itemName+ ByStatus → itemStatus+ ByTags → unwords ∘ itemTags+ ByStartDate → show ∘ startDate+ ByEndDate → show ∘ endDate+ ByDeadline → show ∘ deadline ++showT ∷ SortingType → Int → Todo → [ConfigM]+showT s n (Node item todos) = + (configM <++> (replicate n ' ') <++> (configShow item)) :+ (concatMap (showT s (n+2)) $ sortBy' s todos)++unlines'' ∷ [ConfigM] → ConfigM+unlines'' lst = concat `fmap` (sequence $ intersperse newLine lst)++showTodo ∷ Todo → ConfigM+showTodo t = do+ conf ← ask+ let f = case outOnlyFirst conf of+ False → unlines''+ True → head+ f $ showT (sorting conf) 0 t++showTodos ∷ [Todo] → ConfigM+showTodos lst = do+ conf ← ask+ let f = case outOnlyFirst conf of+ False → unlines''+ True → head+ f $ map showTodo $ sortBy' (sorting conf) $ nub lst++printTodos ∷ Config → [Todo] → IO ()+printTodos conf lst = + let lst' = runReader (showTodos lst) conf+ in mapM_ outItem lst'++mapTags ∷ (Data a) ⇒ ([String] → [String]) → [a] → [a]+mapTags f = map ⋄ everywhere ⋄ mkT changeTags+ where+ changeTags item@(Item {itemTags=ts}) = item {itemTags = f ts}+ +addTag ∷ (Data a) ⇒ String → [a] → [a]+addTag t = mapTags (t:)++delTag ∷ (Data a) ⇒ String → [a] → [a]+delTag t = mapTags (delete t)++pruneSelector ∷ (TodoItem → 𝔹) → Transformer+pruneSelector pred = do+ (Limit n) ← asks pruneL+ (Limit m) ← asks minL+ return $ pruneSelector' n m pred+ +pruneSelector' ∷ ℤ → ℤ → (TodoItem → 𝔹) → (Todo → [Todo])+pruneSelector' n m pred = select n 0 False+ where+ select k t b (Node item trees) | t < m = [Node item ⋄ concatMap (select (n-1) (t+1) True) trees]+ | pred item = [Node item ⋄ concatMap (select (n-1) (t+1) True) trees]+ | (k > 0) ∧ b = [Node item ⋄ concatMap (select (k-1) (t+1) True) trees]+ | k > 0 = concatMap (select (k-1) (t+1) False) trees+ | otherwise = [] ++addS ∷ (Show a) ⇒ a → TodoItem → TodoItem+addS s item@(Item {itemName=name}) = item {itemName = name ⧺ " — " ⧺ show s}++tagPred ∷ String → TodoItem → 𝔹+tagPred tag = \item → tag ∈ itemTags item++statusPred ∷ String → TodoItem → 𝔹+statusPred st = \item → st == itemStatus item+ +grepPred ∷ String → TodoItem → 𝔹+grepPred pattern = \item → itemName item =~ pattern++isLT ∷ (Ord t) ⇒ Maybe t → t → 𝔹+isLT Nothing _ = False+isLT (Just x) y = x <= y++isGT ∷ (Ord t) ⇒ Maybe t → t → 𝔹+isGT Nothing _ = False+isGT (Just x) y = x >= y++datePred ∷ (Ord a) ⇒ (t → Maybe a) → a → a → t → 𝔹+datePred selector curr dt | dt >= curr = \item → selector item `isLT` dt+ | otherwise = \item → selector item `isGT` dt++flattern ∷ [Todo] → [Todo]+flattern = concatMap flat+ where+ flat ∷ Todo → [Todo]+ flat (Node item trees) = (Node item []):(concatMap flat trees)++forT ∷ (Monad m, Eq t) ⇒ [Tree t] → (t → m a) → m [b]+forT todos f = forM (nub todos) forT'+ where+ forT' (Node item trees) =+ do f item+ res ← forM trees forT'+ return $ last res++mapT ∷ (t → t) → [Tree t] → [Tree t]+mapT f todos = map mapT' todos+ where+ mapT' (Node item trees) = Node (f item) (mapT f trees)
+ Types.hs view
@@ -0,0 +1,328 @@+{-# LANGUAGE UnicodeSyntax, DeriveDataTypeable, TypeSynonymInstances, FlexibleInstances, NoMonomorphismRestriction #-}++module Types where++import Prelude hiding (putStr, putStrLn,readFile,getContents,print)+import IO+import System.Console.ANSI++import Control.Monad.Reader+import Data.Function +import Data.Generics hiding (GT)+import Data.Char (toUpper)+import Data.Maybe+import Data.Tree+import Data.List+import qualified Data.Map as M+import Text.ParserCombinators.Parsec++import Unicode++data DateType = StartDate+ | EndDate+ | Deadline+ deriving (Eq)++instance Show DateType where+ show StartDate = "start"+ show EndDate = "end"+ show Deadline = "deadline"++data DateTime =+ DateTime {+ year ∷ Int,+ month ∷ Int,+ day ∷ Int,+ hour ∷ Int,+ minute ∷ Int,+ second ∷ Int }+ deriving (Eq,Ord,Data,Typeable)++months ∷ [String]+months = ["january",+ "february",+ "march",+ "april",+ "may",+ "june",+ "july",+ "august",+ "september",+ "october",+ "november",+ "december"]++capitalize ∷ String → String+capitalize [] = []+capitalize (x:xs) = (toUpper x):xs++showMonth ∷ Int → String+showMonth i = capitalize $ months !! (i-1)++instance Show DateTime where+ show (DateTime y m d h min s) = + show d ⧺ " " ⧺ showMonth m ⧺ " " ⧺ show y ⧺ ", " ⧺+ show h ⧺ ":" ⧺ show min ⧺ ":" ⧺ show s++data Time = + Time {+ tHour ∷ Int,+ tMinute ∷ Int,+ tSecond ∷ Int }+ deriving (Eq,Ord,Show,Data,Typeable)++data TodoItem = Item {+ itemLevel ∷ ℤ,+ itemName ∷ String,+ itemTags ∷ [String],+ depends ∷ [String],+ itemStatus ∷ String,+ itemDescr ∷ String,+ startDate ∷ Maybe DateTime,+ endDate ∷ Maybe DateTime,+ deadline ∷ Maybe DateTime,+ fileName ∷ FilePath,+ lineNr ∷ Line}+ deriving (Eq,Data,Typeable)++type Todo = Tree TodoItem++type TodoMap = M.Map String Todo++data Limit = Unlimited+ | Limit ℤ+ deriving (Eq,Show)++instance Ord Limit where+ compare Unlimited Unlimited = EQ+ compare Unlimited _ = GT+ compare _ Unlimited = LT+ compare (Limit x) (Limit y) = compare x y++data CmdLineFlag = QF {queryFlag ∷ QueryFlag}+ | MF {modeFlag ∷ ModeFlag}+ | OF {outFlag ∷ OutFlag}+ | LF {limFlag ∷ LimitFlag}+ | HelpF+ deriving (Eq,Show)++data QueryFlag = Tag String+ | Name {unName ∷ String}+ | Status String+ | StartDateIs DateTime+ | EndDateIs DateTime+ | DeadlineIs DateTime+ | AndCons+ | OrCons+ | NotCons+ | NoFilter+ deriving (Eq,Ord,Show) ++data LimitFlag = Prune {unPrune ∷ ℤ}+ | Start {unMin ∷ ℤ}+ deriving (Eq,Show)++data ModeFlag = Execute {unExecute ∷ String}+ | Prefix {unPrefix ∷ String}+ | Describe {unDescribe ∷ String}+ deriving (Eq,Ord,Show)++data OutFlag = OnlyFirst + | Colors+ | Sort {getSorting ∷ SortingType}+ deriving (Eq,Ord,Show)++data SortingType = DoNotSort+ | ByTitle+ | ByStatus+ | ByTags + | ByStartDate+ | ByEndDate+ | ByDeadline+ deriving (Eq,Ord,Show)++readSort ∷ String → SortingType+readSort "no" = DoNotSort+readSort "title" = ByTitle+readSort "status" = ByStatus+readSort "tags" = ByTags+readSort "start-date" = ByStartDate+readSort "end-date" = ByEndDate+readSort "deadline" = ByDeadline+readSort s = error $ "Unknown sorting type: "++s++type Transformer = Reader Config (Todo → [Todo])+type ListTransformer = Reader Config ([Todo] → [Todo])++transformList ∷ r → Reader r (t → a) → t → a+transformList conf tr list = do+ f ← tr+ return (f list)+ `runReader` conf++data OutItem = OutString String+ | OutSetColor Color+ | SetBold+ | ResetAll+ deriving (Show)++type ConfigM = Reader Config [OutItem]++newtype IOList = IOL [ConfigM]++configM ∷ ConfigM+configM = return []++outString ∷ String → ConfigM+outString s = return [OutString s]++newLine ∷ ConfigM+newLine = outString "\n"++class ConfigAdd a where+ (<++>) ∷ ConfigM → a → ConfigM++instance ConfigAdd ConfigM where+ (<++>) = liftM2 (⧺)++instance ConfigAdd String where+ cm <++> s = cm <++> ((return [OutString s]) ∷ ConfigM)++setBold ∷ IO ()+setBold = setSGR [SetConsoleIntensity BoldIntensity]++setColor ∷ Color → IO ()+setColor clr = setSGR [SetColor Foreground Dull clr]++reset ∷ IO ()+reset = setSGR []++outItem ∷ OutItem → IO ()+outItem (OutString s) = putStr s+outItem (OutSetColor c) = setColor c+outItem SetBold = setBold+outItem ResetAll = reset++runConfigM ∷ Config → ConfigM → IO ()+runConfigM conf cm = + let lst = runReader cm conf+ in mapM_ outItem lst++class ConfigShow s where+ configShow ∷ s → ConfigM++instance ConfigShow String where+ configShow s = return [OutString s]++instance ConfigShow ConfigM where+ configShow = id+ +showIO ∷ (ConfigShow a) ⇒ Config → a → IO ()+showIO conf = (runConfigM conf) ∘ configShow++instance (Ord a) ⇒ Ord (Tree a) where+ compare = compare `on` rootLabel++-- TODO: - rename Options → QueryOptions or similar+data Options = O [QueryFlag] [ModeFlag] [OutFlag] [LimitFlag]+ | Help++data Config = Config {+ outOnlyFirst ∷ 𝔹,+ outColors ∷ 𝔹,+ sorting ∷ SortingType,+ pruneL ∷ Limit,+ minL ∷ Limit,+ commandToRun ∷ Maybe String,+ prefix ∷ Maybe String,+ descrFormat ∷ String,+ query ∷ Composed}+ deriving (Eq,Show)++data Composed = Pred QueryFlag+ | And Composed Composed+ | Or Composed Composed+ | Not Composed+ | Empty+ | HelpC+ deriving (Eq,Show)++is ∷ (Functor f) ⇒ t → f a → f (t, a)+t `is` x = (\a → (t,a)) `fmap` x++showDate ∷ (Show t, Show t1) ⇒ (t, t1) → [Char]+showDate (t,d) = show t ⧺ ": " ⧺ show d++showDates ∷ (Show t, Show t1) ⇒ [Maybe (t, t1)] → [Char]+showDates = intercalate "; " ∘ map showDate ∘ catMaybes++instance Show TodoItem where+ show item = s ⧺ " " ⧺ dates ⧺ tags ⧺ name ⧺ (if null descr then "" else " "⧺descr)+ where+ n = itemLevel item+ name = itemName item+ ts = itemTags item+ s = itemStatus item+ descr = itemDescr item+ dates | null dates' = ""+ | otherwise = "(" ⧺ dates' ⧺ ") "+ dates' = showDates [StartDate `is` startDate item, EndDate `is` endDate item, Deadline `is` deadline item]+ tags = if null ts+ then ""+ else "[" ⧺ (unwords ts) ⧺ "] "++bold ∷ String → ConfigM+bold s = do+ col ← asks outColors + if col+ then return [SetBold, OutString s, ResetAll]+ else return [OutString s]++lookupC ∷ (Eq a1) ⇒ a1 → [([a1], a)] → Maybe a+lookupC k [] = Nothing+lookupC k ((lst,c):other) | k ∈ lst = Just c+ | otherwise = lookupC k other++statusColors ∷ [([String], Color)]+statusColors = + [(["FIXED", "DONE"], Green),+ (["INVALID"], Magenta),+ (["*"], Red),+ (["?"], Blue)]++colorStatus ∷ String → ConfigM+colorStatus st =+ case lookupC st statusColors of+ Nothing → return [OutString st]+ Just clr → do+ col ← asks outColors + if col+ then return [OutSetColor clr, OutString st, ResetAll]+ else return [OutString st]++instance ConfigShow TodoItem where+ configShow item = configM <++> colorStatus s <++> " " <++> dates <++> tags <++> bold name <++> (if null descr then "" else " "⧺descr)+ where+ n = itemLevel item+ name = itemName item+ ts = itemTags item+ s = itemStatus item+ descr = itemDescr item+ dates | null dates' = ""+ | otherwise = "(" ⧺ dates' ⧺ ") "+ dates' = showDates [StartDate `is` startDate item, EndDate `is` endDate item, Deadline `is` deadline item]+ tags = if null ts+ then ""+ else "[" ⧺ (unwords ts) ⧺ "] "++instance Ord TodoItem where+ compare item1 item2 = + let c1 = (compare `on` itemLevel) item1 item2+ c2 = (compare `on` itemStatus) item1 item2+ c3 = (compare `on` itemName) item1 item2+ in if c1 == EQ+ then if c2 == EQ + then c3+ else c2+ else c1+
+ Unicode.hs view
@@ -0,0 +1,13 @@+module Unicode where++type ℝ = Float+type ℤ = Integer+type 𝔹 = Bool++(⧺) = (++)+(⋄) = ($)+infixr 0 ⋄+(∘) = (.)+(∨) = (||)+(∧) = (&&)+x ∈ lst = elem x lst
+ test.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE UnicodeSyntax, PatternGuards #-}+module Test where++import Control.Monad.Reader+import Data.Maybe+import Data.Tree+import Data.List++import Unicode+import Types+import TodoLoader+import TodoTree+import CommandParser+import Config+import CmdLine++cfg = Config False False (Limit 20) (Limit 20) Nothing Nothing "%d" Empty++test file = do+ todos ← loadTodo Nothing [file]+ printTodos cfg todos+ putStrLn ""+
+ test.txt view
@@ -0,0 +1,11 @@+Line of text+Text+TODO: * one todo+description+text+text+TODO: * another todo+descr+text+text+TODO: + last todo
+ todos.cabal view
@@ -0,0 +1,30 @@+Name: todos+Version: 0.1+Cabal-Version: >= 1.6+License: BSD3+License-File: LICENSE+Author: Ilya V. Portnov+Maintainer: portnov84@rambler.ru+Homepage: http://gitorious.org/todos+Synopsis: Easy-to-use TODOs manager.+Category: Utils,Desktop+Build-Type: Simple+Description: todos is a simple TODO manager. TODO records theirself are described in+ plain-text file, and todos allows you to show only needed of+ them. So, todos works as specialized `grep' utility.++Extra-source-files: CmdLine.hs CommandParser.hs Config.hs ConstrSet.hs Dates.hs IO.hs+ Makefile README README.ru Setup.hs test.hs test.txt TODO+ TodoLoader.hs TodoParser.hs todos.hs TodoTree.hs Types.hs+ Unicode.hs++Executable todos+ Build-Depends: base >= 3 && <= 5, haskell98, utf8-string, containers, parsec >= 2 && < 3,+ syb, mtl, ansi-terminal, Glob, time, regex-pcre, directory, filepath,+ process+ Main-Is: todos.hs++Source-repository head+ type: git+ location: git://gitorious.org/todos/todos.git+
+ todos.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE UnicodeSyntax, PatternGuards #-}++import Prelude hiding (putStrLn,readFile,getContents,print)+import IO+import Codec.Binary.UTF8.String+import System (getArgs)+import System.Exit+import System.Cmd (system)++import Control.Monad.Reader+import Data.Maybe+import Data.Tree+import Data.List++import Unicode+import Types+import TodoLoader+import TodoTree+import CommandParser+import Config+import CmdLine+import Dates (getCurrentDateTime)++main ∷ IO ()+main = do+ currDate ← getCurrentDateTime + config ← readConfig+ args ← getArgs+ let (loptions, files') = parseCmdLine currDate (config ⧺ args)+ files ← glob files'+ case loptions of+ O qflags mflags oflags lflags → + do+ let options = O qflags mflags oflags lflags+ q = buildQuery options+ todos ← loadTodo (prefix q) currDate files+ let todos' = delTag "-" todos+ queried = transformList q (composeAll currDate) todos'+ format item = item {itemDescr = printfItem (descrFormat q) item}+ case commandToRun q of+ Nothing → do+ printTodos q (mapT format queried)+ putStrLn ""+ Just cmd → do+ forT selected (\item → system $ printfItem cmd (format item))+ return ()+ where selected | outOnlyFirst q = [Node (rootLabel $ head queried) []]+ | otherwise = queried++ Help → do putStrLn usage+ exitWith ExitSuccess+