{-# LANGUAGE ScopedTypeVariables #-}

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

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

patsHome :: Action String
patsHome = fromMaybe "/usr/local/lib/ats2-postiats-0.3.8" <$> mh
    where mh = fmap (++ "/.atspkg/compiler/") <$> getEnv "HOME"

-- TODO install the whole compiler?
atsCommand :: CmdResult r => String -> String -> Action r
atsCommand sourceFile out = do
    let atsArgs = [EchoStderr False, AddEnv "PATSHOME" "/usr/local/lib/ats2-postiats-0.3.8"]
    command atsArgs "patsopt" ["--output", out, "-dd", sourceFile, "-cc"]

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
        {- forM_ deps $ \dep ->  -}
            {- copyFile dep (patsHome ++ "/" ++  -}

-- | 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 ()