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)
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
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)