{-# LANGUAGE ScopedTypeVariables #-}

module Development.Shake.ATS ( cgen
                             , cgenPretty
                             , cleanATS
                             ) where

import           Control.Monad              (filterM)
import           Data.Either                (fromRight)
import           Development.Shake
import           Development.Shake.FilePath
import           Language.ATS
import           System.Exit                (ExitCode (ExitSuccess))

atsCommand :: CmdResult r => String -> String -> Action r
atsCommand sourceFile out = command atsArgs "patsopt" ["--output", out, "-dd", sourceFile, "-cc"]
    where atsArgs = [EchoStderr False, AddEnv "PATSHOME" "/usr/local/lib/ats2-postiats-0.3.8"]

cleanATS :: Rules ()
cleanATS =

    "clean" ~> do
        cmd_ ["sn", "c"]
        removeFilesAfter "." ["//*.c", "//tags"]
        removeFilesAfter ".shake" ["//*"]
        removeFilesAfter "ats-deps" ["//*"]

-- | This provides rules for generating C code from ATS source files in the
-- @ats-src@ directory.
cgen :: Rules ()
cgen = do

    atsDeps

    "//*.c" %> \out -> do
        let sourceFile = "ats-src/" ++ (dropDirectory1 out -<.> "dats")
        need [sourceFile]
        atsCommand sourceFile out

atsDeps :: Rules ()
atsDeps =

    ["//*.dats", "//*.sats"] |%> \out -> do
        contents <- liftIO $ readFile out
        let ats = fromRight mempty . parseATS . lexATS $ contents
        deps <- filterM doesFileExist $ getDependencies ats
        need deps

-- | This uses @pats-filter@ to prettify the errors.
cgenPretty :: Rules ()
cgenPretty = do

    atsDeps

    "//*.c" %> \out -> do

        let sourceFile = "ats-src/" ++ (dropDirectory1 out -<.> "dats")
        need [sourceFile]
        (Exit c, Stderr err) :: (Exit, Stderr String) <- atsCommand sourceFile out
        cmd_ [Stdin err] Shell "pats-filter"
        if c /= ExitSuccess
            then error "patscc failure"
            else pure ()