todos 0.4 → 0.5

raw patch · 17 files changed

+448/−91 lines, 17 filesdep +hscursesdep +setlocaledep ~parsec

Dependencies added: hscurses, setlocale

Dependency ranges changed: parsec

Files

• Makefile +2/−2
• README +32/−4
• README.ru +41/−7
• Todos/CommandParser.hs +14/−5
• Todos/Dates.hs +3/−3
• Todos/Default.hs +9/−2
• Todos/Default/CmdLine.hs +2/−0
• Todos/Default/Curses.hs +144/−0
• Todos/Dot/Render.hs +1/−3
• Todos/Formatters.hs +24/−8
• Todos/Loader.hs +9/−6
• Todos/Main.hs +19/−5
• Todos/Parser.hs +26/−13
• Todos/ReadConfig.hs +35/−19
• Todos/Tree.hs +72/−9
• Todos/Types.hs +5/−3
• todos.cabal +10/−2

@@ -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

@@ -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.

@@ -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 компилирует и запускает

@@ -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 ⧺ ") "

@@ -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

@@ -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

@@ -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

@@ -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+

@@ -19,9 +19,7 @@   dotSubgraphs ∷ [Subgraph]   } -data Subgraph = Subgraph {-  subLabel ∷ String,-  subItems ∷ [TodoItem] }+data Subgraph = Subgraph String [TodoItem]   deriving (Eq)  toDot ∷ Todo → Dot

@@ -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' ⧺ ") "

@@ -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 =

@@ -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

@@ -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 

@@ -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   

@@ -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 () 

@@ -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) 

@@ -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