module Development.Shake.Clean ( cleanElm
                               , cleanProducts
                               , cleanHaskell
                               ) where

import           Development.Shake

-- | Clean @elm-stuff@ directory and file extensions typically associated w/ Elm
-- builds.
cleanElm :: Action ()
cleanElm :: Action ()
cleanElm =
    FilePath -> [FilePath] -> Action ()
removeFilesAfter FilePath
"elm-stuff" [FilePath
"//*"] Action () -> Action () -> Action ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
    FilePath -> [FilePath] -> Action ()
removeFilesAfter FilePath
"." [FilePath
"//*.elmi"]

-- | Clean generic products (@.o@, @.so@, @.a@).
cleanProducts :: Action ()
cleanProducts :: Action ()
cleanProducts = FilePath -> [FilePath] -> Action ()
removeFilesAfter FilePath
"." [FilePath
"//*.so", FilePath
"//*.o", FilePath
"//*.a"]

-- | Clean directories and file extensions typically associated w/ Haskell
-- builds
cleanHaskell :: Action ()
cleanHaskell :: Action ()
cleanHaskell =
    (FilePath -> Action ()) -> [FilePath] -> Action ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\FilePath
p -> FilePath -> [FilePath] -> Action ()
removeFilesAfter FilePath
p [FilePath
"//*"])
        [ FilePath
"dist", FilePath
"dist-newstyle", FilePath
".stack-work", FilePath
".cabal-sandbox" ] Action () -> Action () -> Action ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
    FilePath -> [FilePath] -> Action ()
removeFilesAfter FilePath
"."
        [FilePath
"//*.o", FilePath
"//*.ghc.*", FilePath
"//*_stub.h", FilePath
"//*.hi", FilePath
"//*.dyn_o", FilePath
"//*.p_o", FilePath
"//*.dyn_hi", FilePath
"//*.p_hi", FilePath
"//*.hc", FilePath
"//*.haddock", FilePath
"cabal.sandbox.config"]