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 :: String -> IO [(Text, Text, String)]
findRules String
file = do
  String
parent <- String -> IO String
makeAbsolute forall a b. (a -> b) -> a -> b
$ String -> String
takeDirectory String
file
  [String]
dirs <- String -> IO [String]
locateDirs String
parent
  [[(Text, Text, String)]]
batches <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [String]
dirs forall a b. (a -> b) -> a -> b
$ \String
dir -> do
    [String]
files <- String -> String -> IO [String]
H.walkSuffix String
".rule" String
dir
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> String -> (Text, Text, String)
namer String
dir forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Ord a => [a] -> [a]
L.sort [String]
files
  -- remove dupes when a direct ancestor is called `boilerplate`
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn (\(Text
_, Text
_, String
c) -> String
c) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => m (m a) -> m a
join [[(Text, Text, String)]]
batches

locateDirs :: FilePath -> IO [FilePath]
locateDirs :: String -> IO [String]
locateDirs String
dir = do
  Maybe String
mdir <- (String -> Bool) -> String -> IO (Maybe String)
locateDominating (String
"boilerplate" forall a. Eq a => a -> a -> Bool
==) String
dir
  case Maybe String
mdir of
    Maybe String
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    Just String
hit ->
      let grandparent :: String
grandparent = String -> String
takeDirectory forall a b. (a -> b) -> a -> b
$ String -> String
takeDirectory String
hit
       in if String
grandparent forall a. Eq a => a -> a -> Bool
== String
dir
          then forall (f :: * -> *) a. Applicative f => a -> f a
pure [String
hit]
          else (String
hit forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
locateDirs String
grandparent

namer :: FilePath -> FilePath -> (Text, Text, FilePath)
namer :: String -> String -> (Text, Text, String)
namer String
dir String
file =
  let fqn :: String
fqn = forall {f :: * -> *} {b}. (Functor f, Eq b) => b -> b -> f b -> f b
replace Char
pathSeparator Char
'.' forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
dropExtension forall a b. (a -> b) -> a -> b
$ String -> String -> String
makeRelative String
dir String
file
      short :: String
short = String -> String
takeBaseName String
file
      replace :: b -> b -> f b -> f b
replace b
from b
to = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\b
c -> if b
c forall a. Eq a => a -> a -> Bool
== b
from then b
to else b
c)
   in (String -> Text
T.pack String
fqn, String -> Text
T.pack String
short, String
file)