lentil 0.1.0.0 → 0.1.0.1
raw patch · 7 files changed
+488/−1 lines, 7 files
Files
- lentil.cabal +4/−1
- src/Lentil/Args.hs +171/−0
- src/Lentil/Export.hs +35/−0
- src/Lentil/File.hs +50/−0
- src/Lentil/Print.hs +93/−0
- src/Lentil/Query.hs +100/−0
- src/Lentil/Types.hs +35/−0
lentil.cabal view
@@ -1,5 +1,5 @@ name: lentil-version: 0.1.0.0+version: 0.1.0.1 synopsis: frugal issue tracker description: minumum effort, cohesive issue tracker for the rest of us. Check homepage for manual, tutorial.@@ -23,6 +23,9 @@ parsec >=3.1 && <3.2, filepath >=1.3 && <1.5, directory >=1.2 && <1.3, filemanip >=0.3 && <0.4, ansi-wl-pprint >= 0.6 && < 0.7, csv >= 0.1 && < 0.2++ other-modules: Lentil.Types, Lentil.Args, Lentil.File, Lentil.Print,+ Lentil.Query, Lentil.Export hs-source-dirs: src
+ src/Lentil/Args.hs view
@@ -0,0 +1,171 @@+-----------------------------------------------------------------------------+-- |+-- Module : Lentil.Query+-- Copyright : © 2015 Francesco Ariis+-- License : GPLv3 (see the LICENSE file)+--+-- Command line parsing+-----------------------------------------------------------------------------++module Lentil.Args where++import Lentil.Types+import Lentil.Query++import Options.Applicative+import qualified Data.Char as C+++-----------+-- TYPES --+-----------++-- TODO: show help option in lentil short help [feature:intermediate]+-- TODO: disambiguation optparse-applicative [feature:intermediate]+-- TODO: help as lentil PATH [ PATH... ] [ OPTIONS ] [feature:intermediate]++data LOptions = LOptions { loInExcl :: ([FilePath], [FilePath]),+ loFormat :: Format,+ loFilters :: [LFilter],+ loSort :: [LSort],+ loOutFile :: Maybe FilePath }+ deriving (Show)++type LFilter = [Issue] -> [Issue]+type ChType = [LFilter] -> [Issue] -> [Issue] -- AND or OR chain+type LSort = [Issue] -> [Issue]+++lOpts :: Parser LOptions+lOpts = LOptions <$> inexcls <*> format <*> filters <*>+ issort <*> outfile+ where inexcls = (,) <$> includes <*> many exclude+ filters = many $ foldl1 (<|>) [tag, notag, path,+ nopath, desc, nodesc]+++-------------+-- PARSERS --+-------------++-- argument "." gets replaced to "" (all files)+includes :: Parser [FilePath]+includes = map repf <$> some (argument str (metavar "PATH..."))+ where repf "." = ""+ repf cs = cs++exclude :: Parser FilePath+exclude = strOption ( short 'x' <>+ metavar "PATH" <>+ help "file/directory to exclude" )++format :: Parser Format+format = option (str >>= parseFormat)+ ( short 'f' <>+ metavar "TYPE" <>+ value Pretty <>+ help "output format (pretty, tagpop, csv)" )+ where+ parseFormat :: String -> ReadM Format+ parseFormat s = let asl = map forTup (enumFrom minBound)+ in maybe (rerr s "unrecognised format")+ return (lookup s asl)++ forTup f = (map C.toLower $ show f, f)+++outfile :: Parser (Maybe FilePath)+outfile = optional $ strOption+ ( long "output" <>+ metavar "FILE" <>+ help "output file (if not present, prints to stdout)" )++++issort :: Parser [LSort]+issort = pure []++{-++ TODO: uncomment and implement sorting [feature:intermediate]++issort :: Parser [LSort]+issort = option (str >>= parseSorts)+ ( long "sort" <>+ short 's' <>+ metavar "[!]ORDER[,[!]ORDER ...]" <>+ value [] <>+ help "sort order, comma separated (path, desc, label). \+ \'!' orders in descending fashion. Check manual for \+ \examples" )+ -- TODO: sort parsing? [feature:intermediate]+ where parseSorts :: String -> ReadM [LSort]+ parseSorts cs = mapM parSort . words . replace ',' ' ' $ cs++ -- this parsort is broken [bug] [duct]+ parSort :: String -> ReadM LSort+ parSort "path" = return (sortIssues iFile Asc)+ parSort "desc" = return (sortIssues iDesc Asc)+ parSort "!path" = return (sortIssues iFile Desc)+ parSort "!desc" = return (sortIssues iDesc Desc)+ parSort _ = error "lol"++ replace :: Char -> Char -> String -> String+ replace a b cs = map (\c -> if c == a then b else c) cs++-}++-------------------+-- FILTER PARAMS --+-------------------++path :: Parser LFilter+path = option (filterFilepath <$> str)+ ( short 'p' <>+ metavar "EXPR" <>+ help "filters for filepath matching EXPR" )++nopath :: Parser LFilter+nopath = option (negFilter . filterFilepath <$> str)+ ( short 'P' <>+ metavar "EXPR" <>+ help "filters for filepath NOT matching EXPR" )++desc :: Parser LFilter+desc = option (filterDescription <$> str)+ ( short 'd' <>+ metavar "EXPR" <>+ help "filters for description matching EXPR" )++nodesc :: Parser LFilter+nodesc = option (negFilter . filterDescription <$> str)+ ( short 'D' <>+ metavar "EXPR" <>+ help "filters for description NOT matching EXPR" )++tag :: Parser LFilter+tag = option optTxt ( short 't' <>+ metavar "EXPR" <>+ help "filter for tag matching EXPR" )++notag :: Parser LFilter+notag = option (negFilter <$> optTxt)+ ( short 'T' <>+ metavar "EXPR" <>+ help "filter for tag NOT matching EXPR" )+++optTxt :: ReadM LFilter+optTxt = str >>= \oStr ->+ if oStr == "^"+ then return filterTagless+ else return (filterTags oStr)+++-----------------+-- ANCILLARIES --+-----------------++rerr :: String -> String -> ReadM a+rerr var msg = readerError $ msg ++ " \"" ++ var ++ "\""+
+ src/Lentil/Export.hs view
@@ -0,0 +1,35 @@+-----------------------------------------------------------------------------+-- |+-- Module : Lentil.Export+-- Copyright : © 2015 Francesco Ariis+-- License : GPLv3 (see the LICENSE file)+--+-- Exporting issues to various formats+-----------------------------------------------------------------------------++module Lentil.Export where++import Text.CSV+import Lentil.Types++import qualified Data.List as L+++---------------+-- FUNCTIONS --+---------------++issues2CSV :: [Issue] -> String+issues2CSV is = printCSV (firstLine : map i2r is)+ where firstLine = ["Filepath", "Row", "Description", "Tags"]+ i2r i = [iFile i, show (iRow i),+ iDesc i, tags2String (iTags i)]+++-----------------+-- ANCILLARIES --+-----------------++tags2String :: [Tag] -> String+tags2String ts = L.intercalate " " (map tagString ts)+
+ src/Lentil/File.hs view
@@ -0,0 +1,50 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Lentil.File+-- Copyright : © 2015 Francesco Ariis+-- License : GPLv3 (see the LICENSE file)+--+-- File operations+-----------------------------------------------------------------------------++module Lentil.File where++import Lentil.Types+import Lentil.Parse++import System.FilePath+import System.FilePath.Find+import Data.Monoid+import Control.Applicative++import qualified Data.List as L++++---------------+-- INSTANCES --+---------------++instance Monoid a => Monoid (FindClause a) where+ mempty = pure mempty+ mappend = liftA2 mappend+++--------------+-- FILESCAN --+--------------++findIssues :: [FilePath] -> [FilePath] -> IO [Issue]+findIssues is xs = find always (findClause is xs) "." >>= issueFinder++-- fp to include, fp to exclude, clause+findClause :: [FilePath] -> [FilePath] -> FindClause Bool+findClause i x = let ic = mconcat $ map fp2fc i+ xc = mconcat $ map fp2fc x+ in fmap getAny ic &&? (not <$> fmap getAny xc)+ where+ fp2fc :: FilePath -> FindClause Any+ fp2fc f = Any . L.isPrefixOf (combine "." f) <$> filePath+ -- TODO: combine funziona su windows? [feature:intermediate]+
+ src/Lentil/Print.hs view
@@ -0,0 +1,93 @@+-----------------------------------------------------------------------------+-- |+-- Module : Lentil.Print+-- Copyright : © 2015 Francesco Ariis+-- License : GPLv3 (see the LICENSE file)+--+-- printing types+-----------------------------------------------------------------------------++module Lentil.Print where++import Lentil.Types+import Lentil.Query++import Text.PrettyPrint.ANSI.Leijen as PP+import qualified Data.List as L+++-- number of spaces + digits in indentation levels+indNum :: Int+indNum = 6++----------------+-- PRIMITIVES --+----------------++-- right align a number in a space of i columns+alignNumber :: Int -> Int -> String+alignNumber i n = replicate (i - length sn) ' ' ++ sn+ where sn = show n++-- Bool: wheter or not to use colours in rendering+myRender :: Bool -> Doc -> String+myRender col d = ($ "") . displayS . renderPretty 1 75 $ d'+ where d' | col == True = d+ | otherwise = plain d+++------------------+-- PRETTY PRINT --+------------------++data TagCol = Red | Blue deriving (Eq)+ppTag :: TagCol -> Tag -> Doc+ppTag c t = col (char openDel) <> string (tagString t) <>+ col (char closeDel)+ where col | c == Red = red+ | c == Blue = blue++ppIssue :: Int -> Issue -> Doc+ppIssue ind is = indent spInd ( fillSep [string iNum, string "",+ hang 0 (fillSep $ ppDescTags is)] )+ where+ ppDescTags :: Issue -> [Doc]+ ppDescTags i = map string (words (iDesc is)) +++ map (ppTag Blue) (iTags i)++ spInd = indNum - ind+ iNum = alignNumber ind $ iRow is+++ppFile :: Int -> [Issue] -> Doc+ppFile ind is = text (drop 2 $ iFile (head is)) PP.<$>+ vsep (map (ppIssue ind) is)++-- TODO: choose report width (test senza tag)+ppIssues :: Bool -> [Issue] -> String+ppIssues col is = myRender col $ vsep (L.intersperse softline igr)+ where+ ind = maximum . map (length . show . iRow) $ is+ igr = map (ppFile ind) $ groupIssues iFile is+++-------------+-- REPORTS --+-------------++-- tagpop pp report+ppPopularity :: Bool -> [Issue] -> String+ppPopularity col is = myRender col $ text "Tags popularity:" PP.<$>+ vsep (ppPops) -- PP.<$> (string "")+ where+ listpop = tagPop is++ ind = maximum . map (length . show . snd) $ listpop+ spInd = indNum - ind++ ppPop (t, n) = indent spInd (fillSep [iNum n, string "",+ hang 0 (ppTag Red t)])+ ppPops = map ppPop listpop++ iNum n = string $ alignNumber ind n+
+ src/Lentil/Query.hs view
@@ -0,0 +1,100 @@+-----------------------------------------------------------------------------+-- |+-- Module : Lentil.Query+-- Copyright : © 2015 Francesco Ariis+-- License : GPLv3 (see the LICENSE file)+--+-- Query Issues+-----------------------------------------------------------------------------++module Lentil.Query where++import Lentil.Types++import Text.Regex.TDFA+import qualified Data.List as L+import qualified Data.Function as F+import qualified Algorithms.NaturalSort as NS++type RegExp = String++-- TODO: filtering case unsensitive? [test]++---------------+-- FILTERING --+---------------++-- chains (boolean `and`) some partially applied filters+filterAnd :: [[Issue] -> [Issue]] -> [Issue] -> [Issue]+filterAnd fs is = foldl (\r f -> L.intersect r (f is)) is fs++-- chains (boolean `or`) some partially applied filters+filterOr :: [[Issue] -> [Issue]] -> [Issue] -> [Issue]+filterOr fs is = foldl (\r f -> L.union r (f is)) [] fs++filterFilepath :: RegExp -> [Issue] -> [Issue]+filterFilepath r is = filter ((=~ r) . iFile) is++filterDescription :: RegExp -> [Issue] -> [Issue]+filterDescription r is = filter ((=~ r) . iDesc) is++filterTags :: RegExp -> [Issue] -> [Issue]+filterTags r is = filter (df . iTags) is+ where df ts = any ((=~ r) . tagString) ts++filterTagless :: [Issue] -> [Issue]+filterTagless is = filter (null . iTags) is++negFilter :: ([Issue] -> [Issue]) -> [Issue] -> [Issue]+negFilter f is = is L.\\ f is+++-------------+-- SORTING --+-------------++data SortOrder = Asc | Desc deriving (Show, Eq)++-- sequences sorting+chainSorts :: [Issue] -> [[Issue] -> [Issue]] -> [Issue]+chainSorts is [] = is+chainSorts is (s:ss) = concatMap (flip chainSorts ss) $ L.group (s is)++-- given a particular accessor and a sort order, sorts issues+sortIssues :: (NS.NaturalSort a) => (Issue -> a) -> SortOrder ->+ [Issue] -> [Issue]+sortIssues ax o is = if o == Asc then sorted else reverse sorted+ where sorted = L.sortBy (NS.compare `F.on` ax) is++-- give a *partial* tag and it will sort the rest of it+sortTag :: RegExp -> SortOrder -> [Issue] -> [Issue]+sortTag r o is = if o == Asc then sorted else reverse sorted+ where+ ts2s :: RegExp -> [Tag] -> String+ ts2s e ts = maybe "" id $ L.find (=~ e) (map tagString ts)++ cf :: Issue -> Issue -> Ordering+ cf a b = (NS.compare `F.on` (ts2s r . iTags)) a b++ sorted = L.sortBy cf is+++--------------+-- GROUPING --+--------------++groupIssues :: (NS.NaturalSort a, Eq a) =>+ (Issue -> a) -> [Issue] -> [[Issue]]+groupIssues ax is = L.groupBy ((==) `F.on` ax) . sortIssues ax Asc $ is+++-------------+-- REPORTS --+-------------++-- tag popularity+tagPop :: [Issue] -> [(Tag, Int)]+tagPop is = reverse . L.sortBy (compare `F.on` snd) .+ map (\l -> (head l, length l)) . L.group .+ L.sort . concatMap iTags $ is+
+ src/Lentil/Types.hs view
@@ -0,0 +1,35 @@+-----------------------------------------------------------------------------+-- |+-- Module : Lentil.Types+-- Copyright : © 2015 Francesco Ariis+-- License : GPLv3 (see the LICENSE file)+--+-- Types descriptions+-----------------------------------------------------------------------------++module Lentil.Types where++++data Issue = Issue { iFile :: FilePath,+ iRow :: Row,+ iDesc :: Description,+ iTags :: [Tag] }+ deriving (Eq, Show)++data Tag = Tag { tagString :: String }+ deriving (Show, Eq, Ord)++type Description = String+type Row = Int++-- output format+data Format = TagPop | Pretty | Csv+ deriving (Show, Eq, Enum, Bounded)+++-- tag delimiters+openDel, closeDel :: Char+openDel = '['+closeDel = ']'+