kactivities/contrib/update-todo.hs

0001 #! /usr/bin/env runhaskell
0002
0003 {-# LANGUAGE LambdaCase #-}
0004
0005 import System.Directory (doesFileExist, getDirectoryContents)
0006 import System.FilePath ((</>))
0007
0008 import Data.String.Utils
0009 import Data.List
0010
0011
0012 -- Util methods
0013
0014 mapSnd :: (a -> b) -> [(c, a)] -> [(c, b)]
0015 mapSnd f xys = map ( \case (x, y) -> (x, f y) ) xys
0016
0017 mapDir :: (FilePath -> IO ()) -> FilePath -> IO ()
0018 mapDir proc fp = do
0019         isFile <- doesFileExist fp -- is a file of fp
0020         if isFile then proc fp -- process the file
0021                   else getDirectoryContents fp >>=
0022                   mapM_ (mapDir proc . (fp </>)) . filter (`notElem` [".", ".."])
0023
0024 printTitle :: String -> IO()
0025 printTitle title = do
0026         putStrLn ""
0027         putStrLn title
0028         putStrLn $ map (\_ -> '=') title
0029
0030 main :: IO ()
0031 main = do
0032     printTitle "libKActivities"
0033     mapDir process "src/lib/core"
0034
0035     printTitle "libKActivitiesStats"
0036     mapDir process "src/lib/stats"
0037
0038     printTitle "KActivityManagerD"
0039     mapDir process "src/service"
0040
0041     printTitle "QML imports"
0042     mapDir process "src/imports"
0043
0044     printTitle "Workspace plugins"
0045     mapDir process "src/workspace"
0046
0047     printTitle "Other"
0048     mapDir process "src/common"
0049     mapDir process "src/utils"
0050
0051 -- Parsing methods
0052
0053 extractBlock :: [String] -> [String]
0054 extractBlock =
0055         takeWhile (startswith "//")
0056
0057 isTodoBlock :: (Integer, [String]) -> Bool
0058 isTodoBlock (_, block) =
0059         (not $ null block) && (
0060             (startswith "// TODO: " $ head block) ||
0061             (startswith "// FIXME: " $ head block) ||
0062             (startswith "// NOTE: " $ head block)
0063         )
0064
0065 joinBlock :: [String] -> String
0066 joinBlock block =
0067         unlines $
0068         map ( \line ->
0069             ( dropWhile (== '/') line )
0070         ) $
0071         block
0072
0073
0074 -- File processing
0075
0076 process :: FilePath -> IO ()
0077 process filename = do
0078         -- Getting the file contents
0079         content <- readFile filename
0080
0081         -- Items with line numbers
0082         let items :: [(Integer, [String])]
0083             items =
0084                 zip [1..] $
0085                 tails $
0086                 map strip $
0087                 lines content
0088
0089         -- Only those starting with TODO
0090         let todoBlocks :: [(Integer, [String])]
0091             todoBlocks =
0092                 -- Getting only the comment block
0093                 mapSnd extractBlock $
0094                 -- Getting comment blocks that define a todo item
0095                 filter isTodoBlock $
0096                 items
0097
0098         -- Todo items
0099         let todoItems :: [(Integer, String)]
0100             todoItems =
0101                 -- Getting the item blocks into actual items
0102                 mapSnd joinBlock todoBlocks
0103
0104
0105         if (not $ null todoItems)
0106             then
0107                 putStrLn $
0108                     concat $
0109                     map (\case (lineNo, todoItem) ->
0110                                 filename ++ ":" ++ (show lineNo) ++ ":\n" ++ todoItem
0111                         ) todoItems
0112             else
0113                 return ()
0114
0115