diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -1,8 +1,8 @@ GHC=ghc -GHCFLAGS=-O2 +GHCFLAGS=-O2 -fhpc todos: *.hs - $(GHC) $(GHCFLAGS) --make todos.hs + $(GHC) $(GHCFLAGS) -fwarn-unused-imports -fwarn-unused-binds --make todos.hs clean: find . -name \*.hi -delete diff --git a/README b/README --- a/README +++ b/README @@ -103,11 +103,14 @@ %n :: title of the record %t :: list of record's tags %s :: status of the record +%p :: prefix before record in source file %d :: description of the record %f :: name of file, in which record was found %l :: number of line in source file %D :: dates of item +Backslash-escaping is supported too. Supported sequences are: `\t \n \v \b`. + For example, «todos -tBUG -e"vi %f +%l"» command for each record with «BUG» tag will open vi with corresponding file on corresponding line. @@ -123,10 +126,35 @@ properly, it will draw such item only in one cluster. todos can read configuration files: `~/.config/todos/todos.conf` («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. +`./.todos.conf` («local»). Also, if there is not `./.todos.conf`, todos looks +for file named `.todos.conf` in all ancestor directories. For example, if +current directory is `/home/user/work/projects`, these files are checked: + + * `/home/user/work/projects/.todos.conf` + * `/home/user/work/.todos.conf` + * `/home/user/.todos.conf` + * `/home/.todos.conf` + * `/.todos.conf` + +If one of these files is found, todos checks if it starts with «%» (single +percent character) word. If so, options from «ancestor» config file are +prepended to options from this file. Otherwise, ancestor config is not read. + +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. + +For example, if `/home/user/work/projects/.todos.conf` file contents is `% --dot`, +and `/home/user/work/.todos.conf` contains `-A -F`, «effective command line» would be +`-A -F --dot`. + +Config files might be specified in the command line. `@path/to/file.conf` +option will force todos to read options from `path/to/file.conf`, and add them +to «effective command line» before other command line options. +`@@path/to/file.conf` is almost the same, but here todos will not read «global» +and «local» configs at all. Specifying only `@@` in the command line, one can +disable reading config files at all. Moreover, todos could be customized in «xmonad way». You write file `~/.config/todos/todos.hs` and run todos. todos will compile and run that file. diff --git a/README.ru b/README.ru --- a/README.ru +++ b/README.ru @@ -109,14 +109,18 @@ %n :: заменяется на заголовок записи %t :: список тегов записи %s :: статус записи +%p :: префикс перед записью %d :: описание записи %f :: имя файла, в котором встретилась запись %l :: номер строки в файле, где встретилась запись %D :: даты, связанные с записью -Например, `todos -tBUG -e"vi %f +%l"` для каждой записи с тегом BUG откроет vi -на строчке с этой записью. +Кроме того, поддерживается экранирование с помощью бэкслэша. Поддерживаются +следующие последовательности: '\t \n \v \b`. +Например, todos -tBUG -e"vi %f +%l" для каждой записи с тегом BUG откроет vi на +строчке с этой записью. + С опцией «--dot» todos выведет на стандартный выход описание графа для DOT (graphviz) вместо обычного вывода. Можно попробовать, например, так: @@ -129,11 +133,41 @@ правильно рисовать графы, в которых один узел находится сразу в нескольких кластерах; в таких случаях узел будет нарисован только в одном кластере. -todos может читать конфигурационные файлы: `~/.config/todos/todos.conf` (глобальный) и -`.todos.conf` в текущей директории (локальный). Конфигурационные файлы содержат -ключи командной строки. «Эффективная командная строка» составляется как (ключи -в глобальном конфиге) + (ключи в локальном конфиге) + ключи в командной строке. -Если какого-то из конфигов нет, todos это проигнорирует. +todos может читать конфигурационные файлы: `~/.config/todos/todos.conf` +(глобальный) и `.todos.conf` в текущей директории (локальный). Кроме того, +todos ищет файлы с именем `.todos.conf` во всех родительских директориях. +Например, если текущая директория — `/home/user/work/projects`, будут проверены +следующие файлы: + + * `/home/user/work/projects/.todos.conf` + * `/home/user/work/.todos.conf` + * `/home/user/.todos.conf` + * `/home/.todos.conf` + * `/.todos.conf` + +Если один из этих файлов существует, todos проверяет, не начинается ли он со +слова «%» (один знак процента). Если начинается, то будет прочитан +«родительский» конфигурационный файл (из ближайшей родительской директории), и +ключи из него будут подставлены на место этого знака процента. В противном +случае (если конфигурационный файл не начинается с «%»), конфигурационные файлы +из родительских директорий игнорируются. + +Конфигурационные файлы содержат ключи командной строки. «Эффективная командная +строка» составляется как (ключи в глобальном конфиге) + (ключи в локальном +конфиге) + ключи в командной строке. Если какого-то из конфигов нет, todos это +проигнорирует. + +Например, если в файле `/home/user/work/projects/.todos.conf` написано +`% --dot`, а в файле `/home/user/work/.todos.conf` написано `-A -F`, то +«эффективная командная строка» будет иметь вид `-A -F --dot`. + +Конфигурационные файлы могут указываться в командной строке. Параметр командной +строки `@path/to/file.conf` указывает, что нужно прочитать файл +`path/to/file.conf` и добавить ключи из него перед остальными ключами командной +строки (но после ключей из глобальных и локальных конфигурационных файлов). +Параметр вида `@@path/to/file.conf` работает аналогично, но запрещает чтение +глобальных и локальных конфигурационных файлов. Просто заставить todos не +читать (глобальные и локальные) конфигурационные файлы можно параметром `@@`. Кроме того, todos можно настраивать под себя «в стиле xmonad». Вы пишете файл `~/.config/todos/todos.hs` и запускаете todos. todos компилирует и запускает diff --git a/Todos/CommandParser.hs b/Todos/CommandParser.hs --- a/Todos/CommandParser.hs +++ b/Todos/CommandParser.hs @@ -11,17 +11,26 @@ → String printfItem pattern item = printf pattern where - printf "" = "" - printf [x] = [x] - printf ('%':c:xs) = (itemPart c) ⧺ printf xs - printf (x:xs) = x:printf xs + printf "" = "" + printf [x] = [x] + printf ('%':c:xs) = itemPart c ⧺ printf xs + printf ('\\':c:xs) = escape c : printf xs + printf (x:xs) = x:printf xs - itemPart 'L' = show $ itemLevel item + escape '\\' = '\\' + escape 't' = '\t' + escape 'n' = '\n' + escape 'b' = '\b' + escape 'v' = '\v' + escape c = c + itemPart 'n' = itemName item itemPart 't' = unwords $ itemTags item itemPart 's' = itemStatus item + itemPart 'p' = itemPrefix item itemPart 'd' = itemDescr item itemPart 'f' = fileName item + itemPart 'i' = makeId item itemPart 'l' = show $ lineNr item itemPart 'D' | null dates = "" | otherwise = "(" ⧺ dates ⧺ ") " diff --git a/Todos/Dates.hs b/Todos/Dates.hs --- a/Todos/Dates.hs +++ b/Todos/Dates.hs @@ -22,9 +22,9 @@ ltod = localTimeOfDay lt (y,m,d) = toGregorian ld h = todHour ltod - min = todMin ltod + mins = todMin ltod s = round $ todSec ltod - return $ DateTime (fromIntegral y) m d h min s + return $ DateTime (fromIntegral y) m d h mins s uppercase ∷ String → String uppercase = map toUpper @@ -164,7 +164,7 @@ x ← optionMaybe $ char ':' s ← case x of Nothing → return 0 - Just s' → number 2 59 + Just _ → number 2 59 optional space hd ← ampm return $ Time (h+hd) m s diff --git a/Todos/Default.hs b/Todos/Default.hs --- a/Todos/Default.hs +++ b/Todos/Default.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE UnicodeSyntax #-} +{-# LANGUAGE UnicodeSyntax, CPP #-} -- | Todos.Default.* modules contain implementation of RuntimeConfig instance for DefaultConfig type. @@ -6,7 +6,11 @@ (module Todos.Default.CmdLine, module Todos.Default.Instances, module Todos.Default.Utils, - module Todos.Default.Print) + module Todos.Default.Print, +#ifdef WITH_CURSES + module Todos.Default.Curses +#endif + ) where import Todos.Default.CmdLine @@ -14,3 +18,6 @@ import Todos.Default.Utils import Todos.Default.Print +#ifdef WITH_CURSES +import Todos.Default.Curses +#endif diff --git a/Todos/Default/CmdLine.hs b/Todos/Default/CmdLine.hs --- a/Todos/Default/CmdLine.hs +++ b/Todos/Default/CmdLine.hs @@ -203,6 +203,7 @@ (flags, nonOpts, []) → Right (parseFlags flags, nonOpts) (_, _, msgs) → Left $ concat msgs ⧺ usage +isPattern ∷ String → 𝔹 isPattern s = ('*' ∈ s) || ('?' ∈ s) -- | For given list of glob masks, return list of matching files @@ -253,6 +254,7 @@ Option "h" ["help"] (NoArg HelpF) "display this help" ] +mkSort ∷ String → CmdLineFlag mkSort s = OF $ Sort $ readSort s mkTag ∷ String → CmdLineFlag diff --git a/Todos/Default/Curses.hs b/Todos/Default/Curses.hs new file mode 100644 --- /dev/null +++ b/Todos/Default/Curses.hs @@ -0,0 +1,144 @@ +{-# LANGUAGE UnicodeSyntax #-} + +module Todos.Default.Curses (cursesPrintTodos) where + +import Control.Monad +import Control.Monad.Reader +import System.IO +import System.Console.ANSI as ANSI +import UI.HSCurses.Curses as Curses +import System.Locale.SetLocale + +import Todos.Types +import Todos.Tree +import Todos.Default.Config +import Todos.Default.Print (showTodos, defaultPrintTodos) +import Todos.Formatters hiding (outItem) + +toCursesColor ∷ ANSI.Color → Curses.Color +toCursesColor ANSI.Black = Curses.Color 0 +toCursesColor ANSI.Red = Curses.Color 1 +toCursesColor ANSI.Green = Curses.Color 2 +toCursesColor ANSI.Yellow = Curses.Color 3 +toCursesColor ANSI.Blue = Curses.Color 4 +toCursesColor ANSI.Magenta = Curses.Color 5 +toCursesColor ANSI.Cyan = Curses.Color 6 +toCursesColor ANSI.White = Curses.Color 7 + +setColor ∷ Window → ANSI.ColorIntensity → ANSI.Color → IO () +setColor pad int clr = do + let (Curses.Color c) = toCursesColor clr + (attr, _) ← wAttrGet pad + let attr' = case int of + ANSI.Vivid → Curses.setBold attr True + ANSI.Dull → attr + wAttrSet pad (attr', Pair c) + +setBoldW ∷ Window → IO () +setBoldW pad = do + (attr, pair) ← wAttrGet pad + wAttrSet pad (Curses.setBold attr True, pair) + +reset ∷ Window → IO () +reset pad = wAttrSet pad (attr0, Pair 0) + +-- | Print OutItem to console +outItem ∷ Window → OutItem → IO () +outItem pad (OutString s) = wAddStr pad s +outItem pad (OutSetColor i c) = setColor pad i c +outItem pad SetBold = setBoldW pad +outItem pad ResetAll = reset pad + +cursesPrintTodos ∷ (TodoItem → IO ()) → PrintConfig DefaultConfig → [Todo] → IO () +cursesPrintTodos run cfg lst = do + tty ← hIsTerminalDevice stdout + if not tty + then defaultPrintTodos cfg lst + else do + todos <- if hasCycles lst + then do + hPutStrLn stderr "Warning: cycles in TODOs; `execute' will not work" + return lst + else return $ markLevels $ enumerateTodos lst + setLocale LC_ALL Nothing + initCurses + (lines,cols) ← scrSize + let nLines = fromIntegral $ treeLines todos + if nLines >= lines + then do + np ← colorPairs + nc ← colors + let m = min np nc + forM_ [0..m-1] $ \i → + initPair (Pair i) (Curses.Color i) (Curses.Color (-1)) + pad ← newPad nLines cols + let lst' = runReader (showTodos todos) cfg + forM lst' (outItem pad) + echo False + scrollPad pad nLines lines cols (runByNumber run todos) + delWin pad + endWin + else do + endWin + defaultPrintTodos cfg lst + +runByNumber ∷ (TodoItem → IO ()) → [Todo] → Int → IO () +runByNumber run todos i = + case itemByNumber todos (fromIntegral i) of + Nothing → putStrLn $ "Not found: " ++ show i + Just x → run x + +scrollPad ∷ Window → Int → Int → Int → (Int → IO ()) → IO () +scrollPad pad padLines lines cols run = do + wMove pad 0 0 + scrollToLine 0 + waitForKeys 0 + where + scrollToLine i = pRefresh pad i 0 0 0 (lines-1) (cols-1) + + scroll i = do + scrollToLine i + waitForKeys i + + moveDown i = do + (y,x) ← getYX pad + wMove pad (min (padLines-1) (y+1)) x + if y-i == lines - 1 + then scroll $ min (padLines - lines) (i+1) + else scroll i + + moveUp i = do + (y,x) ← getYX pad + wMove pad (max 0 (y-1)) x + if y == i + then scroll $ max 0 (i-1) + else scroll i + + moveRight i = do + (y,x) ← getYX pad + wMove pad y $ min (cols-1) (x+1) + scroll i + + moveLeft i = do + (y,x) ← getYX pad + wMove pad y $ max 0 (x-1) + scroll i + + runSelected = do + (y,_) ← getYX pad + wAddStr pad (show y) + run (y+1) + + waitForKeys i = do + c ← getCh + case c of + KeyChar 'q' → return () + KeyChar 'j' → moveDown i + KeyChar 'k' → moveUp i + KeyChar 'h' → moveLeft i + KeyChar 'l' → moveRight i + KeyChar 'g' → scroll 0 + KeyChar 'G' → scroll (padLines - lines) + KeyChar 'e' → runSelected + _ → beep >> waitForKeys i + diff --git a/Todos/Dot/Render.hs b/Todos/Dot/Render.hs --- a/Todos/Dot/Render.hs +++ b/Todos/Dot/Render.hs @@ -19,9 +19,7 @@ dotSubgraphs ∷ [Subgraph] } -data Subgraph = Subgraph { - subLabel ∷ String, - subItems ∷ [TodoItem] } +data Subgraph = Subgraph String [TodoItem] deriving (Eq) toDot ∷ Todo → Dot diff --git a/Todos/Formatters.hs b/Todos/Formatters.hs --- a/Todos/Formatters.hs +++ b/Todos/Formatters.hs @@ -98,33 +98,49 @@ colorStatus st = do getclr ← asks printStatusColor let (int, clr) = getclr st + colored int clr st + +-- | Output string in specified color +colored ∷ (RuntimeConfig (PrintConfig c)) ⇒ ColorIntensity → Color → String → Formatter c +colored int clr str = do col ← askBase outColors if col - then return [OutSetColor int clr, OutString st, ResetAll] - else return [OutString st] + then return [OutSetColor int clr, OutString str, ResetAll] + else return [OutString str] printM ∷ (RuntimeConfig (PrintConfig c)) ⇒ TodoItem → Formatter c printM item = askBase outputFormat >>= printf where printf :: (RuntimeConfig (PrintConfig c)) ⇒ String → Formatter c - printf "" = return [] - printf [c] = return [OutString [c]] - printf ('%':c:xs) = liftM2 (⧺) (itemPart c) (printf xs) - printf (x:xs) = do r ← printf xs - return $ (OutString [x]):r + printf "" = return [] + printf [c] = return [OutString [c]] + printf ('%':c:xs) = liftM2 (⧺) (itemPart c) (printf xs) + printf ('\\':c:xs) = liftM2 (:) (outChar $ escape c) (printf xs) + printf (x:xs) = do r ← printf xs + return $ (OutString [x]):r + + outChar c = return (OutString [c]) + escape '\\' = '\\' + escape 't' = '\t' + escape 'n' = '\n' + escape 'b' = '\b' + escape 'v' = '\v' + escape c = c + tags = filter (not ∘ null) $ itemTags item string s = return [OutString s] itemPart ∷ (RuntimeConfig (PrintConfig c)) ⇒ Char → Formatter c - itemPart 'L' = string (show $ itemLevel item) itemPart 'n' = bold item itemPart 't' = if null tags then return [] else string ("[" ⧺ unwords tags ⧺ "] ") itemPart 's' = colorStatus (itemStatus item) + itemPart 'p' = string (itemPrefix item) itemPart 'd' = string (itemDescr item) itemPart 'f' = string (fileName item) + itemPart 'i' = colored Dull Yellow (makeId item) itemPart 'l' = string (show $ lineNr item) itemPart 'D' | null dates' = return [] | otherwise = string $ "(" ⧺ dates' ⧺ ") " diff --git a/Todos/Loader.hs b/Todos/Loader.hs --- a/Todos/Loader.hs +++ b/Todos/Loader.hs @@ -24,9 +24,6 @@ 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 @@ -139,6 +136,7 @@ where item = Item { itemLevel = 0, + itemPrefix = "", itemName = tag, itemTags = ["TAG"], depends = [], @@ -148,7 +146,8 @@ endDate = Nothing, deadline = Nothing, fileName = "(no file)", - lineNr = 0 } + lineNr = 0, + itemNumber = 0} groupByTag' ∷ [Todo] → [Todo] groupByTag' todos = @@ -159,6 +158,7 @@ where item = Item { itemLevel = 0, + itemPrefix = "", itemName = st, itemTags = ["STATUS"], depends = [], @@ -168,7 +168,8 @@ endDate = Nothing, deadline = Nothing, fileName = "(no file)", - lineNr = 0 } + lineNr = 0, + itemNumber = 0} groupByStatus' ∷ [Todo] → [Todo] groupByStatus' todos = @@ -183,6 +184,7 @@ fileTodo ∷ FilePath → TodoItem fileTodo path = Item { itemLevel = 0, + itemPrefix = "", itemName = takeFileName path, itemTags = [dirname path], depends = [], @@ -192,7 +194,8 @@ endDate = Nothing, deadline = Nothing, fileName = path, - lineNr = 0 } + lineNr = 0, + itemNumber = 0} todosGroup ∷ FilePath → [TodoItem] -> [TodoItem] todosGroup path items = diff --git a/Todos/Main.hs b/Todos/Main.hs --- a/Todos/Main.hs +++ b/Todos/Main.hs @@ -11,7 +11,6 @@ import IO import Data.Tree import System.Exit -import System.Cmd (system) import System.Environment import Config.Dyre @@ -23,16 +22,31 @@ import Todos.Tree import Todos.ReadConfig import Todos.Loader -import Todos.CommandParser import Todos.Config import Todos.Default +-- | Sort command line arguments: +-- (should we read other configs, command-line specified config files, command-line options) +sortCmdLine ∷ [String] → (𝔹, [String], [String]) +sortCmdLine args = foldr sortOne (True, [],[]) args + where + sortOne "@@" (_, configs, as) = (False, configs, as) + sortOne ('@':'@':path) (_, configs, as) = (False, path:configs, as) + sortOne ('@':path) (r, configs, as) = (r, path:configs, as) + sortOne option (r, configs, as) = (r, configs, option:as) + +-- | Real main funciton. Is called by dyre. realTodos ∷ (RuntimeConfig c) ⇒ TodosConfig c → IO () realTodos tcfg = do currDate ← getCurrentDateTime - config ← readConfig args ← getArgs - let pres = (parseCommandLine tcfg) currDate (nullConfig tcfg) (config ⧺ args) + let (readOther, configs, args') = sortCmdLine args + config ← if readOther + then readAllConfigs + else return [] + -- Read options from command-line specified config files + cmdLineConfig ← concat `fmap` mapM readConfigFile configs + let pres = (parseCommandLine tcfg) currDate (nullConfig tcfg) (config ⧺ cmdLineConfig ⧺ args') case pres of Parsed q files' → do let bc = toBaseConfig q @@ -44,7 +58,7 @@ ShowAsDot → putStrLn $ showAsDot (itemColor tcfg) (itemShape tcfg) queried SystemCommand cmd → do - forT selected (\item → system $ printfItem cmd item) + forT selected (spawn cmd) return () where selected | outOnlyFirst bc = [Node (rootLabel $ head queried) []] | otherwise = queried diff --git a/Todos/Parser.hs b/Todos/Parser.hs --- a/Todos/Parser.hs +++ b/Todos/Parser.hs @@ -7,6 +7,7 @@ import Data.List import Text.ParserCombinators.Parsec import Data.Char +import Text.Regex.PCRE import Todos.Unicode import Todos.Types @@ -46,13 +47,20 @@ where word = many1 (noneOf " \t\n\r]") -pItem ∷ DateTime → TParser TodoItem -pItem date = do +pItem ∷ String → DateTime → TParser TodoItem +pItem prefix date = do + pr ← if null prefix + then return "" + else do + w ← many1 (noneOf " \t\n\r") + if w =~ prefix + then return w + else fail $ "Internal error: invalid prefix: " ⧺ w ⧺ " =~ " ⧺ prefix pos ← getPosition s ← pSpaces conf ← getState stat ← if skipStatus conf - then case forcedStatus conf of + then case forcedStatus conf of Just fs → return fs Nothing → return "*" else do @@ -71,6 +79,7 @@ many ⋄ oneOf "\n\r" return ⋄ Item { itemLevel = fromIntegral $ length s, + itemPrefix = pr, itemName = unwords namew, itemTags = tags, depends = deps, @@ -80,7 +89,8 @@ endDate = lookup EndDate dates, deadline = lookup Deadline dates, fileName = sourceName pos, - lineNr = sourceLine pos } + lineNr = sourceLine pos, + itemNumber = 0} pWord ∷ TParser String pWord = do @@ -88,9 +98,9 @@ (try pSpace') <|> (return w) return w -pItems ∷ DateTime → TParser [TodoItem] -pItems date = do - its ← many (pItem date) +pItems ∷ String → DateTime → TParser [TodoItem] +pItems prefix date = do + its ← many (pItem prefix date) eof return its @@ -100,7 +110,7 @@ addLines = filter (not ∘ (prefix `isPrefixOf`)) tl in case addLines of [] → hd - _ → hd ⧺ " {" ++ (unwords addLines) ++ "}" + _ → hd ⧺ " {" ⧺ unwords addLines ⧺ "}" filterN ∷ (Num a, Enum a) ⇒ Int → String → [String] → ([a], [String]) filterN n prefix lst = @@ -109,10 +119,13 @@ 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) + regex = makeRE prefix + isGood x = x =~ regex + in (map (+1) lns, ans) +makeRE ∷ String → String +makeRE x = "^(" ⧺ x ⧺ ")" + filterJoin ∷ Int → String → String → ([Int], String) filterJoin n prefix str = let (ns, lns) = filterN n prefix (lines str) @@ -125,7 +138,7 @@ → String -- ^ String to parse → [TodoItem] parsePlain conf date path text = - case runParser (pItems date) conf path text of + case runParser (pItems "" date) conf path text of Right items → items Left e → error $ show e @@ -141,7 +154,7 @@ let (ns, filtered) = filterJoin next prefix text renumber lst = zipWith renumber1 ns lst renumber1 n item = item {lineNr=n} - in case runParser (pItems date) conf path filtered of + in case runParser (pItems (makeRE prefix) date) conf path filtered of Right items → renumber items Left e → error $ show e diff --git a/Todos/ReadConfig.hs b/Todos/ReadConfig.hs --- a/Todos/ReadConfig.hs +++ b/Todos/ReadConfig.hs @@ -2,14 +2,14 @@ -- | Module for parsing config files module Todos.ReadConfig - (readConfig) + (readAllConfigs, readConfigFile) where import Prelude hiding (putStrLn,readFile,getContents,print) import Todos.IO import System.Environment import System.FilePath -import System.Directory (doesFileExist) +import System.Directory (doesFileExist, getCurrentDirectory) import Text.ParserCombinators.Parsec import Todos.Unicode @@ -17,8 +17,10 @@ word ∷ Parser String word = choice $ map try [quotedOption, simpleOption, quoted, simpleWord] +simpleWord ∷ Parser String simpleWord = many1 $ noneOf " \t\r\n=\"'" +quotedOption ∷ Parser String quotedOption = (try quotedLongOption) <|> quotedShortOption quotedLongOption ∷ Parser String @@ -36,25 +38,27 @@ v ← quoted return ("-" ⧺ o ⧺ v) +simpleOption ∷ Parser String simpleOption = do o ← simpleWord optional $ char '=' v ← simpleWord return (o ⧺ "=" ⧺ v) +quoted ∷ Parser String quoted = quoted1 <|> quoted2 - -quoted1 = do - char '\'' - s ← many1 $ noneOf "'" - char '\'' - return s + where + quoted1 = do + char '\'' + s ← many1 $ noneOf "'" + char '\'' + return s -quoted2 = do - char '"' - s ← many1 $ noneOf "\"" - char '"' - return s + quoted2 = do + char '"' + s ← many1 $ noneOf "\"" + char '"' + return s pConfig ∷ Parser [String] pConfig = word `sepBy` space @@ -65,8 +69,9 @@ Right lst → lst Left err → error $ show err -readFile' ∷ FilePath → IO [String] -readFile' path = +-- | Read list of options from given config file +readConfigFile ∷ FilePath → IO [String] +readConfigFile path = do b ← doesFileExist path if not b then return [] @@ -74,12 +79,23 @@ str ← readFile path return $ parseConfig (unwords $ lines str) +readFiles ∷ [FilePath] → IO [String] +readFiles [] = return [] +readFiles (path:other) = do + content ← readConfigFile path + case content of + "%":options → do otherOptions ← readFiles other + return $ otherOptions ⧺ options + [] → readFiles other + _ → return content + -- | Read list of options from config files -readConfig ∷ IO [String] -readConfig = do +readAllConfigs ∷ IO [String] +readAllConfigs = do home ← getEnv "HOME" let homepath = home ".config" "todos" "todos.conf" - homecfg ← readFile' homepath - localcfg ← readFile' ".todos.conf" + homecfg ← readConfigFile homepath + pwd <- getCurrentDirectory + localcfg ← readFiles $ map ( ".todos.conf") $ scanl1 () $ splitPath pwd return $ homecfg ⧺ localcfg diff --git a/Todos/Tree.hs b/Todos/Tree.hs --- a/Todos/Tree.hs +++ b/Todos/Tree.hs @@ -1,31 +1,42 @@ {-# LANGUAGE UnicodeSyntax, NoMonomorphismRestriction, FlexibleInstances, TypeSynonymInstances #-} module Todos.Tree - (delTag, + (delTag, addTag, mapTags, + flattern, pruneSelector, tagPred, statusPred, grepPred, descPred, datePred, idPred, - forT, mapT) + hasCycles, + forT, mapT, + treeLines, enumerateTodos, itemByNumber, markLevels, + spawn) where import Prelude hiding (putStrLn,readFile,getContents,print) import Control.Monad +import Control.Monad.State +import qualified Data.Traversable as T +import Data.Maybe import Data.Generics import Data.List import Data.Tree +import Data.Hash import Text.Regex.PCRE +import System.Cmd (system) import Todos.Types import Todos.Unicode import Todos.Config +import Todos.CommandParser -mapTags ∷ (Data a) ⇒ ([String] → [String]) → [a] → [a] -mapTags f = map ⋄ everywhere ⋄ mkT changeTags +mapTags ∷ ([String] → [String]) → [Todo] → [Todo] +mapTags f = map ⋄ everywhere (mkT changeTags :: Data a => a -> a) where + changeTags ∷ TodoItem → TodoItem changeTags item@(Item {itemTags=ts}) = item {itemTags = f ts} -addTag ∷ (Data a) ⇒ String → [a] → [a] +addTag ∷ String → [Todo] → [Todo] addTag t = mapTags (t:) -delTag ∷ (Data a) ⇒ String → [a] → [a] +delTag ∷ String → [Todo] → [Todo] delTag t = mapTags (delete t) pruneSelector ∷ BaseConfig → (TodoItem → 𝔹) → (Todo → [Todo]) @@ -43,10 +54,8 @@ | 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} - -- | Check if item has given tag +-- | Check if item has given tag tagPred ∷ String → TodoItem → 𝔹 tagPred tag = \item → tag ∈ itemTags item @@ -85,6 +94,29 @@ flat ∷ Todo → [Todo] flat (Node item trees) = (Node item []):(concatMap flat trees) +untilM ∷ (Monad m) ⇒ (a → m Bool) → [a] → m Bool +untilM fn [] = return False +untilM fn (x:xs) = do + y ← fn x + if y + then return True + else untilM fn xs + +-- | Check if trees contain cycles +hasCycles ∷ (Hashable a) ⇒ [Tree a] → 𝔹 +hasCycles trees = any cycled trees + where + cycled (Node z trees) = evalState (untilM test trees) [hash z] + + test (Node item children) = do + old ← get + let h = hash item + if h ∈ old + then return True + else do + put (h: old) + untilM test children + -- | For each item in the tree, execute given monadic action (this is similar -- to forM, but for trees instead of lists). forT ∷ (Monad m, Eq t) ⇒ [Tree t] → (t → m a) → m [b] @@ -100,4 +132,35 @@ mapT f todos = map mapT' todos where mapT' (Node item trees) = Node (f item) (mapT f trees) + +treeLines ∷ [Tree t] → ℤ +treeLines todos = sum $ map treeLines' todos + where + treeLines' (Node _ children) = 1 + (sum $ map treeLines' children) + +enumerateTodos ∷ [Todo] → [Todo] +enumerateTodos list = snd $ T.mapAccumL enumTree 1 list + where + enumTree ∷ ℤ → Todo → (ℤ, Todo) + enumTree i tree = T.mapAccumL enum i tree + + enum ∷ ℤ → TodoItem → (ℤ, TodoItem) + enum i item = (i + 1, item{itemNumber = i}) + +itemByNumber ∷ [Todo] → ℤ → Maybe TodoItem +itemByNumber todos i = listToMaybe $ everything (⧺) (listify check) todos + where + check ∷ TodoItem → 𝔹 + check item = itemNumber item == i + +markLevels ∷ [Todo] → [Todo] +markLevels todos = map (mark 0) todos + where + mark i (Node item children) = + Node (item {itemLevel=i}) $ map (mark $ i+1) children + +spawn ∷ String → TodoItem → IO () +spawn format item = do + system $ printfItem format item + return () diff --git a/Todos/Types.hs b/Todos/Types.hs --- a/Todos/Types.hs +++ b/Todos/Types.hs @@ -63,9 +63,9 @@ showMonth i = capitalize $ months !! (i-1) instance Show DateTime where - show (DateTime y m d h min s) = + show (DateTime y m d h mins s) = show d ⧺ " " ⧺ showMonth m ⧺ " " ⧺ show y ⧺ ", " ⧺ - show h ⧺ ":" ⧺ show min ⧺ ":" ⧺ show s + show h ⧺ ":" ⧺ show mins ⧺ ":" ⧺ show s -- | Only time, without date data Time = @@ -78,6 +78,7 @@ -- | TODO item itself. data TodoItem = Item { itemLevel ∷ ℤ, -- ^ Indentation level (from source file) + itemPrefix ∷ String, -- ^ A prefix before item in source file (or empty string) itemName ∷ String, -- ^ Name (title) of the item itemTags ∷ [String], -- ^ Tags of the item depends ∷ [String], -- ^ Names (titles) of item's depends @@ -87,7 +88,8 @@ endDate ∷ Maybe DateTime, -- ^ Date when TODO is planned to end deadline ∷ Maybe DateTime, -- ^ Deadline for this TODO fileName ∷ FilePath, -- ^ Path to the source file - lineNr ∷ Line -- ^ Line in the source file, where this item was defined + lineNr ∷ Line, -- ^ Line in the source file, where this item was defined + itemNumber ∷ ℤ -- ^ Raw number of item } deriving (Eq,Data,Typeable) diff --git a/todos.cabal b/todos.cabal --- a/todos.cabal +++ b/todos.cabal @@ -1,5 +1,5 @@ Name: todos -Version: 0.4 +Version: 0.5 Cabal-Version: >= 1.6 License: BSD3 License-File: LICENSE @@ -15,6 +15,9 @@ Extra-source-files: Makefile README README.ru TODO +flag with_curses + Description: Build Todos.Default.Curses module, for ncurses output. + library Exposed-Modules: Todos Todos.Default @@ -40,9 +43,14 @@ Todos.Unicode Todos.Formatters - Build-Depends: base >= 3 && <= 5, haskell98, containers, parsec >= 2 && < 3, + Build-Depends: base >= 3 && <= 5, haskell98, containers, parsec >= 3, syb, mtl, ansi-terminal, Glob, time, regex-pcre, directory, filepath, process, data-hash, dyre, utf8-string + + if flag(with_curses) + Exposed-Modules: Todos.Default.Curses + Build-Depends: hscurses, setlocale + cpp-options: -DWITH_CURSES ghc-options: -fwarn-unused-imports