{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeSynonymInstances #-}

module Development.Shake.ATS ( -- * Shake Rules
                               cgen
                             , cgenPretty
                             , cleanATS
                             , atsBin
                             -- * Actions
                             , patsHome
                             -- Types
                             , Version (..)
                             ) 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))

newtype Version = Version [Integer]

instance Show Version where
    show (Version [])     = ""
    show (Version [x])    = show x
    show (Version (x:xs)) = show x ++ "." ++ show (Version xs)

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 => Version -> String -> String -> Action r
atsCommand version sourceFile out = do
    let home = "/usr/local/lib/ats2-postiats-" ++ show version
    let atsArgs = [EchoStderr False, AddEnv "PATSHOME" home]
        patsc = "patsopt"
    command atsArgs patsc ["--output", out, "-dd", sourceFile, "-cc"]

gcFlag :: Bool -> String
gcFlag False = "-DATS_MEMALLOC_LIBC"
gcFlag True  = "-DATS_MEMALLOC_GCBDW"

-- TODO musl?
atsBin :: Version -> Bool -> [String] -> String -> String -> Rules ()
atsBin v gc libs sourceFile out =
    out %> \_ -> do
        need [sourceFile]
        let home = "/usr/local/lib/ats2-postiats-" ++ show v
        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/", gcFlag gc, "-o", out, "-cleanaft", "-O2", "-mtune=native", "-flto"] <> 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 :: Version -> FilePath -> Rules ()
cgen version dir = do

    atsDeps

    "//*.c" %> \out -> do
        let sourceFile = dir ++ "/" ++ (dropDirectory1 out -<.> "dats")
        need [sourceFile]
        atsCommand version 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 :: Version -> Rules ()
cgenPretty version = do

    atsDeps

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

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