module Boilerplate.RuleFinder (findRules) where import Control.Monad (join) import Data.Containers.ListUtils (nubOrdOn) import qualified Data.List as L import Data.Text (Text) import qualified Data.Text as T import Data.Traversable (for) import HsInspect.Util (locateDominating) import qualified HsInspect.Util as H import System.Directory (makeAbsolute) import System.FilePath (dropExtension, makeRelative, pathSeparator, takeBaseName, takeDirectory) -- Finds all .rule files that live in dominant directories named "boilerplate" -- starting from the file. The files are sorted lexiographically within each -- boilerplate directory, starting with the nearest directory and working -- outwards. -- -- Both fully qualified and short names are provided to make it easier for -- callers to find a rule [(fqn, short, path)]. findRules :: FilePath -> IO [(Text, Text, FilePath)] findRules file = do parent <- makeAbsolute $ takeDirectory file dirs <- locateDirs parent batches <- for dirs $ \dir -> do files <- H.walkSuffix ".rule" dir pure $ namer dir <$> L.sort files -- remove dupes when a direct ancestor is called `boilerplate` pure . nubOrdOn (\(_, _, c) -> c) $ join batches locateDirs :: FilePath -> IO [FilePath] locateDirs dir = do mdir <- locateDominating ("boilerplate" ==) dir case mdir of Nothing -> pure [] Just hit -> let grandparent = takeDirectory $ takeDirectory hit in if grandparent == dir then pure [hit] else (hit :) <$> locateDirs grandparent namer :: FilePath -> FilePath -> (Text, Text, FilePath) namer dir file = let fqn = replace pathSeparator '.' . dropExtension $ makeRelative dir file short = takeBaseName file replace from to = fmap (\c -> if c == from then to else c) in (T.pack fqn, T.pack short, file)