packages feed

slate 0.13.0.0 → 0.13.1.0

raw patch · 9 files changed

+293/−205 lines, 9 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Ansi: makeGreen :: String -> String
- Ansi: makeGrey :: String -> String
- Ansi: makeRed :: String -> String
- Ansi: makeResetEmphasis :: String -> String
- Ansi: makeResetUnderline :: String -> String
- Ansi: resetEmphasis :: String
- Style: instance GHC.Show.Show Style.Style
- Style: instance GHC.Show.Show Style.Text
+ Ansi: faint :: String
+ Ansi: italic :: String
+ Ansi: makeFaint :: String -> String
+ Ansi: makeItalic :: String -> String
+ Ansi: paint :: (Palette -> String) -> String -> String
+ Ansi: resetBold :: String
+ Ansi: resetItalic :: String
+ Command: Edit :: Maybe Slate -> Command
+ Command: type Slate = String
+ Task: Doing :: Status
+ Task: Done :: Status
+ Task: Task :: Int -> Status -> String -> Maybe String -> Task
+ Task: Todo :: Status
+ Task: [comment] :: Task -> Maybe String
+ Task: [line] :: Task -> Int
+ Task: [status] :: Task -> Status
+ Task: [text] :: Task -> String
+ Task: data Status
+ Task: data Task
+ Task: dumpTasks :: [Task] -> String
+ Task: loadTasks :: Int -> [Task] -> [String] -> [Task]
+ Task: showTasks :: [Task] -> [String]
- Command: Add :: Slate -> Note -> Command
+ Command: Add :: Maybe Slate -> Task -> Command
- Command: Display :: Slate -> Filter -> Command
+ Command: Display :: Maybe Slate -> Maybe Filter -> Command
- Command: Doing :: Slate -> Maybe NoteId -> Command
+ Command: Doing :: Maybe Slate -> Maybe TaskId -> Command
- Command: Done :: Slate -> Maybe NoteId -> Command
+ Command: Done :: Maybe Slate -> Maybe TaskId -> Maybe Comment -> Command
- Command: Remove :: Slate -> NoteId -> Command
+ Command: Remove :: Maybe Slate -> TaskId -> Command
- Command: Status :: Slate -> Command
+ Command: Status :: Maybe Slate -> Command
- Command: Todo :: Slate -> Maybe NoteId -> Command
+ Command: Todo :: Maybe Slate -> Maybe TaskId -> Command
- Command: Wipe :: Slate -> Filter -> Command
+ Command: Wipe :: Maybe Slate -> Maybe Filter -> Command
- Config: getSlatePath :: String -> IO FilePath
+ Config: getSlatePath :: Maybe String -> IO FilePath
- Filter: doing :: String -> Bool
+ Filter: doing :: Task -> Bool
- Filter: done :: String -> Bool
+ Filter: done :: Task -> Bool
- Filter: todo :: String -> Bool
+ Filter: todo :: Task -> Bool

Files

app/Main.hs view
@@ -1,7 +1,7 @@ module Main where  import Data.Semigroup ((<>))-import Lib+import Lib (execute, initialize, parser) import Options.Applicative  main :: IO ()@@ -13,4 +13,4 @@     opts =       info         (parser <**> helper)-        (fullDesc <> progDesc "Slate" <> header "slate - a note taking tool.")+        (fullDesc <> progDesc "Slate" <> header "slate - a task taking tool.")
slate.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: ca55e5d9e79e4ff7d881a04647a1111a94d04f291ee2995939812486f4807c72+-- hash: 2549dba7ab74a557507567f4b805938039dd154ae72c0899df947cb4831c2497  name:           slate-version:        0.13.0.0+version:        0.13.1.0 synopsis:       A note taking CLI tool. description:    Please see the README on Github at <https://github.com/evuez/slate#readme> homepage:       https://github.com/evuez/slate#readme@@ -34,6 +34,7 @@       Filter       Lib       Style+      Task   other-modules:       Paths_slate   hs-source-dirs:
src/Ansi.hs view
@@ -17,6 +17,12 @@ bold :: String bold = "\x1B[1m" +faint :: String+faint = "\x1B[2m"++italic :: String+italic = "\x1B[3m"+ underline :: String underline = "\x1B[4m" @@ -26,9 +32,12 @@ crossed :: String crossed = "\x1B[9m" -resetEmphasis :: String-resetEmphasis = "\x1B[22m"+resetBold :: String+resetBold = "\x1B[22m" +resetItalic :: String+resetItalic = "\x1B[23m"+ resetUnderline :: String resetUnderline = "\x1B[24m" @@ -61,6 +70,12 @@ makeBold :: String -> String makeBold s = bold ++ s ++ reset +makeItalic :: String -> String+makeItalic s = italic ++ s ++ reset++makeFaint :: String -> String+makeFaint s = faint ++ s ++ reset+ makeUnderline :: String -> String makeUnderline s = underline ++ s ++ reset @@ -70,17 +85,5 @@ makeCrossed :: String -> String makeCrossed s = crossed ++ s ++ reset -makeResetEmphasis :: String -> String-makeResetEmphasis s = resetEmphasis ++ s ++ reset--makeResetUnderline :: String -> String-makeResetUnderline s = resetUnderline ++ s ++ reset--makeRed :: String -> String-makeRed s = red ++ s ++ reset--makeGreen :: String -> String-makeGreen s = green ++ s ++ reset--makeGrey :: String -> String-makeGrey s = grey ++ s ++ reset+paint :: (Palette -> String) -> String -> String+paint f s = (f palette) ++ s ++ reset
src/Command.hs view
@@ -1,6 +1,7 @@ module Command   ( parser   , Command(..)+  , Slate   ) where  import Data.Semigroup ((<>))@@ -8,62 +9,78 @@  type Slate = String -type Note = String+type Task = String -type NoteId = Int+type TaskId = Int  type Filter = String +type Comment = String+ data Command-  = Add Slate-        Note-  | Done Slate-         (Maybe NoteId)-  | Todo Slate-         (Maybe NoteId)-  | Doing Slate-          (Maybe NoteId)-  | Remove Slate-           NoteId-  | Display Slate-            Filter+  = Add (Maybe Slate)+        Task+  | Display (Maybe Slate)+            (Maybe Filter)+  | Doing (Maybe Slate)+          (Maybe TaskId)+  | Done (Maybe Slate)+         (Maybe TaskId)+         (Maybe Comment)+  | Edit (Maybe Slate)+  | Remove (Maybe Slate)+           TaskId   | Rename Slate            Slate-  | Wipe Slate-         Filter-  | Status Slate+  | Status (Maybe Slate)   | Sync+  | Todo (Maybe Slate)+         (Maybe TaskId)+  | Wipe (Maybe Slate)+         (Maybe Filter)   deriving (Eq, Show) -name :: Parser String+name :: Parser (Maybe Slate) name =-  option-    str-    (long "name" <> short 'n' <> metavar "SLATE" <> help "Name of the slate." <>-     value "")+  optional+    (option+       str+       (long "name" <> short 'n' <> metavar "SLATE" <> help "Name of the slate.")) +taskId :: Parser TaskId+taskId = argument auto (metavar "TASK ID")+ add :: Parser Command-add = Add <$> name <*> argument str (metavar "NOTE")+add = Add <$> name <*> argument str (metavar "TASK")  done :: Parser Command-done = Done <$> name <*> optional (argument auto (metavar "NOTE ID"))+done =+  Done <$> name <*> optional taskId <*>+  optional+    (option+       str+       (long "comment" <> short 'c' <> metavar "COMMENT" <>+        help "Additional comment."))  todo :: Parser Command-todo = Todo <$> name <*> optional (argument auto (metavar "NOTE ID"))+todo = Todo <$> name <*> optional taskId  doing :: Parser Command-doing = Doing <$> name <*> optional (argument auto (metavar "NOTE ID"))+doing = Doing <$> name <*> optional taskId +edit :: Parser Command+edit = Edit <$> name+ remove :: Parser Command-remove = Remove <$> name <*> argument auto (metavar "NOTE ID")+remove = Remove <$> name <*> taskId  display :: Parser Command display =   Display <$> name <*>-  option-    str-    (long "only" <> short 'o' <> help "Display only done / todo notes." <>-     value "")+  optional+    (option+       str+       (long "only" <> short 'o' <> help "Display only done / todo tasks."))  rename :: Parser Command rename =@@ -73,9 +90,10 @@ wipe :: Parser Command wipe =   Wipe <$> name <*>-  option-    str-    (long "only" <> short 'o' <> help "Wipe only done / todo notes." <> value "")+  optional+    (option+       str+       (long "only" <> short 'o' <> help "Wipe only done / todo tasks."))  status :: Parser Command status = Status <$> name@@ -86,26 +104,29 @@ parser :: Parser Command parser =   subparser-    (command "add" (info add (progDesc "Add a note.")) <>+    (command "add" (info add (progDesc "Add a task.")) <>      command        "done"        (info           done           (progDesc-             "Mark a note as done when given a note ID, display done notes otherwise.")) <>+             "Mark a task as done when given a task ID, display done tasks otherwise.")) <>      command        "todo"        (info           todo           (progDesc-             "Mark a note as todo when given a note ID, display todo notes otherwise.")) <>+             "Mark a task as todo when given a task ID, display todo tasks otherwise.")) <>      command        "doing"        (info           doing           (progDesc-             "Toggle highlighting on a note when given a note ID, display notes marked as doing otherwise.")) <>-     command "remove" (info remove (progDesc "Remove a note.")) <>+             "Toggle highlighting on a task when given a task ID, display tasks marked as doing otherwise.")) <>+     command+       "edit"+       (info edit (progDesc "Open the slate in the default editor.")) <>+     command "remove" (info remove (progDesc "Remove a task.")) <>      command "display" (info display (progDesc "Display a slate.")) <>      command "rename" (info rename (progDesc "Rename a slate.")) <>      command "wipe" (info wipe (progDesc "Wipe a slate.")) <>
src/Config.hs view
@@ -54,18 +54,18 @@   let headOrFail =         \x ->           maybe-            (error "The .slate file in this directory shouldn't be empty.")+            (error "Found a .slate file in the current directory but it is empty.")             id             (listToMaybe x)   doesFileExist (d ++ "/.slate") >>= \case     True -> readFile (d ++ "/.slate") >>= (return . headOrFail . lines)     False -> return $ takeBaseName d -getSlatePath :: String -> IO FilePath-getSlatePath "" = do+getSlatePath :: Maybe String -> IO FilePath+getSlatePath Nothing = do   s <- slateName   dir <- configDirectory   return $ dir ++ s ++ ".md"-getSlatePath s = do+getSlatePath (Just s) = do   dir <- configDirectory   return $ dir ++ s ++ ".md"
src/Filter.hs view
@@ -4,15 +4,17 @@   , doing   ) where -done :: String -> Bool-done (' ':'-':' ':'[':'x':']':_) = True-done ('\x1B':'[':'9':'m':_) = True-done _ = False+import qualified Task as T (Status(..), Task(..)) -todo :: String -> Bool-todo n = (not . done) n+done :: T.Task -> Bool+done (T.Task _ T.Done _ _) = True+done (T.Task _ _ _ _) = False -doing :: String -> Bool-doing (' ':'-':' ':'[':' ':']':' ':'>':_) = True-doing ('\x1B':'[':'7':'m':_) = True-doing _ = False+todo :: T.Task -> Bool+todo (T.Task _ T.Todo _ _) = True+todo (T.Task _ T.Doing _ _) = True+todo (T.Task _ _ _ _) = False++doing :: T.Task -> Bool+doing (T.Task _ T.Doing _ _) = True+doing (T.Task _ _ _ _) = False
src/Lib.hs view
@@ -1,23 +1,20 @@ module Lib   ( initialize   , execute-  , parser+  , C.parser   ) where  import Ansi   ( Palette(primary, secondary, success, ternary, warning)-  , makeCrossed-  , makeGreen-  , makeInverse-  , makeRed+  , paint   , palette   , progress   , reset   )-import Command (Command(..), parser)+import qualified Command as C (Command(..), Slate, parser) import Config (configDirectory, getConfigValue, getSlatePath)+import Data.Maybe (fromMaybe, listToMaybe) import qualified Filter as F (doing, done, todo)-import Style (preen) import System.Directory (createDirectoryIfMissing, removeFile, renameFile) import System.Exit (ExitCode(ExitFailure, ExitSuccess)) import System.Process@@ -26,143 +23,115 @@   , cwd   , env   , shell+  , spawnProcess   , std_out   , waitForProcess   )+import qualified Task as T+  ( Status(..)+  , Task(..)+  , dumpTasks+  , loadTasks+  , showTasks+  ) -execute :: Command -> IO ()-execute (Add s n) =-  getSlatePath s >>= (\x -> appendFile x (" - [ ] " ++ n ++ "\n"))-execute (Done s (Just n)) = getSlatePath s >>= (\x -> markAsDone x n)-execute (Done s Nothing) = getSlatePath s >>= (\x -> displaySlate x "done")-execute (Todo s (Just n)) = getSlatePath s >>= (\x -> markAsTodo x n)-execute (Todo s Nothing) = getSlatePath s >>= (\x -> displaySlate x "todo")-execute (Doing s (Just n)) = getSlatePath s >>= (\x -> markAsDoing x n)-execute (Doing s Nothing) = getSlatePath s >>= (\x -> displaySlate x "doing")-execute (Remove s n) = getSlatePath s >>= (\x -> removeNote x n)-execute (Display s f) = getSlatePath s >>= (\x -> displaySlate x f)-execute (Rename sc sn) = renameSlate sc sn-execute (Wipe s "") = getSlatePath s >>= removeFile-execute (Wipe s f) = getSlatePath s >>= (\x -> wipeSlate x f)-execute (Status s) = getSlatePath s >>= (\x -> displayStatus x)-execute (Sync) = syncSlates+execute :: C.Command -> IO ()+execute (C.Add s t) =+  getSlatePath s >>= (\x -> appendFile x (" - [ ] " ++ t ++ "\n"))+execute (C.Done s (Just ti) comment) =+  getSlatePath s >>= (\x -> markAsDone x ti comment)+execute (C.Done s Nothing _) =+  getSlatePath s >>= (\x -> displaySlate x (Just "done"))+execute (C.Todo s (Just ti)) = getSlatePath s >>= (\x -> markAsTodo x ti)+execute (C.Todo s Nothing) =+  getSlatePath s >>= (\x -> displaySlate x (Just "todo"))+execute (C.Doing s (Just ti)) = getSlatePath s >>= (\x -> markAsDoing x ti)+execute (C.Doing s Nothing) =+  getSlatePath s >>= (\x -> displaySlate x (Just "doing"))+execute (C.Edit s) = getSlatePath s >>= editSlate+execute (C.Remove s ti) = getSlatePath s >>= (\x -> removeTask x ti)+execute (C.Display s f) = getSlatePath s >>= (\x -> displaySlate x f)+execute (C.Rename sc sn) = renameSlate sc sn+execute (C.Wipe s Nothing) = getSlatePath s >>= removeFile+execute (C.Wipe s (Just f)) = getSlatePath s >>= (\x -> wipeSlate x f)+execute (C.Status s) = getSlatePath s >>= (\x -> displayStatus x)+execute (C.Sync) = syncSlates  initialize :: IO () initialize = configDirectory >>= (\c -> createDirectoryIfMissing True c) -displaySlate :: String -> String -> IO ()-displaySlate s "" = do-  contents <- readFile s-  putStr $ unlines $ displayNotes (lines contents)-displaySlate s "done" = do-  contents <- readFile s-  putStr $ unlines $ filter F.done $ displayNotes (lines contents)-displaySlate s "todo" = do-  contents <- readFile s-  putStr $ unlines $ filter F.todo $ displayNotes (lines contents)-displaySlate s "doing" = do-  contents <- readFile s-  putStr $ unlines $ filter F.doing $ displayNotes (lines contents)-displaySlate _ f = putStrLn $ "\"" ++ f ++ "\" is not a valid filter."--displayNotes :: [String] -> [String]-displayNotes notes = zipWith (displayNote $ length notes) [0 ..] notes+readTasks :: FilePath -> IO [T.Task]+readTasks s = T.loadTasks 0 [] <$> lines <$> readFile s -displayNote :: Int -> Int -> String -> String-displayNote total line (' ':'-':' ':'[':_:']':' ':'>':note) =-  makeInverse $-  (ternary palette) ++ alignRight total line ++ reset ++ " -" ++ preen note-displayNote total line (' ':'-':' ':'[':' ':']':note) =-  (ternary palette) ++ alignRight total line ++ reset ++ " -" ++ preen note-displayNote total line (' ':'-':' ':'[':'x':']':note) =-  makeCrossed $-  (ternary palette) ++ alignRight total line ++ reset ++ " -" ++ preen note-displayNote total line _ =-  makeRed $-  (ternary palette) ++-  alignRight total line ++ reset ++ " - Parsing error: line is malformed"+writeTasks :: FilePath -> [T.Task] -> IO ()+writeTasks s tasks = do+  let tmp = s ++ ".tmp"+  writeFile tmp (T.dumpTasks tasks)+  renameFile tmp s -alignRight :: Int -> Int -> String-alignRight x n = replicate (length (show x) - length (show n)) ' ' ++ show n+displaySlate :: FilePath -> Maybe String -> IO ()+displaySlate s Nothing = putStr =<< unlines <$> T.showTasks <$> readTasks s+displaySlate s (Just "done") =+  putStr =<< unlines <$> T.showTasks <$> filter F.done <$> readTasks s+displaySlate s (Just "todo") =+  putStr =<< unlines <$> T.showTasks <$> filter F.todo <$> readTasks s+displaySlate s (Just "doing") =+  putStr =<< unlines <$> T.showTasks <$> filter F.doing <$> readTasks s+displaySlate _ (Just f) = putStrLn $ "\"" ++ f ++ "\" is not a valid filter." -markAsDone :: FilePath -> Int -> IO ()-markAsDone s n = do-  contents <- readFile s-  let (x, y:t) = splitAt n (lines contents)-      c =-        case y of-          ' ':'-':' ':'[':' ':']':' ':'>':note -> " - [x]" ++ note-          ' ':'-':' ':'[':' ':']':note -> " - [x]" ++ note-          note -> note-      tmp = s ++ ".tmp"-  writeFile (s ++ ".tmp") (unlines $ x ++ c : t)-  renameFile tmp s+markAsDone :: FilePath -> Int -> Maybe String -> IO ()+markAsDone s ti comment = do+  (x, t:xs) <- splitAt ti <$> (readTasks s)+  writeTasks s $ x ++ (t {T.status = T.Done, T.comment = comment}) : xs  markAsTodo :: FilePath -> Int -> IO ()-markAsTodo s n = do-  contents <- readFile s-  let (x, y:t) = splitAt n (lines contents)-      c =-        case y of-          ' ':'-':' ':'[':'x':']':note -> " - [ ]" ++ note-          note -> note-      tmp = s ++ ".tmp"-  writeFile tmp (unlines $ x ++ c : t)-  renameFile tmp s+markAsTodo s ti = do+  (x, t:xs) <- splitAt ti <$> (readTasks s)+  writeTasks s $ x ++ (t {T.status = T.Todo}) : xs  markAsDoing :: FilePath -> Int -> IO ()-markAsDoing s n = do-  contents <- readFile s-  let ls = zipWith (removeDoingMarkForOthers n) [0 ..] (lines contents)-  let (x, y:t) = splitAt n ls-      c =-        case y of-          ' ':'-':' ':'[':m:']':' ':'>':note -> " - [" ++ [m] ++ "]" ++ note-          ' ':'-':' ':'[':_:']':note -> " - [ ] >" ++ note-          note -> note-      tmp = s ++ ".tmp"-  writeFile tmp (unlines $ x ++ c : t)-  renameFile tmp s+markAsDoing s ti = writeTasks s . map (markAsDoing' ti) =<< readTasks s -removeDoingMarkForOthers :: Int -> Int -> String -> String-removeDoingMarkForOthers k l p@(' ':'-':' ':'[':m:']':' ':'>':n)-  | k /= l = " - [" ++ [m] ++ "]" ++ n-  | otherwise = p-removeDoingMarkForOthers _ _ n = n+markAsDoing' :: Int -> T.Task -> T.Task+markAsDoing' _ t@(T.Task _ T.Doing _ _) = t {T.status = T.Todo}+markAsDoing' ti t@(T.Task l _ _ _)+  | ti == l = t {T.status = T.Doing}+markAsDoing' _ t = t -removeNote :: FilePath -> Int -> IO ()-removeNote s n = do-  contents <- readFile s-  let (x, _:t) = splitAt n (lines contents)-      tmp = s ++ ".tmp"-  writeFile tmp (unlines $ x ++ t)+editSlate :: FilePath -> IO ()+editSlate s = do+  h <- spawnProcess "vim" [s]+  _ <- waitForProcess h+  return ()++removeTask :: FilePath -> Int -> IO ()+removeTask s ti = do+  (x, _:xs) <- splitAt ti <$> (lines <$> readFile s)+  let tmp = s ++ ".tmp"+  writeFile tmp (unlines $ x ++ xs)   renameFile tmp s -renameSlate :: String -> String -> IO ()+renameSlate :: C.Slate -> C.Slate -> IO () renameSlate sc sn = do-  current <- getSlatePath sc-  new <- getSlatePath sn+  current <- getSlatePath (Just sc)+  new <- getSlatePath (Just sn)   renameFile current new  wipeSlate :: FilePath -> String -> IO ()-wipeSlate s "done" = do-  contents <- readFile s-  let tmp = s ++ ".tmp"-  writeFile tmp $ unlines $ filter F.todo (lines contents)-  renameFile tmp s-wipeSlate s "todo" = do-  contents <- readFile s-  let tmp = s ++ ".tmp"-  writeFile tmp $ unlines $ filter F.done (lines contents)-  renameFile tmp s+wipeSlate s "done" = writeTasks s . filter F.todo =<< readTasks s+wipeSlate s "todo" = writeTasks s . filter F.done =<< readTasks s wipeSlate _ f = putStrLn $ "\"" ++ f ++ "\" is not a valid filter."  displayStatus :: FilePath -> IO () displayStatus s = do   (syncColor, syncString) <- getSyncStatus s-  contents <- readFile s-  let done = fromIntegral $ length $ filter F.done (lines contents) :: Double-      todo = fromIntegral $ length $ filter F.todo (lines contents) :: Double+  tasks <- readTasks s+  let done = fromIntegral $ length $ filter F.done tasks :: Double+      todo = fromIntegral $ length $ filter F.todo tasks :: Double+      doing =+        fromMaybe "" $+        (\x -> Just $ "\n" ++ x) =<<+        (listToMaybe $ T.showTasks $ filter F.doing tasks)       percent = done / (done + todo) * 100       stats =         [ (ternary palette)@@ -182,17 +151,17 @@         , reset         ]       statsLength = sum [length (x : xs) | x:xs <- stats, x /= '\ESC']-  putStrLn $ mconcat [mconcat stats, "\n", progress percent statsLength]+  putStrLn $ mconcat [mconcat stats, "\n", progress percent statsLength, doing]  getSyncStatus :: FilePath -> IO (String, String) getSyncStatus s = do-  v <- getConfigValue ("callbacks", "status")-  case v of-    (Just c) -> do+  c <- getConfigValue ("callbacks", "status")+  case c of+    (Just c') -> do       d <- configDirectory       (_, _, _, h) <-         createProcess-          (shell c)+          (shell c')           {cwd = Just d, std_out = NoStream, env = Just [("SLATE", s)]}       e <- waitForProcess h       return $@@ -207,4 +176,4 @@   d <- configDirectory   (_, _, _, h) <- createProcess (shell c) {cwd = Just d}   _ <- waitForProcess h-  putStrLn $ makeGreen "Done syncing ☺️"+  putStrLn $ paint success "Done syncing ✔"
src/Style.hs view
@@ -2,34 +2,33 @@   ( preen   ) where -import Ansi (bold, resetEmphasis, resetUnderline, underline)+import Ansi (bold, resetBold, resetUnderline, underline)  data Style   = Normal   | Emphasized Char   | Code-  deriving (Show)  data Text = Text   { style :: Style   , parsed :: String   , rest :: String-  } deriving (Show)+  }  getStyle :: Style -> Char -> (Style, String) getStyle Normal '*' = (Emphasized '*', bold) getStyle Normal '_' = (Emphasized '_', bold) getStyle Normal '`' = (Code, underline)-getStyle (Emphasized '*') '*' = (Normal, resetEmphasis)-getStyle (Emphasized '_') '_' = (Normal, resetEmphasis)+getStyle (Emphasized '*') '*' = (Normal, resetBold)+getStyle (Emphasized '_') '_' = (Normal, resetBold) getStyle Code '`' = (Normal, resetUnderline) getStyle s c = (s, [c])  preen :: String -> String-preen s = parsed $ parseNote $ Text Normal [] s+preen s = parsed $ parseTask $ Text Normal [] s -parseNote :: Text -> Text-parseNote (Text s p (c:t)) = do+parseTask :: Text -> Text+parseTask (Text s p (c:t)) = do   let (s1, c1) = getStyle s c-  parseNote $ Text s1 (p ++ c1) t-parseNote (Text s p ([])) = Text s p []+  parseTask $ Text s1 (p ++ c1) t+parseTask (Text s p ([])) = Text s p []
+ src/Task.hs view
@@ -0,0 +1,93 @@+module Task+  ( Task(..)+  , Status(..)+  , dumpTasks+  , showTasks+  , loadTasks+  ) where++import Ansi+  ( Palette(ternary)+  , makeCrossed+  , makeFaint+  , makeInverse+  , makeItalic+  , paint+  , reset+  )+import Style (preen)++data Status+  = Todo+  | Doing+  | Done++data Task = Task+  { line :: Int+  , status :: Status+  , text :: String+  , comment :: Maybe String+  }++-- Dump+dumpTasks :: [Task] -> String+dumpTasks tasks = unlines $ map dumpTask tasks++dumpTask :: Task -> String+dumpTask (Task _ status' text' comment') =+  (mconcat [" - ", dumpStatus status', text', dumpComment comment'])++dumpStatus :: Status -> String+dumpStatus Todo = "[ ] "+dumpStatus Doing = "[ ] … "+dumpStatus Done = "[x] "++dumpComment :: Maybe String -> String+dumpComment (Just comment') = " — " ++ comment'+dumpComment Nothing = ""++-- Load+loadTasks :: Int -> [Task] -> [String] -> [Task]+loadTasks l tasks (x:xs) = loadTasks (l + 1) ((buildTask x l) : tasks) xs+loadTasks _ tasks [] = reverse tasks++buildTask :: String -> Int -> Task+buildTask (' ':'-':' ':'[':' ':']':' ':'…':' ':r) line' =+  buildTask' (Task line' Doing) r+buildTask (' ':'-':' ':'[':' ':']':' ':r) line' = buildTask' (Task line' Todo) r+buildTask (' ':'-':' ':'[':'x':']':' ':r) line' = buildTask' (Task line' Done) r+buildTask text' _ = error $ "Error: \"" ++ text' ++ "\" is not a valid task."++buildTask' :: (String -> Maybe String -> Task) -> String -> Task+buildTask' partialTask text' =+  uncurry partialTask $ splitComment text' ("", Nothing)++splitComment :: String -> (String, Maybe String) -> (String, Maybe String)+splitComment [] (t, c) = (reverse t, c)+splitComment (' ':'—':' ':xs) (t, Nothing) = (reverse t, Just xs)+splitComment (x:xs) (t, _) = splitComment xs (x : t, Nothing)++-- Show+showTasks :: [Task] -> [String]+showTasks tasks = map (showTask $ length tasks) tasks++showTask :: Int -> Task -> String+showTask total (Task line' Todo text' comment') =+  (showLine total line' id) ++ " " ++ (showText text' comment' id) ++ reset+showTask total (Task line' Doing text' comment') =+  (showLine total line' makeInverse) +++  " " ++ (showText text' comment' id) ++ reset+showTask total (Task line' Done text' comment') =+  (showLine total line' makeCrossed) +++  " " ++ (showText text' comment' makeFaint) ++ reset++showLine :: Int -> Int -> (String -> String) -> String+showLine total line' style =+  (alignRight total line') ++ (style $ paint ternary $ show line')+  where+    alignRight x n = replicate (length (show $ x - 1) - length (show n)) ' '++showText :: String -> Maybe String -> (String -> String) -> String+showText text' (Just comment') style =+  style $ preen text' ++ (makeItalic $ " — " ++ comment')+showText text' Nothing style = style $ preen text'