From f7edba1c0a1b5a75beb7713b6a896064d2e1f083 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Damien=20Courouss=C3=A9?= Date: Wed, 24 Oct 2018 22:48:25 +0200 Subject: [PATCH 01/11] add flags: hardcoded TODO, FIXME, XXX --- app/Main.hs | 31 +++++++++++++++++++++++++------ 1 file changed, 25 insertions(+), 6 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 7016c80..39eb06c 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -52,12 +52,16 @@ data TodoEntry , sourceFile :: FilePath , lineNumber :: LineNumber , priority :: Maybe Integer + , flag :: Flag , customAttributes :: [(T.Text, T.Text)] , tags :: [T.Text] , leadingText :: T.Text } | TodoBodyLine T.Text deriving (Show, Generic) +data Flag = TODO | FIXME | XXX + deriving (Show, Generic) + data TodoListResult = TodoListResult { todos :: [TodoEntry] , message :: T.Text @@ -83,6 +87,10 @@ instance FromJSON TodoEntry instance ToJSON TodoEntry +instance FromJSON Flag + +instance ToJSON Flag + instance FromJSON TodoListResult instance ToJSON TodoListResult @@ -222,7 +230,7 @@ renderTodo t = let comment = fromJust $ lookup ("." <> getExtension (sourceFile t)) fileTypeToComment detail = - "TODO (" <> + renderFlag (flag t) <> " (" <> (T.pack $ Data.String.Utils.join "|" @@ -232,8 +240,13 @@ renderTodo t = map (\a -> fst a <> "=" <> snd a) (customAttributes t))) <> ") " fullNoComments = mapHead (\l -> detail <> "- " <> l) $ body t - commented = map (\l -> comment <> " " <> l) fullNoComments in - mapHead (\l -> leadingText t <> l) $ + commented = map (\l -> comment <> " " <> l) fullNoComments + + renderFlag :: Flag -> T.Text + renderFlag TODO = "TODO" + renderFlag FIXME = "FIXME" + renderFlag XXX = "XXX" + in mapHead (\l -> leadingText t <> l) $ mapInit (\l -> foldl (<>) "" [" " | _ <- [1..(T.length $ leadingText t)]] <> l) commented mapHead :: (a -> a) -> [a] -> [a] @@ -266,8 +279,8 @@ isBodyLine (TodoBodyLine _) = True isBodyLine _ = False combineTodo :: TodoEntry -> TodoEntry -> TodoEntry -combineTodo (TodoEntryHead i b a p n entryPriority attrs entryTags entryLeadingText) (TodoBodyLine l) = - TodoEntryHead i (b ++ [l]) a p n entryPriority attrs entryTags entryLeadingText +combineTodo (TodoEntryHead i b a p n entryPriority f attrs entryTags entryLeadingText) (TodoBodyLine l) = + TodoEntryHead i (b ++ [l]) a p n entryPriority f attrs entryTags entryLeadingText combineTodo _ _ = error "Can't combine todoEntry of these types" data SourceFile = SourceFile @@ -350,6 +363,11 @@ lexeme = L.lexeme space symbol :: T.Text -> Parser T.Text symbol = L.symbol space +parseFlag :: Parser Flag +parseFlag = try (symbol "TODO" *> pure TODO ) + <|> try (symbol "FIXME" *> pure FIXME) + <|> (symbol "XXX" *> pure XXX ) + parseComment :: T.Text -> Parser TodoEntry parseComment extension = do @@ -421,7 +439,7 @@ prefixParserForFileType extension = parseTodoEntryHead :: FilePath -> LineNumber -> Parser TodoEntry parseTodoEntryHead path lineNum = do entryLeadingText <- manyTill anyChar (prefixParserForFileType $ getExtension path) - _ <- symbol "TODO" + flag <- parseFlag entryDetails <- optional $ try (inParens $ many (noneOf [')', '('])) let parsedDetails = parseDetails . T.pack <$> entryDetails entryPriority = (readMaybe . T.unpack) =<< (snd4 =<< parsedDetails) @@ -438,6 +456,7 @@ parseTodoEntryHead path lineNum = do path lineNum entryPriority + flag otherDetails entryTags (T.pack entryLeadingText) From ac44021cfdcbb7f4ed49c7f034ba48313b67a95d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Damien=20Courouss=C3=A9?= Date: Wed, 24 Oct 2018 22:50:00 +0200 Subject: [PATCH 02/11] prettyFormat flags when printing results on the command line --- app/Main.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 39eb06c..12c34e6 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -522,13 +522,14 @@ foldTodoHelper (todoEntries :: [TodoEntry], currentlyBuildingTodoLines :: Bool) | otherwise = (todoEntries, False) prettyFormat :: TodoEntry -> String -prettyFormat (TodoEntryHead _ l a p n entryPriority _ _ _) = +prettyFormat (TodoEntryHead _ l a p n entryPriority f _ _ _) = printf - "Assignee: %s\n%s%s:%d\n%s" + "Assignee: %s\n%s%s:%d\n%s - %s" (fromMaybe "None" a) (maybe "" (\x -> "Priority: " ++ show x ++ "\n") entryPriority) p n + (show f) (unlines $ map T.unpack l) prettyFormat (TodoBodyLine _) = error "Invalid type for prettyFormat" From b72458beffae86f0aeea591f8ca78507db130134 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Damien=20Courouss=C3=A9?= Date: Wed, 24 Oct 2018 23:46:11 +0200 Subject: [PATCH 03/11] UI: show flags --- web/html/index.html | 2 ++ web/js/app.js | 1 + 2 files changed, 3 insertions(+) diff --git a/web/html/index.html b/web/html/index.html index e03bbe3..cffd7e6 100644 --- a/web/html/index.html +++ b/web/html/index.html @@ -124,6 +124,7 @@ + Flag Body Assignee Tags @@ -134,6 +135,7 @@
{{ todo.priority }}
+ {{ todo.flag }}
{{ todo.sourceFile }}:{{ todo.lineNumber}}
{{ todo.body }}
diff --git a/web/js/app.js b/web/js/app.js index 382536b..86ea588 100644 --- a/web/js/app.js +++ b/web/js/app.js @@ -38,6 +38,7 @@ $(document).ready(function() { lineNumber: t.lineNumber, sourceFile: t.sourceFile, priority: t.priority, + flag: t.flag, tags: t.tags, customAttributes: t.customAttributes.reduce((acc, curr) => { console.log(acc, curr) From 2e05c27e7a71c627775c01a4b8bb35998c9be04b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Damien=20Courouss=C3=A9?= Date: Thu, 25 Oct 2018 15:35:12 +0200 Subject: [PATCH 04/11] add support for flags specified with the command line --- app/Main.hs | 78 +++++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 58 insertions(+), 20 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 12c34e6..f6b8a9f 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -13,12 +13,14 @@ import qualified Control.Exception as E import Control.Monad import Control.Monad.IO.Class import Data.Aeson +import Data.Aeson.Types (typeMismatch) import Data.Either import Data.IORef import Data.List import Data.Maybe import Data.Monoid import Data.Proxy +import Data.String (IsString) import Data.String.Utils import qualified Data.Text as T import Data.Version (showVersion) @@ -59,9 +61,13 @@ data TodoEntry | TodoBodyLine T.Text deriving (Show, Generic) -data Flag = TODO | FIXME | XXX +data Flag = TODO | FIXME | XXX | UF UserFlag deriving (Show, Generic) +newtype UserFlag = UserFlag T.Text + deriving ( Show, Data, Eq + , Generic, IsString) + data TodoListResult = TodoListResult { todos :: [TodoEntry] , message :: T.Text @@ -87,10 +93,6 @@ instance FromJSON TodoEntry instance ToJSON TodoEntry -instance FromJSON Flag - -instance ToJSON Flag - instance FromJSON TodoListResult instance ToJSON TodoListResult @@ -105,6 +107,28 @@ instance ToJSON EditTodoRequest instance FromJSON ToodlesConfig +instance ToJSON Flag where + toJSON TODO = Data.Aeson.String "TODO" + toJSON FIXME = Data.Aeson.String "FIXME" + toJSON XXX = Data.Aeson.String "XXX" + toJSON (UF (UserFlag x)) = Data.Aeson.String x + +instance FromJSON Flag where + parseJSON (Data.Aeson.String x) = + case x of + "TODO" -> pure TODO + "FIXME" -> pure FIXME + "XXX" -> pure XXX + _ -> pure $ UF $ UserFlag x + parseJSON invalid = typeMismatch "UserFlag" invalid + +instance ToJSON UserFlag where + toJSON (UserFlag x) = Data.Aeson.String x + +instance FromJSON UserFlag where + parseJSON (Data.Aeson.String x) = pure $ UserFlag x + parseJSON invalid = typeMismatch "UserFlag" invalid + type ToodlesAPI = "todos" :> QueryFlag "recompute" :> Get '[ JSON] TodoListResult :<|> "todos" :> "delete" :> ReqBody '[ JSON] DeleteTodoRequest :> Post '[ JSON] T.Text :<|> @@ -302,6 +326,7 @@ data ToodlesArgs = ToodlesArgs , limit_results :: Int , port :: Maybe Int , no_server :: Bool + , userFlag :: [UserFlag] } deriving (Show, Data, Typeable, Eq) argParser :: ToodlesArgs @@ -312,6 +337,7 @@ argParser = , limit_results = def &= help "Limit number of search results" , port = def &= help "Run server on port" , no_server = def &= help "Output matching todos to the command line and exit" + , userFlag = def &= help "Additional flagword (e.g.: MAYBE)" } &= summary ("toodles " ++ showVersion version) &= program "toodles" &= @@ -363,10 +389,20 @@ lexeme = L.lexeme space symbol :: T.Text -> Parser T.Text symbol = L.symbol space -parseFlag :: Parser Flag -parseFlag = try (symbol "TODO" *> pure TODO ) - <|> try (symbol "FIXME" *> pure FIXME) - <|> (symbol "XXX" *> pure XXX ) +-- | parse "hard-coded" flags, and user-defined flags if any +parseFlag :: [UserFlag] -> Parser Flag +parseFlag us = foldr (\a b -> b <|> foo a) (try parseFlagHardcoded) us + where + foo :: UserFlag -> Parser Flag + foo (UserFlag x) = try (symbol x *> pure (UF $ UserFlag x)) + +-- | parse flags TODO, FIXME, XXX +parseFlagHardcoded :: Parser Flag +parseFlagHardcoded = + try (symbol "TODO" *> pure TODO ) + <|> try (symbol "FIXME" *> pure FIXME) + <|> (symbol "XXX" *> pure XXX ) + parseComment :: T.Text -> Parser TodoEntry parseComment extension @@ -436,10 +472,10 @@ prefixParserForFileType extension = then orgMode else comment -parseTodoEntryHead :: FilePath -> LineNumber -> Parser TodoEntry -parseTodoEntryHead path lineNum = do +parseTodoEntryHead :: [UserFlag] -> FilePath -> LineNumber -> Parser TodoEntry +parseTodoEntryHead us path lineNum = do entryLeadingText <- manyTill anyChar (prefixParserForFileType $ getExtension path) - flag <- parseFlag + flag <- parseFlag us entryDetails <- optional $ try (inParens $ many (noneOf [')', '('])) let parsedDetails = parseDetails . T.pack <$> entryDetails entryPriority = (readMaybe . T.unpack) =<< (snd4 =<< parsedDetails) @@ -461,9 +497,9 @@ parseTodoEntryHead path lineNum = do entryTags (T.pack entryLeadingText) -parseTodo :: FilePath -> LineNumber -> Parser TodoEntry -parseTodo path lineNum = - try (parseTodoEntryHead path lineNum) <|> parseComment (getExtension path) +parseTodo :: [UserFlag] -> FilePath -> LineNumber -> Parser TodoEntry +parseTodo us path lineNum = + try (parseTodoEntryHead us path lineNum) <|> parseComment (getExtension path) getAllFiles :: ToodlesConfig -> FilePath -> IO [SourceFile] getAllFiles config path = @@ -500,11 +536,11 @@ isValidFile :: ToodlesConfig -> FilePath -> Bool isValidFile config f = fileHasValidExtension f && not (ignoreFile config f) -runTodoParser :: SourceFile -> [TodoEntry] -runTodoParser (SourceFile path ls) = +runTodoParser :: [UserFlag] -> SourceFile -> [TodoEntry] +runTodoParser us (SourceFile path ls) = let parsedTodoLines = map - (\(lineNum, lineText) -> parseMaybe (parseTodo path lineNum) lineText) + (\(lineNum, lineText) -> parseMaybe (parseTodo us path lineNum) lineText) (zip [1 ..] ls) groupedTodos = foldl foldTodoHelper ([], False) parsedTodoLines in fst groupedTodos @@ -555,7 +591,7 @@ runFullSearch userArgs = when (isLeft config) $ putStrLn $ "[WARNING] Invalid .toodles.yaml: " ++ show config allFiles <- getAllFiles (fromRight (ToodlesConfig []) config) projectRoot - let parsedTodos = concatMap runTodoParser allFiles + let parsedTodos = concatMap (runTodoParser $ userFlag userArgs) allFiles filteredTodos = filter (filterSearch (assignee_search userArgs)) parsedTodos resultList = limitSearch filteredTodos $ limit_results userArgs @@ -606,10 +642,12 @@ main = do userArgs <- cmdArgs argParser >>= setAbsolutePath sResults <- runFullSearch userArgs case userArgs of - (ToodlesArgs _ _ _ _ True) -> mapM_ (putStrLn . prettyFormat) $ todos sResults + (ToodlesArgs _ _ _ _ True _) -> mapM_ (putStrLn . prettyFormat) $ todos sResults _ -> do let webPort = fromMaybe 9001 $ port userArgs ref <- newIORef sResults dataDir <- (++ "/web") <$> getDataDir putStrLn $ "serving on " ++ show webPort run webPort $ app $ ToodlesState ref dataDir + +-- TODO (damien|p=2) - add support for user flags in the configuration file From fe5b4abc0d8f6396b2a3498e578e7ef883076012 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Damien=20Courouss=C3=A9?= Date: Thu, 25 Oct 2018 15:54:31 +0200 Subject: [PATCH 05/11] flags: add support for flags specified from the configuration file The commits in this branch add support for the features listed in issue #8. The branch needs some documentation, and maybe some code editing or refactoring before integration to master. --- .toodles.yaml | 3 +++ app/Main.hs | 36 ++++++++++++++++++++---------------- 2 files changed, 23 insertions(+), 16 deletions(-) diff --git a/.toodles.yaml b/.toodles.yaml index 8923faa..22162e0 100644 --- a/.toodles.yaml +++ b/.toodles.yaml @@ -4,3 +4,6 @@ ignore: - test.js - stack-work + +flags: +- MAYBE diff --git a/app/Main.hs b/app/Main.hs index f6b8a9f..e33e906 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,10 +1,11 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeOperators #-} -- TODO (avi|p=3|#cleanup|key=val|k3y=asdf|key=1) - break this into modules module Main where @@ -85,9 +86,10 @@ data EditTodoRequest = EditTodoRequest , setPriority :: Maybe Integer } deriving (Show, Generic) -newtype ToodlesConfig = ToodlesConfig { - ignore :: [FilePath] - } deriving (Show, Generic) +data ToodlesConfig = ToodlesConfig + { ignore :: [FilePath] + , flags :: [UserFlag] + } deriving (Show, Generic) instance FromJSON TodoEntry @@ -267,9 +269,10 @@ renderTodo t = commented = map (\l -> comment <> " " <> l) fullNoComments renderFlag :: Flag -> T.Text - renderFlag TODO = "TODO" - renderFlag FIXME = "FIXME" - renderFlag XXX = "XXX" + renderFlag TODO = "TODO" + renderFlag FIXME = "FIXME" + renderFlag XXX = "XXX" + renderFlag (UF (UserFlag x)) = x in mapHead (\l -> leadingText t <> l) $ mapInit (\l -> foldl (<>) "" [" " | _ <- [1..(T.length $ leadingText t)]] <> l) commented @@ -523,7 +526,7 @@ fileHasValidExtension path = any (\ext -> ext `T.isSuffixOf` T.pack path) (map fst fileTypeToComment) ignoreFile :: ToodlesConfig -> FilePath -> Bool -ignoreFile (ToodlesConfig ignoredPaths) file = +ignoreFile (ToodlesConfig ignoredPaths todo) file = let p = T.pack file in T.isInfixOf "node_modules" p || T.isSuffixOf "pb.go" p || T.isSuffixOf "_pb2.py" p || @@ -587,11 +590,12 @@ runFullSearch userArgs = configExists <- doesFileExist $ projectRoot ++ "/.toodles.yaml" config <- if configExists then Y.decodeFileEither (projectRoot ++ "/.toodles.yaml") - else return . Right $ ToodlesConfig [] + else return . Right $ ToodlesConfig [] [] when (isLeft config) $ putStrLn $ "[WARNING] Invalid .toodles.yaml: " ++ show config - allFiles <- getAllFiles (fromRight (ToodlesConfig []) config) projectRoot - let parsedTodos = concatMap (runTodoParser $ userFlag userArgs) allFiles + let config' = fromRight (ToodlesConfig [] []) config + allFiles <- getAllFiles config' projectRoot + let parsedTodos = concatMap (runTodoParser $ userFlag userArgs ++ flags config') allFiles filteredTodos = filter (filterSearch (assignee_search userArgs)) parsedTodos resultList = limitSearch filteredTodos $ limit_results userArgs From 6654aaf4aaafb38fa33fa77dd9d5a943d789dfe3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Damien=20Courouss=C3=A9?= Date: Fri, 26 Oct 2018 22:09:58 +0200 Subject: [PATCH 06/11] flags: better rendering with --no-server --- app/Main.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/app/Main.hs b/app/Main.hs index e33e906..00fe24e 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -63,12 +63,18 @@ data TodoEntry deriving (Show, Generic) data Flag = TODO | FIXME | XXX | UF UserFlag - deriving (Show, Generic) + deriving (Generic) newtype UserFlag = UserFlag T.Text deriving ( Show, Data, Eq , Generic, IsString) +instance Show Flag where + show TODO = "TODO" + show FIXME = "FIXME" + show XXX = "XXX" + show (UF (UserFlag x)) = T.unpack x + data TodoListResult = TodoListResult { todos :: [TodoEntry] , message :: T.Text From 33db6e8bfc2c091b14e622f739762fc6d99380c1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Damien=20Courouss=C3=A9?= Date: Fri, 26 Oct 2018 21:57:19 +0200 Subject: [PATCH 07/11] build with -Wall and -Wcompat The -Wall option turns on most warnings, but not all of them. -Wcompat enables warnings that make your code more robust in the face of future backwards-incompatible changes. https://lexi-lambda.github.io/blog/2018/02/10/an-opinionated-guide-to-haskell-in-2018 https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/using-warnings.html#warnings-and-sanity-checking --- package.yaml | 5 ++++- toodles.cabal | 2 +- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/package.yaml b/package.yaml index fb74fc5..69270e7 100644 --- a/package.yaml +++ b/package.yaml @@ -26,7 +26,10 @@ description: your TODO\'s with an easy to use web application. When you make changes via toodles, the edits will be applied directly the TODO entries in your code. When you\'re done, commit and push your changes to share them with your team! - + +ghc-options: + - -Wall + - -Wcompat dependencies: - base >= 4.0 && < 5 diff --git a/toodles.cabal b/toodles.cabal index b28521f..301c7f8 100644 --- a/toodles.cabal +++ b/toodles.cabal @@ -41,7 +41,7 @@ executable toodles Paths_toodles hs-source-dirs: app - ghc-options: -threaded -rtsopts -with-rtsopts=-N + ghc-options: -Wall -Wcompat -threaded -rtsopts -with-rtsopts=-N build-depends: MissingH ==1.4.0.1 , aeson ==1.3.1.1 From 3f8fec1e68b217e24388a8e7ce1a2d44f94525bd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Damien=20Courouss=C3=A9?= Date: Fri, 26 Oct 2018 22:01:29 +0200 Subject: [PATCH 08/11] fix build warnings --- app/Main.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 00fe24e..737188d 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -19,7 +19,6 @@ import Data.Either import Data.IORef import Data.List import Data.Maybe -import Data.Monoid import Data.Proxy import Data.String (IsString) import Data.String.Utils @@ -198,6 +197,7 @@ removeAndAdjust deleteList = else let deleteItem = head deleteList rest = tail deleteList in do _ <- removeTodoFromCode deleteItem + return $ map (\t -> @@ -471,6 +471,7 @@ thd4 (_, _, x, _) = x fth4 :: (a, b, c, d) -> d fth4 (_, _, _, x) = x +prefixParserForFileType :: T.Text -> Parser T.Text prefixParserForFileType extension = let comment = symbol . getCommentForFileType $ extension orgMode = @@ -484,7 +485,7 @@ prefixParserForFileType extension = parseTodoEntryHead :: [UserFlag] -> FilePath -> LineNumber -> Parser TodoEntry parseTodoEntryHead us path lineNum = do entryLeadingText <- manyTill anyChar (prefixParserForFileType $ getExtension path) - flag <- parseFlag us + f <- parseFlag us entryDetails <- optional $ try (inParens $ many (noneOf [')', '('])) let parsedDetails = parseDetails . T.pack <$> entryDetails entryPriority = (readMaybe . T.unpack) =<< (snd4 =<< parsedDetails) @@ -501,7 +502,7 @@ parseTodoEntryHead us path lineNum = do path lineNum entryPriority - flag + f otherDetails entryTags (T.pack entryLeadingText) @@ -532,7 +533,7 @@ fileHasValidExtension path = any (\ext -> ext `T.isSuffixOf` T.pack path) (map fst fileTypeToComment) ignoreFile :: ToodlesConfig -> FilePath -> Bool -ignoreFile (ToodlesConfig ignoredPaths todo) file = +ignoreFile (ToodlesConfig ignoredPaths _) file = let p = T.pack file in T.isInfixOf "node_modules" p || T.isSuffixOf "pb.go" p || T.isSuffixOf "_pb2.py" p || @@ -635,7 +636,7 @@ addAnchors s = in BZ.preEscapedToHtml $ (unlines $ map - (\(i, l) -> printf "
%s
" (show i) l) + (\(i :: Int, l) -> printf "
%s
" (show i) l) codeLines) setAbsolutePath :: ToodlesArgs -> IO ToodlesArgs From 76044d7bbbffc6d06d5100b2c419fcfd9dc3e359 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Damien=20Courouss=C3=A9?= Date: Thu, 1 Nov 2018 08:46:33 +0100 Subject: [PATCH 09/11] Config: restrict import of System.Console.CmdArgs --- app/Config.hs | 11 ++++++++++- app/Main.hs | 3 +-- app/Server.hs | 11 +++++------ 3 files changed, 16 insertions(+), 9 deletions(-) diff --git a/app/Config.hs b/app/Config.hs index 596abd1..7e67aaa 100644 --- a/app/Config.hs +++ b/app/Config.hs @@ -4,7 +4,13 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} -module Config where +module Config + ( toodlesArgs + , ToodlesArgs(..) + , SearchFilter(..) + , AssigneeFilterRegex(..) + ) + where import Paths_toodles import Types @@ -13,6 +19,9 @@ import Data.Text (Text) import Data.Version (showVersion) import System.Console.CmdArgs +toodlesArgs :: IO ToodlesArgs +toodlesArgs = cmdArgs argParser + data ToodlesArgs = ToodlesArgs { directory :: FilePath , assignee_search :: Maybe SearchFilter diff --git a/app/Main.hs b/app/Main.hs index 6f2e0ce..4decd91 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -11,12 +11,11 @@ import Data.IORef (newIORef) import Data.Maybe (fromMaybe) import qualified Data.Text as T (unpack) import Network.Wai.Handler.Warp (run) -import System.Console.CmdArgs (cmdArgs) import Text.Printf (printf) main :: IO () main = do - userArgs <- cmdArgs argParser >>= setAbsolutePath + userArgs <- toodlesArgs >>= setAbsolutePath sResults <- runFullSearch userArgs case userArgs of (ToodlesArgs _ _ _ _ True _) -> mapM_ (putStrLn . prettyFormat) $ todos sResults diff --git a/app/Server.hs b/app/Server.hs index 95e1c01..f531c89 100644 --- a/app/Server.hs +++ b/app/Server.hs @@ -26,7 +26,6 @@ import qualified Data.Text as T import qualified Data.Yaml as Y import GHC.Generics (Generic) import Servant -import System.Console.CmdArgs import System.Directory import System.IO.HVFS import qualified System.IO.Strict as SIO @@ -208,19 +207,19 @@ deleteTodos (ToodlesState ref _) req = do removeTodoFromCode = updateTodoLinesInFile (const []) setAbsolutePath :: ToodlesArgs -> IO ToodlesArgs -setAbsolutePath toodlesArgs = do - let pathOrDefault = if T.null . T.pack $ directory toodlesArgs +setAbsolutePath args = do + let pathOrDefault = if T.null . T.pack $ directory args then "." - else directory toodlesArgs + else directory args absolute <- normalise_path <$> absolute_path pathOrDefault - return $ toodlesArgs {directory = absolute} + return $ args {directory = absolute} getFullSearchResults :: ToodlesState -> Bool -> IO TodoListResult getFullSearchResults (ToodlesState ref _) recompute = if recompute then do putStrLn "refreshing todo's" - userArgs <- cmdArgs argParser >>= setAbsolutePath + userArgs <- toodlesArgs >>= setAbsolutePath sResults <- runFullSearch userArgs atomicModifyIORef' ref (const (sResults, sResults)) else putStrLn "cached read" >> readIORef ref From 0a0b6651c8423ecc5f5be3a44bfab64729a241c3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Damien=20Courouss=C3=A9?= Date: Thu, 1 Nov 2018 09:02:16 +0100 Subject: [PATCH 10/11] flags: fix the text rendering --- app/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/app/Main.hs b/app/Main.hs index 4decd91..45916cb 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -29,7 +29,7 @@ main = do prettyFormat :: TodoEntry -> String prettyFormat (TodoEntryHead _ l a p n entryPriority f _ _ _) = printf - "Assignee: %s\n%s%s:%d\n%s" + "Assignee: %s\n%s%s:%d\n%s - %s" (fromMaybe "None" a) (maybe "" (\x -> "Priority: " ++ show x ++ "\n") entryPriority) p From 4faf8681c33cda3a90043981f44e57ab8d02b9a6 Mon Sep 17 00:00:00 2001 From: Avi Press Date: Thu, 1 Nov 2018 09:06:24 +0100 Subject: [PATCH 11/11] fix issue: deletion of TODOs in UI https://github.com/aviaviavi/toodles/pull/41#discussion_r229784915 --- app/Types.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/app/Types.hs b/app/Types.hs index e7c7425..159ff87 100644 --- a/app/Types.hs +++ b/app/Types.hs @@ -50,7 +50,8 @@ instance ToJSON TodoListResult newtype DeleteTodoRequest = DeleteTodoRequest { ids :: [Integer] - } deriving (Show, Generic, FromJSON) + } deriving (Show, Generic) +instance FromJSON DeleteTodoRequest data EditTodoRequest = EditTodoRequest { editIds :: [Integer]