diff options
Diffstat (limited to 'app/TreeGrepper')
-rw-r--r-- | app/TreeGrepper/FileType.hs | 76 | ||||
-rw-r--r-- | app/TreeGrepper/Match.hs | 28 | ||||
-rw-r--r-- | app/TreeGrepper/Result.hs | 15 |
3 files changed, 107 insertions, 12 deletions
diff --git a/app/TreeGrepper/FileType.hs b/app/TreeGrepper/FileType.hs new file mode 100644 index 0000000..843eaf1 --- /dev/null +++ b/app/TreeGrepper/FileType.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +module TreeGrepper.FileType + ( FileType (..), + all, + Info (..), + BlockInfo (..), + info, + ) +where + +import Data.Aeson (FromJSON (parseJSON)) +import Data.Text (Text) +import Prelude hiding (all) + +data FileType + = Elm + | Haskell + | Nix + | Shell + deriving (Show) + +instance FromJSON FileType where + parseJSON v = + parseJSON v >>= \case + "elm" -> pure Elm + "haskell" -> pure Haskell + "nix" -> pure Nix + "sh" -> pure Shell + fileType -> fail ("parsing file_type failed, got " ++ fileType) + +all :: [FileType] +all = + [ Elm, + Haskell, + Nix, + Shell + ] + +data Info = Info + { exts :: [String], + lineStart :: Text, + block :: Maybe BlockInfo + } + +data BlockInfo = BlockInfo + { blockStart :: [Text], + blockEnd :: Text + } + +info :: FileType -> Info +info Elm = + Info + { exts = [".elm"], + lineStart = "--", + block = Just BlockInfo {blockStart = ["{-|", "{-"], blockEnd = "-}"} + } +info Haskell = + Info + { exts = [".hs"], + lineStart = "--", + block = Just BlockInfo {blockStart = ["{-"], blockEnd = "-}"} + } +info Nix = + Info + { exts = [".nix"], + lineStart = "#", + block = Just BlockInfo {blockStart = ["/*"], blockEnd = "*/"} + } +info Shell = + Info + { exts = [".sh"], + lineStart = "#", + block = Nothing + } diff --git a/app/TreeGrepper/Match.hs b/app/TreeGrepper/Match.hs index f882a3c..7b8cde8 100644 --- a/app/TreeGrepper/Match.hs +++ b/app/TreeGrepper/Match.hs @@ -10,13 +10,17 @@ where import Data.Aeson (FromJSON) import Data.Function (on) import Data.List (sortBy) +import Data.List.NonEmpty (NonEmpty ((:|))) +import Data.List.NonEmpty qualified as N import Data.Ord (comparing) +import Data.Text (Text) +import Data.Text qualified as T import GHC.Generics (Generic) data Match = Match { kind :: String, name :: String, - text :: String, + text :: Text, start :: Position, end :: Position } @@ -39,11 +43,11 @@ instance FromJSON Position merge :: [Match] -> [Match] merge matches = map mergeGroup - . groupBy (\a b -> a.end.row + 1 == b.start.row) + . chainsBy (\a b -> a.end.row + 1 == b.start.row) $ sortBy (comparing (.start)) matches -mergeGroup :: [Match] -> Match -mergeGroup (m : ms) = +mergeGroup :: NonEmpty Match -> Match +mergeGroup (m :| ms) = m { text = text, start = start, @@ -51,16 +55,16 @@ mergeGroup (m : ms) = } where mss = m : ms - text = unlines $ map (.text) mss + text = T.unlines $ map (.text) mss start = minimum $ map (.start) mss end = maximum $ map (.end) mss {- A version of `Data.List.groupBy` that uses the last added group-member for comparison with new candidates for the group. `Data.List.groupBy` uses the initial member for all subsequent comparisons. -} -groupBy :: (a -> a -> Bool) -> [a] -> [[a]] -groupBy p xs = reverse . map reverse $ go [] p xs +chainsBy :: (a -> a -> Bool) -> [a] -> [NonEmpty a] +chainsBy p = reverse . map N.reverse . go [] where - go rs _ [] = rs - go [] p (x : xs) = go [[x]] p xs - go (ass@((a : as) : rs)) p (x : xs) - | p a x = go ((x : a : as) : rs) p xs - | otherwise = go ([x] : ass) p xs + go rs [] = rs + go [] (x : xs) = go [N.singleton x] xs + go (ass@((a :| as) : rs)) (x : xs) + | p a x = go ((x :| a : as) : rs) xs + | otherwise = go (N.singleton x : ass) xs diff --git a/app/TreeGrepper/Result.hs b/app/TreeGrepper/Result.hs new file mode 100644 index 0000000..856871a --- /dev/null +++ b/app/TreeGrepper/Result.hs @@ -0,0 +1,15 @@ +module TreeGrepper.Result (Result (..)) where + +import Data.Aeson (FromJSON) +import GHC.Generics (Generic) +import TreeGrepper.FileType (FileType) +import TreeGrepper.Match (Match) + +data Result = Result + { file :: String, + file_type :: FileType, + matches :: [Match] + } + deriving (Show, Generic) + +instance FromJSON Result |