slate 0.11.0.0 → 0.12.0.0

raw patch · 9 files changed

+356/−272 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +1/−1
• slate.cabal +7/−3
• src/Ansi.hs +67/−0
• src/AnsiStyle.hs +0/−33
• src/Command.hs +113/−0
• src/Config.hs +71/−0
• src/Filter.hs +18/−0
• src/Lib.hs +44/−235
• src/Style.hs +35/−0

@@ -18,7 +18,7 @@  ## Install -You can either download a release from [here](https://github.com/evuez/slate/releases) or install it using [stack](https://docs.haskellstack.org/) (requires stack >= 1.6).+You can install it using [stack](https://docs.haskellstack.org/) (requires stack >= 1.6).  ```shell $ stack install slate

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: d019482639897778ad0de66e9777ed7e55617c47cb7c5e4fa748a230bc2ad249+-- hash: 1391bb62af66f9a2e775ecb379056cf77456c27fc59b7f928cb629cb9acb7806  name:           slate-version:        0.11.0.0+version:        0.12.0.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@@ -38,8 +38,12 @@     , string-conversions >=0.2     , unordered-containers >=0.2   exposed-modules:-      AnsiStyle+      Ansi+      Command+      Config+      Filter       Lib+      Style   other-modules:       Paths_slate   default-language: Haskell2010

@@ -0,0 +1,67 @@+module Ansi where++progress :: Double -> Int -> String+progress percent size =+  makeInverse+    ((replicate sizeCompleted ' ') ++ makeGrey (replicate sizeRemaining ' '))+  where+    size' = fromIntegral size :: Double+    sizeCompleted = round $ size' * percent / 100+    sizeRemaining = size - sizeCompleted++reset :: String+reset = "\x1B[0m"++bold :: String+bold = "\x1B[1m"++underline :: String+underline = "\x1B[4m"++inverse :: String+inverse = "\x1B[7m"++crossed :: String+crossed = "\x1B[9m"++resetEmphasis :: String+resetEmphasis = "\x1B[22m"++resetUnderline :: String+resetUnderline = "\x1B[24m"++red :: String+red = "\x1B[31m"++green :: String+green = "\x1B[32m"++grey :: String+grey = "\x1B[2;37m"++makeBold :: String -> String+makeBold s = bold ++ s ++ reset++makeUnderline :: String -> String+makeUnderline s = underline ++ s ++ reset++makeInverse :: String -> String+makeInverse s = inverse ++ s ++ reset++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

@@ -1,33 +0,0 @@-module AnsiStyle-  ( toAnsi-  ) where--data Style-  = Normal-  | Emphasized-  | Code-  deriving (Show)--data Text = Text-  { style :: Style-  , parsed :: String-  , rest :: String-  } deriving (Show)--getStyle :: Style -> Char -> (Style, String)-getStyle Normal '*' = (Emphasized, "\x1B[1m")-getStyle Normal '_' = (Emphasized, "\x1B[1m")-getStyle Normal '`' = (Code, "\x1B[4m")-getStyle Emphasized '*' = (Normal, "\x1B[21m")-getStyle Emphasized '_' = (Normal, "\x1B[21m")-getStyle Code '`' = (Normal, "\x1B[24m")-getStyle s c = (s, [c])--toAnsi :: String -> String-toAnsi s = parsed $ parseNote $ Text Normal [] s--parseNote :: Text -> Text-parseNote (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 []

@@ -0,0 +1,113 @@+module Command+  ( parser+  , Command(..)+  ) where++import Data.Semigroup ((<>))+import Options.Applicative++type Slate = String++type Note = String++type NoteId = Int++type Filter = String++data Command+  = Add Slate+        Note+  | Done Slate+         (Maybe NoteId)+  | Todo Slate+         (Maybe NoteId)+  | Doing Slate+          (Maybe NoteId)+  | Remove Slate+           NoteId+  | Display Slate+            Filter+  | Rename Slate+           Slate+  | Wipe Slate+         Filter+  | Status Slate+  | Sync+  deriving (Eq, Show)++name :: Parser String+name =+  option+    str+    (long "name" <> short 'n' <> metavar "SLATE" <> help "Name of the slate." <>+     value "")++add :: Parser Command+add = Add <$> name <*> argument str (metavar "NOTE")++done :: Parser Command+done = Done <$> name <*> optional (argument auto (metavar "NOTE ID"))++todo :: Parser Command+todo = Todo <$> name <*> optional (argument auto (metavar "NOTE ID"))++doing :: Parser Command+doing = Doing <$> name <*> optional (argument auto (metavar "NOTE ID"))++remove :: Parser Command+remove = Remove <$> name <*> argument auto (metavar "NOTE ID")++display :: Parser Command+display =+  Display <$> name <*>+  option+    str+    (long "only" <> short 'o' <> help "Display only done / todo notes." <>+     value "")++rename :: Parser Command+rename =+  Rename <$> argument str (metavar "CURRENT" <> help "Current name.") <*>+  argument str (metavar "NEW" <> help "New name.")++wipe :: Parser Command+wipe =+  Wipe <$> name <*>+  option+    str+    (long "only" <> short 'o' <> help "Wipe only done / todo notes." <> value "")++status :: Parser Command+status = Status <$> name++sync :: Command+sync = Sync++parser :: Parser Command+parser =+  subparser+    (command "add" (info add (progDesc "Add a note.")) <>+     command+       "done"+       (info+          done+          (progDesc+             "Mark a note as done when given a note ID, display done notes otherwise.")) <>+     command+       "todo"+       (info+          todo+          (progDesc+             "Mark a note as todo when given a note ID, display todo notes 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.")) <>+     command "display" (info display (progDesc "Display a slate.")) <>+     command "rename" (info rename (progDesc "Rename a slate.")) <>+     command "wipe" (info wipe (progDesc "Wipe a slate.")) <>+     command "status" (info status (progDesc "Display the status of a slate.")) <>+     command "sync" (info (pure sync) (progDesc "Sync every slate.")))

@@ -0,0 +1,71 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}++module Config+  ( getConfigValue+  , configDirectory+  , getSlatePath+  ) where++import qualified Data.HashMap.Lazy as M (lookup)+import Data.Maybe (listToMaybe)+import Data.String (fromString)+import Data.String.Conversions (convertString)+import System.Directory (doesFileExist, getCurrentDirectory, getHomeDirectory)+import System.FilePath.Posix (takeBaseName)+import Text.Toml (parseTomlDoc)+import Text.Toml.Types (Node(VString), Node(VTable))++class GetConfig a where+  getConfigValue :: (String, String) -> IO a++instance GetConfig (Maybe String) where+  getConfigValue (s, k) = do+    f <- configFile+    config <- readFile f+    let Right c = parseTomlDoc "" (fromString config)+    return $+      case (M.lookup (fromString s) c) of+        Just (VTable t) ->+          case (M.lookup (fromString k) t) of+            Just (VString v) -> Just (convertString v)+            _ -> Nothing+        _ -> Nothing++instance GetConfig String where+  getConfigValue (s, k) = do+    f <- configFile+    c <- getConfigValue (s, k)+    return $ maybe (error $ "Key `" ++ k ++ "` not found in " ++ f ++ ".") id c++configDirectory :: IO String+configDirectory = do+  home <- getHomeDirectory+  return $ home ++ "/.config/slate/"++configFile :: IO String+configFile = do+  dir <- configDirectory+  return $ dir ++ "config.toml"++slateName :: IO String+slateName = do+  d <- getCurrentDirectory+  let headOrFail =+        \x ->+          maybe+            (error "The .slate file in this directory shouldn't be 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+  s <- slateName+  dir <- configDirectory+  return $ dir ++ s ++ ".md"+getSlatePath s = do+  dir <- configDirectory+  return $ dir ++ s ++ ".md"

@@ -0,0 +1,18 @@+module Filter+  ( done+  , todo+  , doing+  ) where++done :: String -> Bool+done (' ':'-':' ':'[':'x':']':_) = True+done ('\x1B':'[':'9':'m':_) = True+done _ = False++todo :: String -> Bool+todo n = (not . done) n++doing :: String -> Bool+doing (' ':'-':' ':'[':' ':']':' ':'>':_) = True+doing ('\x1B':'[':'7':'m':_) = True+doing _ = False

@@ -1,29 +1,16 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE LambdaCase #-}- module Lib   ( initialize   , execute   , parser   ) where -import AnsiStyle (toAnsi)-import qualified Data.HashMap.Lazy as M (lookup)-import Data.Maybe (listToMaybe)-import Data.Semigroup ((<>))-import Data.String (fromString)-import Data.String.Conversions (convertString)-import Options.Applicative-import System.Directory-  ( createDirectoryIfMissing-  , doesFileExist-  , getCurrentDirectory-  , getHomeDirectory-  , removeFile-  , renameFile-  )+import Ansi (makeCrossed, makeGreen, makeInverse, makeRed, progress)+import Command (Command(..), parser)+import Config (configDirectory, getConfigValue, getSlatePath)+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.FilePath.Posix (takeBaseName) import System.Process   ( StdStream(NoStream)   , createProcess@@ -33,117 +20,7 @@   , std_out   , waitForProcess   )-import Text.Toml (parseTomlDoc)-import Text.Toml.Types (Node(VString), Node(VTable)) -type Slate = String--type Note = String--type NoteId = Int--type Filter = String--data Command-  = Add Slate-        Note-  | Done Slate-         (Maybe NoteId)-  | Todo Slate-         (Maybe NoteId)-  | Doing Slate-          (Maybe NoteId)-  | Remove Slate-           NoteId-  | Display Slate-            Filter-  | Rename Slate-           Slate-  | Wipe Slate-         Filter-  | Status Slate-  | Sync-  deriving (Eq, Show)---- Parsers-name :: Parser String-name =-  option-    str-    (long "name" <> short 'n' <> metavar "SLATE" <> help "Name of the slate." <>-     value "")--add :: Parser Command-add = Add <$> name <*> argument str (metavar "NOTE")--done :: Parser Command-done = Done <$> name <*> optional (argument auto (metavar "NOTE ID"))--todo :: Parser Command-todo = Todo <$> name <*> optional (argument auto (metavar "NOTE ID"))--doing :: Parser Command-doing = Doing <$> name <*> optional (argument auto (metavar "NOTE ID"))--remove :: Parser Command-remove = Remove <$> name <*> argument auto (metavar "NOTE ID")--display :: Parser Command-display =-  Display <$> name <*>-  option-    str-    (long "only" <> short 'o' <> help "Display only done / todo notes." <>-     value "")--rename :: Parser Command-rename =-  Rename <$> argument str (metavar "CURRENT" <> help "Current name.") <*>-  argument str (metavar "NEW" <> help "New name.")--wipe :: Parser Command-wipe =-  Wipe <$> name <*>-  option-    str-    (long "only" <> short 'o' <> help "Wipe only done / todo notes." <> value "")--status :: Parser Command-status = Status <$> name--sync :: Command-sync = Sync--parser :: Parser Command-parser =-  subparser-    (command "add" (info add (progDesc "Add a note.")) <>-     command-       "done"-       (info-          done-          (progDesc-             "Mark a note as done when given a note ID, display done notes otherwise.")) <>-     command-       "todo"-       (info-          todo-          (progDesc-             "Mark a note as todo when given a note ID, display todo notes 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.")) <>-     command "display" (info display (progDesc "Display a slate.")) <>-     command "rename" (info rename (progDesc "Rename a slate.")) <>-     command "wipe" (info wipe (progDesc "Wipe a slate.")) <>-     command "status" (info status (progDesc "Display the status of a slate.")) <>-     command "sync" (info (pure sync) (progDesc "Sync every slate.")))---- Commands execute :: Command -> IO () execute (Add s n) =   getSlatePath s >>= (\x -> appendFile x (" - [ ] " ++ n ++ "\n"))@@ -161,106 +38,39 @@ execute (Status s) = getSlatePath s >>= (\x -> displayStatus x) execute (Sync) = syncSlates --- Helpers initialize :: IO ()-initialize = getConfigDirectory >>= (\c -> createDirectoryIfMissing True c)--getSlateName :: IO String-getSlateName = do-  d <- getCurrentDirectory-  let headOrFail =-        \x ->-          maybe-            (error "The .slate file in this directory shouldn't be empty.")-            id-            (listToMaybe x)-  doesFileExist (d ++ "/.slate") >>= \case-    True -> readFile (d ++ "/.slate") >>= (return . headOrFail . lines)-    False -> return $ takeBaseName d--getConfigDirectory :: IO String-getConfigDirectory = do-  home <- getHomeDirectory-  return $ home ++ "/.config/slate/"--getConfigFile :: IO String-getConfigFile = do-  dir <- getConfigDirectory-  return $ dir ++ "config.toml"--getSlatePath :: String -> IO FilePath-getSlatePath "" = do-  s <- getSlateName-  dir <- getConfigDirectory-  return $ dir ++ s ++ ".md"-getSlatePath s = do-  dir <- getConfigDirectory-  return $ dir ++ s ++ ".md"--class GetConfig a where-  getConfigValue :: (String, String) -> IO a--instance GetConfig (Maybe String) where-  getConfigValue (s, k) = do-    f <- getConfigFile-    config <- readFile f-    let Right c = parseTomlDoc "" (fromString config)-    return $-      case (M.lookup (fromString s) c) of-        Just (VTable t) ->-          case (M.lookup (fromString k) t) of-            Just (VString v) -> Just (convertString v)-            _ -> Nothing-        _ -> Nothing--instance GetConfig String where-  getConfigValue (s, k) = do-    f <- getConfigFile-    c <- getConfigValue (s, k)-    return $ maybe (error $ "Key `" ++ k ++ "` not found in " ++ f ++ ".") id c+initialize = configDirectory >>= (\c -> createDirectoryIfMissing True c)  displaySlate :: String -> String -> IO () displaySlate s "" = do   contents <- readFile s-  let notes = zipWith displayNote [0 ..] (lines contents)-  putStr $ unlines notes+  putStr $ unlines $ displayNotes (lines contents) displaySlate s "done" = do   contents <- readFile s-  let notes = zipWith displayNote [0 ..] (lines contents)-  putStr $ unlines $ filter isNoteDone notes+  putStr $ unlines $ filter F.done $ displayNotes (lines contents) displaySlate s "todo" = do   contents <- readFile s-  let notes = zipWith displayNote [0 ..] (lines contents)-  putStr $ unlines $ filter (not . isNoteDone) notes+  putStr $ unlines $ filter F.todo $ displayNotes (lines contents) displaySlate s "doing" = do   contents <- readFile s-  let notes = zipWith displayNote [0 ..] (lines contents)-  putStr $ unlines $ filter isNoteDoing notes+  putStr $ unlines $ filter F.doing $ displayNotes (lines contents) displaySlate _ f = putStrLn $ "\"" ++ f ++ "\" is not a valid filter." -displayNote :: Int -> String -> String-displayNote line (' ':'-':' ':'[':_:']':' ':'>':note) =-  "\x1B[7m" ++ padInt line 2 ++ " -" ++ (toAnsi note) ++ "\x1B[0m"-displayNote line (' ':'-':' ':'[':' ':']':note) =-  padInt line 2 ++ " -" ++ (toAnsi note)-displayNote line (' ':'-':' ':'[':'x':']':note) =-  "\x1B[9m" ++ padInt line 2 ++ " -" ++ (toAnsi note) ++ "\x1B[0m"-displayNote line _ =-  "\x1B[31m" ++-  padInt line 2 ++ " - Parsing error: line is malformed" ++ "\x1B[0m"--isNoteDone :: String -> Bool-isNoteDone (' ':'-':' ':'[':'x':']':_) = True-isNoteDone ('\x1B':'[':'9':'m':_) = True-isNoteDone _ = False+displayNotes :: [String] -> [String]+displayNotes notes = zipWith (displayNote $ length notes) [0 ..] notes -isNoteDoing :: String -> Bool-isNoteDoing (' ':'-':' ':'[':' ':']':' ':'>':_) = True-isNoteDoing ('\x1B':'[':'7':'m':_) = True-isNoteDoing _ = False+displayNote :: Int -> Int -> String -> String+displayNote total line (' ':'-':' ':'[':_:']':' ':'>':note) =+  makeInverse $ alignRight total line ++ " -" ++ preen note+displayNote total line (' ':'-':' ':'[':' ':']':note) =+  alignRight total line ++ " -" ++ preen note+displayNote total line (' ':'-':' ':'[':'x':']':note) =+  makeCrossed $ alignRight total line ++ " -" ++ preen note+displayNote total line _ =+  makeRed $ alignRight total line ++ " - Parsing error: line is malformed" -padInt :: Int -> Int -> String-padInt n s = replicate (s - length (show n)) '0' ++ show n+alignRight :: Int -> Int -> String+alignRight x n = replicate (length (show x) - length (show n)) ' ' ++ show n  markAsDone :: FilePath -> Int -> IO () markAsDone s n = do@@ -325,12 +135,12 @@ wipeSlate s "done" = do   contents <- readFile s   let tmp = s ++ ".tmp"-  writeFile tmp $ unlines $ filter (not . isNoteDone) (lines contents)+  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 isNoteDone (lines contents)+  writeFile tmp $ unlines $ filter F.done (lines contents)   renameFile tmp s wipeSlate _ f = putStrLn $ "\"" ++ f ++ "\" is not a valid filter." @@ -338,27 +148,26 @@ displayStatus s = do   ss <- getSyncStatus s   contents <- readFile s-  let d = length $ filter isNoteDone (lines contents)-      t = length $ filter (not . isNoteDone) (lines contents)-      dd = fromIntegral d :: Double-      dt = fromIntegral t :: Double-      pd = round $ 28 * dd / (dt + dd)-      pt = round $ 28 * dt / (dt + dd)-      p = round $ dd / (dd + dt) * 100 :: Integer-  putStrLn $-    (show d) ++-    " done, " ++-    (show t) ++-    " todo (" ++-    (show p) ++-    "% done).\n" ++ (replicate pd '▮') ++ (replicate pt '▯') ++ "\n" ++ ss+  let done = fromIntegral $ length $ filter F.done (lines contents) :: Double+      todo = fromIntegral $ length $ filter F.todo (lines contents) :: Double+      percent = done / (done + todo) * 100+      stats =+        mconcat+          [ show (round done :: Integer)+          , " done, "+          , show (round todo :: Integer)+          , " todo ("+          , show (round percent :: Integer)+          , "% done)."+          ]+  putStrLn $ mconcat [stats, "\n", progress percent (length stats), "\n", ss]  getSyncStatus :: FilePath -> IO String getSyncStatus s = do   v <- getConfigValue ("callbacks", "status")   case v of     (Just c) -> do-      d <- getConfigDirectory+      d <- configDirectory       (_, _, _, h) <-         createProcess           (shell c)@@ -366,14 +175,14 @@       e <- waitForProcess h       return $         case e of-          ExitSuccess -> "\x1B[32mSynced ☺️\x1B[0m"-          (ExitFailure _) -> "\x1B[31mOut of sync 😕\x1B[0m"+          ExitSuccess -> makeGreen "Synced ☺️"+          (ExitFailure _) -> makeRed "Out of sync 😕"     Nothing -> return ""  syncSlates :: IO () syncSlates = do   c <- getConfigValue ("callbacks", "sync")-  d <- getConfigDirectory+  d <- configDirectory   (_, _, _, h) <- createProcess (shell c) {cwd = Just d}   _ <- waitForProcess h-  putStrLn "\x1B[32mDone syncing ☺️\x1B[0m"+  putStrLn $ makeGreen "Done syncing ☺️"

@@ -0,0 +1,35 @@+module Style+  ( preen+  ) where++import Ansi (bold, resetEmphasis, 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 Code '`' = (Normal, resetUnderline)+getStyle s c = (s, [c])++preen :: String -> String+preen s = parsed $ parseNote $ Text Normal [] s++parseNote :: Text -> Text+parseNote (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 []