module Lastik.Runner(
Runner,
runner,
runnerPath,
codeRunner,
pathRunner,
valueRunner,
andThen,
ifRun,
(+++),
(-+-),
pathTransform,
(!!!),
(>->),
(+>->),
(->-),
(+->-)
) where
import Data.Maybe
import System.Cmd
import System.Directory
import System.Exit
import Lastik.Find
import Lastik.Compile
import Lastik.Extension
import Lastik.Output
type Runner r = r -> [FilePath] -> IO ExitCode
runner :: (r -> [FilePath] -> Runner r) -> Runner r
runner f = (\c p -> (f c p) c p)
runnerPath :: ([FilePath] -> Runner r) -> Runner r
runnerPath = runner . const
runnerValue :: (r -> Runner r) -> Runner r
runnerValue = runner . (const .)
codeRunner :: ExitCode -> Runner r
codeRunner c = \_ _ -> return c
pathRunner :: ([FilePath] -> IO ExitCode) -> Runner r
pathRunner f = \_ -> f
valueRunner :: (r -> IO ExitCode) -> Runner r
valueRunner f = const . f
andThen :: (r -> [FilePath] -> IO a) -> (a -> Runner r) -> Runner r
andThen f g = \c p -> f c p >>= \k -> (g k) c p
andThen' :: (r -> [FilePath] -> IO a) -> Runner r -> Runner r
andThen' = (. const) . andThen
ifRun :: (ExitCode -> Bool) -> Runner r -> Runner r -> Runner r
ifRun z j k = \c p -> do j' <- j c p
if z j'
then k c p
else return j'
(+++) :: Runner r -> Runner r -> Runner r
(+++) = ifRun (== ExitSuccess)
(-+-) :: Runner r -> Runner r -> Runner r
(-+-) = ifRun (/= ExitSuccess)
pathTransform :: ([FilePath] -> IO [FilePath]) -> Runner t -> Runner t
pathTransform k f = \c p -> do v <- k p
f c v
pathTransform' :: (Extension e) => e -> Runner r -> Runner r
pathTransform' = pathTransform . recurse
where
recurse c p = fmap concat $ find always (constant $ extension ==? ext' c) `mapM` p
(!!!) :: (Compile c) => Runner c
(!!!) = (system .) . compile
(>->) :: (Output c, Compile c) => Runner c
(>->) = (const . mkdirectory . output) `andThen'` (!!!)
where
mkdirectory s = createDirectoryIfMissing True `mapM_` maybeToList s
(+>->) :: (Output c, Compile c, OutputReference c) => Runner c
(+>->) = \c p -> do d <- c <===> p
if null d then return ExitSuccess else (>->) (outref c) d
(->-) :: (Output c, Extension c, Compile c) => Runner c
(->-) = runnerValue (flip pathTransform' (>->))
(+->-) :: (Output r, Extension r, Compile r, OutputReference r) => Runner r
(+->-) = runnerValue (flip pathTransform' (+>->))