RuleFinder.hs

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)