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/Config.hs b/app/Config.hs index 5705837..7e67aaa 100644 --- a/app/Config.hs +++ b/app/Config.hs @@ -1,23 +1,34 @@ -{-# LANGUAGE DeriveDataTypeable, - DataKinds, - OverloadedStrings, - ScopedTypeVariables, - TypeOperators #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} -module Config where +module Config + ( toodlesArgs + , ToodlesArgs(..) + , SearchFilter(..) + , AssigneeFilterRegex(..) + ) + where import Paths_toodles +import Types 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 , limit_results :: Int , port :: Maybe Int , no_server :: Bool + , userFlag :: [UserFlag] } deriving (Show, Data, Typeable, Eq) newtype SearchFilter = @@ -34,6 +45,7 @@ argParser = ToodlesArgs , 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" &= verbosity diff --git a/app/Main.hs b/app/Main.hs index 48b7697..45916cb 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -11,15 +11,14 @@ 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 + (ToodlesArgs _ _ _ _ True _) -> mapM_ (putStrLn . prettyFormat) $ todos sResults _ -> do let webPort = fromMaybe 9001 $ port userArgs ref <- newIORef sResults @@ -28,12 +27,13 @@ main = do run webPort $ app $ ToodlesState ref dataDir 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" diff --git a/app/Parse.hs b/app/Parse.hs index b2a1500..f076906 100644 --- a/app/Parse.hs +++ b/app/Parse.hs @@ -63,6 +63,21 @@ parseDetails toParse = entryTags = filter (T.isPrefixOf "#") dataTokens in (assigneeTo, priorityVal, filteredDetails, entryTags) +-- | 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 ) + + fileTypeToComment :: [(Text, Text)] fileTypeToComment = [ (".c", "//") @@ -102,16 +117,16 @@ fileTypeToComment = , (".yaml", "#") ] -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 - where + where -- fold fn to concatenate todos that a multiple, single line comments foldTodoHelper :: ([TodoEntry], Bool) -> Maybe TodoEntry -> ([TodoEntry], Bool) foldTodoHelper (todoEntries, currentlyBuildingTodoLines) maybeTodo @@ -124,7 +139,7 @@ runTodoParser (SourceFile path ls) = (init todoEntries ++ [combineTodo (last todoEntries) (fromJust maybeTodo)], True) | otherwise = (todoEntries, False) - where + where isEntryHead :: TodoEntry -> Bool isEntryHead TodoEntryHead {} = True isEntryHead _ = False @@ -134,8 +149,8 @@ runTodoParser (SourceFile path ls) = 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" getExtension :: FilePath -> Text @@ -162,15 +177,14 @@ fth4 (_, _, _, x) = x unkownMarker :: Text unkownMarker = "UNKNOWN-DELIMETER-UNKNOWN-DELIMETER-UNKNOWN-DELIMETER" -parseTodo :: FilePath -> LineNumber -> Parser TodoEntry -parseTodo path lineNum = try parseTodoEntryHead - <|> parseComment (getExtension path) - - where - parseTodoEntryHead :: Parser TodoEntry - parseTodoEntryHead = do +parseTodo :: [UserFlag] -> FilePath -> LineNumber -> Parser TodoEntry +parseTodo us path lineNum = try (parseTodoEntryHead us) + <|> parseComment (getExtension path) + where + parseTodoEntryHead :: [UserFlag] -> Parser TodoEntry + parseTodoEntryHead uf = do entryLeadingText <- manyTill anyChar (prefixParserForFileType $ getExtension path) - _ <- symbol "TODO" + f <- parseFlag uf entryDetails <- optional $ try (inParens $ many (noneOf [')', '('])) let parsedDetails = parseDetails . T.pack <$> entryDetails entryPriority = (readMaybe . T.unpack) =<< (snd4 =<< parsedDetails) @@ -187,6 +201,7 @@ parseTodo path lineNum = try parseTodoEntryHead path lineNum entryPriority + f otherDetails entryTags (T.pack entryLeadingText) diff --git a/app/Server.hs b/app/Server.hs index a0e0a8f..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 @@ -37,8 +36,9 @@ import qualified Text.Blaze.Html5 as BZ import Text.Printf import Text.Regex.Posix -newtype ToodlesConfig = ToodlesConfig +data ToodlesConfig = ToodlesConfig { ignore :: [FilePath] + , flags :: [UserFlag] } deriving (Show, Generic, FromJSON) app :: ToodlesState -> Application @@ -115,7 +115,7 @@ renderTodo t = let comment = fromJust $ lookup ("." <> getExtension (sourceFile t)) fileTypeToComment detail = - "TODO (" <> + renderFlag (flag t) <> " (" <> (T.pack $ Data.String.Utils.join "|" @@ -129,7 +129,7 @@ renderTodo t = mapHead (\l -> leadingText t <> l) $ mapInit (\l -> foldl (<>) "" [" " | _ <- [1..(T.length $ leadingText t)]] <> l) commented - where + where mapHead :: (a -> a) -> [a] -> [a] mapHead f (x:xs) = f x : xs mapHead _ xs = xs @@ -142,6 +142,12 @@ renderTodo t = listIfNotNull "" = [] listIfNotNull s = [s] + renderFlag :: Flag -> Text + renderFlag TODO = "TODO" + renderFlag FIXME = "FIXME" + renderFlag XXX = "XXX" + renderFlag (UF (UserFlag x)) = x + -- | Given a function to emit new lines for a given todo, write that update in -- place of the current todo lines updateTodoLinesInFile :: MonadIO m => (TodoEntry -> [Text]) -> TodoEntry -> m () @@ -201,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 @@ -224,11 +230,12 @@ runFullSearch userArgs = do 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 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 indexedResults = map (\(i, r) -> r {entryId = i}) $ zip [1 ..] resultList @@ -244,7 +251,7 @@ runFullSearch userArgs = do limitSearch todoList n = take n todoList getAllFiles :: ToodlesConfig -> FilePath -> IO [SourceFile] -getAllFiles (ToodlesConfig ignoredPaths) basePath = +getAllFiles (ToodlesConfig ignoredPaths _) basePath = E.catch (do putStrLn $ printf "Running toodles for path: %s" basePath files <- recurseDir SystemFS basePath diff --git a/app/Types.hs b/app/Types.hs index 740bba2..159ff87 100644 --- a/app/Types.hs +++ b/app/Types.hs @@ -1,12 +1,19 @@ -{-# LANGUAGE DeriveAnyClass, - DeriveGeneric #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} module Types where -import Data.Aeson (ToJSON, FromJSON) -import Data.IORef (IORef) -import Data.Text (Text) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON, ToJSON, Value (String), parseJSON, + toJSON) +import Data.Aeson.Types (typeMismatch) +import Data.Data +import Data.IORef (IORef) +import Data.String (IsString) +import Data.Text (Text) +import qualified Data.Text as T (unpack) +import GHC.Generics (Generic) data SourceFile = SourceFile { fullPath :: FilePath @@ -27,20 +34,24 @@ data TodoEntry , sourceFile :: FilePath , lineNumber :: LineNumber , priority :: Maybe Integer + , flag :: Flag , customAttributes :: [(Text, Text)] , tags :: [Text] , leadingText :: Text } | TodoBodyLine Text - deriving (Show, Generic, ToJSON) + deriving (Show, Generic) +instance ToJSON TodoEntry data TodoListResult = TodoListResult { todos :: [TodoEntry] , message :: Text - } deriving (Show, Generic, ToJSON) + } deriving (Show, Generic) +instance ToJSON TodoListResult newtype DeleteTodoRequest = DeleteTodoRequest { ids :: [Integer] - } deriving (Show, Generic, FromJSON) + } deriving (Show, Generic) +instance FromJSON DeleteTodoRequest data EditTodoRequest = EditTodoRequest { editIds :: [Integer] @@ -48,4 +59,39 @@ data EditTodoRequest = EditTodoRequest , addTags :: [Text] , addKeyVals :: [(Text, Text)] , setPriority :: Maybe Integer - } deriving (Show, Generic, FromJSON) + } deriving (Show, Generic) +instance FromJSON EditTodoRequest + +data Flag = TODO | FIXME | XXX | UF UserFlag + deriving (Generic) + +newtype UserFlag = UserFlag Text + deriving (Show, Eq, IsString, Data, Generic) + +instance Show Flag where + show TODO = "TODO" + show FIXME = "FIXME" + show XXX = "XXX" + show (UF (UserFlag x)) = T.unpack x + +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 diff --git a/package.yaml b/package.yaml index 890d008..7de53fe 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 fd1bfee..a25ec08 100644 --- a/toodles.cabal +++ b/toodles.cabal @@ -1,8 +1,10 @@ --- This file has been generated from package.yaml by hpack version 0.28.2. +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.31.0. -- -- see: https://github.com/sol/hpack -- --- hash: 1db0fe4af19503b62b329d05d28ee3b9d61e69b6919ca9205e5b0ece19e4faeb +-- hash: 92631e6c0588971cddf6651815d7b3793d0d453f48c6d5100ce62b534ed0094a name: toodles version: 0.1.0.16 @@ -16,20 +18,19 @@ maintainer: mail@avi.press copyright: 2018 Avi Press license: MIT build-type: Simple -cabal-version: >= 1.10 extra-source-files: README.md data-files: + web/js/app.js + web/js/jquery-3.3.1.min.js + web/js/vue.js + web/html/index.html web/css/bulma.min.css web/css/font-awesome.min.css web/css/toodles.css web/fonts/fontawesome-webfont.woff web/fonts/fontawesome-webfont.woff2 - web/html/index.html web/img/favicon.png - web/js/app.js - web/js/jquery-3.3.1.min.js - web/js/vue.js source-repository head type: git @@ -46,7 +47,7 @@ executable toodles Paths_toodles hs-source-dirs: app - ghc-options: -threaded -rtsopts -O3 -Wall -with-rtsopts=-N + ghc-options: -Wall -Wcompat -threaded -rtsopts -O3 -Wall -with-rtsopts=-N build-depends: MissingH >=1.4.0.1 , aeson ==1.3.1.1 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 b014a5c..5db5a9a 100644 --- a/web/js/app.js +++ b/web/js/app.js @@ -33,18 +33,19 @@ $(document).ready(function() { this.todos = data.todos.map(t => { return { id: t.entryId, - assignee: t.assignee, body: t.body.join("\n"), - lineNumber: t.lineNumber, + assignee: t.assignee, sourceFile: t.sourceFile, + lineNumber: t.lineNumber, priority: t.priority, - tags: t.tags, + flag: t.flag, customAttributes: t.customAttributes.reduce((acc, curr) => { console.log(acc, curr) acc[curr[0]] = curr[1] console.log(acc, curr) return acc }, {}), + tags: t.tags, selected: false } }) @@ -236,4 +237,3 @@ $(document).ready(function() { } }) }) -