{-# LANGUAGE ScopedTypeVariables #-}

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

import           Control.Monad              (filterM, forM_)
import           Data.Either                (fromRight)
import           Data.Maybe                 (fromMaybe)
import           Development.Shake
import           Development.Shake.FilePath
import           Language.ATS
import           System.Directory           (copyFile)
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
    home <- patsHome
    let atsArgs = [EchoStderr False, AddEnv "PATSHOME" home]
        patsc = home ++ "/bin/patsopt"
    command atsArgs patsc ["--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
        home <- patsHome
        forM_ deps $ \dep ->
            liftIO $ copyFile dep (home ++ "/" ++ dep)

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