-- findExecutable

module Development.Shake.Linters ( tomlcheck
                                 , yamllint
                                 , hlint
                                 , shellcheck
                                 , ghc
                                 , dhall
                                 , madlang
                                 -- * Formatters
                                 , clangFormat
                                 , atsfmt
                                 , stylishHaskell
                                 -- * File detection
                                 , module Development.Shake.FileDetect
                                 ) where

import           Control.Monad
import           Data.Char                    (isSpace)
import           Development.Shake
import           Development.Shake.FileDetect

-- | Check all @.dhall@ files.
dhall :: Action ()
dhall :: Action ()
dhall = (FilePath -> Action ()) -> [FilePath] -> Action ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> Action ()
checkDhall ([FilePath] -> Action ()) -> Action [FilePath] -> Action ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Action [FilePath]
getDhall

checkDhall :: FilePath -> Action ()
checkDhall :: FilePath -> Action ()
checkDhall FilePath
dh = do
    FilePath
contents <- IO FilePath -> Action FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> Action FilePath) -> IO FilePath -> Action FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
readFile FilePath
dh
    [CmdOption] -> FilePath -> [FilePath] -> Action ()
forall r.
(Partial, CmdResult r) =>
[CmdOption] -> FilePath -> [FilePath] -> Action r
command [FilePath -> CmdOption
Stdin FilePath
contents] FilePath
"dhall" []

trim :: String -> String
trim :: FilePath -> FilePath
trim = ((FilePath -> FilePath)
 -> (FilePath -> FilePath) -> FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> FilePath
f
   where f :: FilePath -> FilePath
f = FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace

-- | Check a given formatter is idempotent.
checkIdempotent :: String -> FilePath -> Action ()
checkIdempotent :: FilePath -> FilePath -> Action ()
checkIdempotent FilePath
s FilePath
p = do
    FilePath
contents <- IO FilePath -> Action FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> Action FilePath) -> IO FilePath -> Action FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
readFile FilePath
p
    (Stdout FilePath
out) <- (FilePath -> Action (Stdout FilePath)) :-> Action Any
forall args r. (Partial, CmdArguments args) => args
cmd (FilePath
s FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
p)
    if FilePath -> FilePath
trim FilePath
contents FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> FilePath
trim FilePath
out then () -> Action ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure () else FilePath -> Action ()
forall a. Partial => FilePath -> a
error FilePath
"formatter is not fully applied!"

-- | Check that given files are formatted according to @stylish-haskell@
stylishHaskell :: [FilePath] -> Action ()
stylishHaskell :: [FilePath] -> Action ()
stylishHaskell = (FilePath -> Action ()) -> [FilePath] -> Action ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> FilePath -> Action ()
checkIdempotent FilePath
"stylish-haskell")

-- | Check that given files are formatted according to @atsfmt@
atsfmt :: [FilePath] -> Action ()
atsfmt :: [FilePath] -> Action ()
atsfmt = (FilePath -> Action ()) -> [FilePath] -> Action ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> FilePath -> Action ()
checkIdempotent FilePath
"atsfmt")

-- | Check that given files are formatted according to @clang-format@
clangFormat :: [FilePath] -> Action ()
clangFormat :: [FilePath] -> Action ()
clangFormat = (FilePath -> Action ()) -> [FilePath] -> Action ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> FilePath -> Action ()
checkIdempotent FilePath
"clang-format")

checkFiles :: String -> [FilePath] -> Action ()
checkFiles :: FilePath -> [FilePath] -> Action ()
checkFiles FilePath
str = (FilePath -> Action ()) -> [FilePath] -> Action ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> Action ()
forall args. (Partial, CmdArguments args, Unit args) => args
cmd_ (FilePath -> Action ())
-> (FilePath -> FilePath) -> FilePath -> Action ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath
str FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" ") FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++))

-- | Check all @.mad@ files.
madlang :: [FilePath] -> Action ()
madlang :: [FilePath] -> Action ()
madlang = FilePath -> [FilePath] -> Action ()
checkFiles FilePath
"madlang check"

-- | Lint @.sh@ files using
-- [shellcheck](http://hackage.haskell.org/package/ShellCheck).
shellcheck :: [FilePath] -> Action ()
shellcheck :: [FilePath] -> Action ()
shellcheck = FilePath -> [FilePath] -> Action ()
checkFiles FilePath
"shellcheck"

-- | Check Haskell files using @ghc@.
ghc :: [FilePath] -> Action ()
ghc :: [FilePath] -> Action ()
ghc [FilePath]
dirs = FilePath -> [FilePath] -> Action ()
checkFiles FilePath
"ghc -Wall -Werror -Wincomplete-uni-patterns -Wincomplete-record-updates -fno-code" ([FilePath] -> Action ()) -> Action [FilePath] -> Action ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [FilePath] -> Action [FilePath]
getHs [FilePath]
dirs

-- | Check all @.toml@ files using
-- [tomlcheck](http://hackage.haskell.org/package/tomlcheck).
tomlcheck :: Action ()
tomlcheck :: Action ()
tomlcheck = FilePath -> [FilePath] -> Action ()
checkFiles FilePath
"tomlcheck --file" ([FilePath] -> Action ()) -> Action [FilePath] -> Action ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Action [FilePath]
getToml

-- | Lint all @.hs@, @.hsig@, and @.hs-boot@ files using
-- [hlint](http://hackage.haskell.org/package/hlint).
hlint :: [FilePath] -> Action ()
hlint :: [FilePath] -> Action ()
hlint [FilePath]
dirs = FilePath -> [FilePath] -> Action ()
checkFiles FilePath
"hlint" ([FilePath] -> Action ()) -> Action [FilePath] -> Action ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [FilePath] -> Action [FilePath]
getHs [FilePath]
dirs

-- | Lint all files ending in @yaml@ or @yml@ using
-- [yamllint](https://pypi.python.org/pypi/yamllint).
yamllint :: Action ()
yamllint :: Action ()
yamllint = FilePath -> [FilePath] -> Action ()
checkFiles FilePath
"yamllint -s" ([FilePath] -> Action ()) -> Action [FilePath] -> Action ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Action [FilePath]
getYml