{-# LANGUAGE ScopedTypeVariables #-}

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

import           Control.Monad              (filterM, forM_)
import           Data.Either                (fromRight)
import           Data.Maybe                 (fromMaybe)
import           Data.Semigroup             (Semigroup (..))
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
    let home = "/usr/local/lib/ats2-postiats-0.3.8"
    let atsArgs = [EchoStderr False, AddEnv "PATSHOME" home]
        patsc = "patsopt" -- home ++ "/bin/patsopt"
    command atsArgs patsc ["--output", out, "-dd", sourceFile, "-cc"]

atsBin :: [String] -> String -> String -> Rules ()
atsBin libs sourceFile out =
    out %> \_ -> do
        need [sourceFile]
        let home = "/usr/local/lib/ats2-postiats-0.3.8"
        cmd_ ["mkdir", "-p", dropDirectory1 out]
        let toLibs = fmap ("-l" <>)
        command [EchoStderr False, AddEnv "PATSHOME" home] "patscc" ([sourceFile, "-atsccomp", "gcc -flto -I/usr/local/lib/ats2-postiats-0.3.8/ccomp/runtime/ -I/usr/local/lib/ats2-postiats-0.3.8/", "-DATS_MEMALLOC_LIBC", "-o", out, "-cleanaft", "-O2", "-mtune=native"] <> toLibs libs)

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 :: FilePath -> Rules ()
cgen dir = do

    atsDeps

    "//*.c" %> \out -> do
        let sourceFile = dir ++ "/" ++ (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 ()