module Development.Shake.ATS.Rules ( atsLex
, cleanATS
, cabalExport
, getSubdirs
, genATS
) where
import Control.Monad
import Data.Semigroup (Semigroup (..))
import qualified Data.Text.Lazy as TL
import Development.Shake hiding (doesDirectoryExist)
import Development.Shake.ATS.Type hiding (BinaryTarget (..))
import Development.Shake.Cabal
import Development.Shake.FilePath
import Language.ATS.Generate
import System.Directory (copyFile, createDirectoryIfMissing, doesDirectoryExist, listDirectory)
genATS :: FilePath
-> FilePath
-> Rules ()
genATS src target =
target %> \out -> liftIO $ do
createDirectoryIfMissing True (takeDirectory out)
genATSTypes src out
getSubdirs :: FilePath -> IO [FilePath]
getSubdirs p = do
ds <- listDirectory p
case ds of
[] -> pure []
xs -> do
ds' <- filterM doesDirectoryExist (((p <> "/") <>) <$> xs)
ss <- mapM getSubdirs ds'
pure $ ds' <> join ss
cabalExport :: ForeignCabal -> Rules ()
cabalExport (ForeignCabal cf' obf') = do
let cf = TL.unpack cf'
obf = TL.unpack obf'
obfDir = takeDirectory (obf -<.> "hs")
trDeps <- liftIO $ getCabalDeps cf
obf %> \out -> do
need (cf : fmap ((obfDir <> "/") <>) trDeps)
command_ [Cwd obfDir] "cabal" ["new-build"]
let subdir = takeDirectory cf ++ "/"
endsBuild = (== "build") . last . splitPath
dir <- filter endsBuild <$> liftIO (getSubdirs $ subdir ++ "dist-newstyle/build")
let obj = head dir ++ "/" ++ takeFileName obf
liftIO $ copyFile obj out
let hdr = dropExtension obj ++ "_stub.h"
liftIO $ copyFile hdr (takeDirectory out ++ "/" ++ takeFileName hdr)
atsLex :: FilePattern -> Rules ()
atsLex fp =
fp %> \out -> do
lats <- liftIO $ readFile (out -<.> "lats")
(Stdout contents) <- command [Stdin lats] "atslex" []
liftIO $ writeFile out contents
cleanATS :: Rules ()
cleanATS = "clean" ~> do
removeFilesAfter "." ["//*.c", "//tags"]
removeFilesAfter ".atspkg" ["//*"]
removeFilesAfter "ats-deps" ["//*"]