-- | The functions in this module get all files in the current directory with
-- some extension.
module Development.Shake.FileDetect
    ( getAts
    , getSats
    , getHats
    , getCats
    , getYml
    , getToml
    , getHs
    , getHappy
    , getAlex
    , getShell
    , getDhall
    , getElm
    , getMadlang
    ) where

import           Control.Monad
import           Data.Semigroup    ((<>))
import           Development.Shake

-- | Get all files ending with @.mad@.
getMadlang :: Action [FilePath]
getMadlang :: Action [FilePath]
getMadlang = [FilePath] -> Action [FilePath]
getAll [FilePath
"mad"]

getElm :: Action [FilePath]
getElm :: Action [FilePath]
getElm = [FilePath] -> Action [FilePath]
getAll [FilePath
"elm"]

getDhall :: Action [FilePath]
getDhall :: Action [FilePath]
getDhall = [FilePath] -> Action [FilePath]
getAll [FilePath
"dhall"]

getYml :: Action [FilePath]
getYml :: Action [FilePath]
getYml = [FilePath] -> Action [FilePath]
getAll [FilePath
"yaml", FilePath
"yml", FilePath
"yamllint"]

getToml :: Action [FilePath]
getToml :: Action [FilePath]
getToml = [FilePath] -> Action [FilePath]
getAll [FilePath
"toml"]

-- | Get all haskell source files, including module signatures.
getHs :: [FilePath] -> Action [FilePath]
getHs :: [FilePath] -> Action [FilePath]
getHs [FilePath]
files = [[FilePath]] -> [FilePath]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[FilePath]] -> [FilePath])
-> Action [[FilePath]] -> Action [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> Action [FilePath])
-> [FilePath] -> Action [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FilePath -> [FilePath] -> Action [FilePath]
`getAllDir` [FilePath
"hs", FilePath
"hs-boot", FilePath
"hsig", FilePath
"lhs"]) [FilePath]
files

getHappy :: Action [FilePath]
getHappy :: Action [FilePath]
getHappy = [FilePath] -> Action [FilePath]
getAll [FilePath
"y", FilePath
"yl"]

getAlex :: Action [FilePath]
getAlex :: Action [FilePath]
getAlex = [FilePath] -> Action [FilePath]
getAll [FilePath
"x"]

getShell :: Action [FilePath]
getShell :: Action [FilePath]
getShell = [FilePath] -> Action [FilePath]
getAll [FilePath
"sh"]

get :: String -> Action [FilePath]
get :: FilePath -> Action [FilePath]
get = [FilePath] -> Action [FilePath]
getAll ([FilePath] -> Action [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> Action [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure

getAll :: [String] -> Action [FilePath]
getAll :: [FilePath] -> Action [FilePath]
getAll = FilePath -> [FilePath] -> Action [FilePath]
getAllDir FilePath
""

getAllDir :: FilePath -> [String] -> Action [FilePath]
getAllDir :: FilePath -> [FilePath] -> Action [FilePath]
getAllDir FilePath
dir [FilePath]
ss = FilePath -> [FilePath] -> Action [FilePath]
getDirectoryFiles FilePath
"" (((FilePath
dir FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"//*.") FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath]
ss)

getCats :: Action [FilePath]
getCats :: Action [FilePath]
getCats = FilePath -> Action [FilePath]
get FilePath
"cats"

getSats :: Action [FilePath]
getSats :: Action [FilePath]
getSats = FilePath -> Action [FilePath]
get FilePath
"sats"

getDats :: Action [FilePath]
getDats :: Action [FilePath]
getDats = FilePath -> Action [FilePath]
get FilePath
"dats"

getHats :: Action [FilePath]
getHats :: Action [FilePath]
getHats = FilePath -> Action [FilePath]
get FilePath
"hats"

-- | Get files ending in @.sats@ or @.dats@.
getAts :: Action [FilePath]
getAts :: Action [FilePath]
getAts = [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
(<>) ([FilePath] -> [FilePath] -> [FilePath])
-> Action [FilePath] -> Action ([FilePath] -> [FilePath])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Action [FilePath]
getDats Action ([FilePath] -> [FilePath])
-> Action [FilePath] -> Action [FilePath]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Action [FilePath]
getSats