shake-ats 1.1.0.2 → 1.2.0.0

raw patch · 4 files changed

+159/−116 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• shake-ats.cabal +3/−1
• src/Development/Shake/ATS.hs +43/−115
• src/Development/Shake/ATS/Rules.hs +62/−0
• src/Development/Shake/ATS/Type.hs +51/−0

@@ -1,5 +1,5 @@ name:                shake-ats-version:             1.1.0.2+version:             1.2.0.0 synopsis:            Utilities for building ATS projects with shake description:         Various helper functions for building [ATS](http://www.ats-lang.org/) with the [shake](http://shakebuild.com/) library homepage:            https://github.com/vmchale/shake-ats#readme@@ -22,6 +22,8 @@ library   hs-source-dirs:      src   exposed-modules:     Development.Shake.ATS+  other-modules:       Development.Shake.ATS.Type+                     , Development.Shake.ATS.Rules   build-depends:       base >= 4.7 && < 5                      , language-ats                      , shake-ext >= 2.1.0.0

@@ -1,7 +1,6 @@ {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}-{-# LANGUAGE DeriveAnyClass       #-}-{-# LANGUAGE DeriveGeneric        #-} {-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE RecordWildCards      #-} {-# LANGUAGE ScopedTypeVariables  #-} {-# LANGUAGE TypeSynonymInstances #-} @@ -11,7 +10,7 @@                              , cleanATS                              , atsBin                              , atsLex-                             , ghcExport+                             , cabalExport                              -- * Actions                              , patsHome                              -- * Helper functions@@ -19,88 +18,36 @@                              -- Types                              , Version (..)                              , ForeignCabal (..)+                             , BinaryTarget (..)                              ) where  import           Control.Monad import           Control.Monad.IO.Class-import           Data.Binary                (Binary (..))-import           Data.Bool                  (bool)-import           Data.Either                (fromRight)-import           Data.List                  (intercalate)-import           Data.Maybe                 (fromMaybe)-import           Data.Semigroup             (Semigroup (..))-import qualified Data.Text.Lazy             as TL-import           Development.Shake          hiding (doesDirectoryExist)-import           Development.Shake.Cabal+import           Data.Bool                   (bool)+import           Data.Either                 (fromRight)+import           Data.List                   (intercalate)+import           Data.Maybe                  (fromMaybe)+import           Data.Semigroup              (Semigroup (..))+import qualified Data.Text.Lazy              as TL+import           Development.Shake+import           Development.Shake.ATS.Rules+import           Development.Shake.ATS.Type import           Development.Shake.FilePath-import           GHC.Generics               (Generic) import           Language.ATS import           Language.ATS.Generate-import           System.Directory           (copyFile, createDirectoryIfMissing, doesDirectoryExist, listDirectory)-import           System.Exit                (ExitCode (ExitSuccess))--data ForeignCabal = ForeignCabal { cabalFile  :: TL.Text -- ^ @.cabal@ file associated with the library-                                 , objectFile :: TL.Text -- ^ Object file to be generated-                                 }--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--newtype Version = Version [Integer]-    deriving (Eq, Generic, Binary)--instance Show Version where-    show (Version is) = intercalate "." (show <$> is)+import           System.Directory            (copyFile, createDirectoryIfMissing)+import           System.Exit                 (ExitCode (ExitSuccess)) -genATS :: FilePath -> FilePath -> Rules ()+-- | Given a plain Haskell source file, generate a @.sats@ file containing+-- analogous types.+genATS :: FilePath -- ^ Haskell source+       -> FilePath -- ^ @.sats@ file to generate+       -> Rules () genATS src target =     target %> \out -> liftIO $ do         createDirectoryIfMissing True (takeDirectory out)         genATSTypes src target --- dumb heuristic:--- go to dist-newstyle/build--- find 'build' subdir--- file is there--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)---- cabal deps-ghcExport :: String -> Rules ()-ghcExport m =-    [ m ++ ".o" ] &%> \[out] -> do-        let fn = out -<.> "hs"-        let dir = takeDirectory out-        need [ fn ]-        command [Cwd dir] "ghc" ["-c", "-O", takeFileName fn ]- -- | The directory @~/.atspkg@ pkgHome :: Action String pkgHome = fromMaybe "/usr/local/" <$> mh@@ -110,7 +57,12 @@ patsHome :: Version -> Action String patsHome v = fmap (++ (show v ++ "/")) pkgHome -atsCommand :: CmdResult r => Version -> Version -> String -> String -> Action r+-- | Run @patsopt@ given information about+atsCommand :: CmdResult r => Version -- ^ Compiler version+                          -> Version -- ^ Standard library version+                          -> String -- ^ Source file+                          -> String -- ^ C code to be generated+                          -> Action r atsCommand v v' sourceFile out = do     h <- patsHome v'     let home = h ++ "lib/ats2-postiats-" ++ show v@@ -123,7 +75,7 @@ gcFlag True  = "-DATS_MEMALLOC_GCBDW"  -- Copy source files to the appropriate place. This is necessary because--- @#include@s in ATS are fucked up.+-- @#include@s in ATS are weird. copySources :: Version -> Version -> [FilePath] -> Action () copySources v v' sources =     forM_ sources $ \dep -> do@@ -132,6 +84,7 @@         liftIO $ createDirectoryIfMissing True (home ++ "/" ++ takeDirectory dep)         liftIO $ copyFile dep (home ++ "/" ++ dep) +-- This is the @$PATSHOMELOCS@ variable to be passed to the shell. patsHomeLocs :: Int -> String patsHomeLocs n = intercalate ":" $ (<> ".atspkg/contrib") . ("./" <>) <$> g     where g = [ join $ replicate i "../" | i <- [1..n] ]@@ -146,34 +99,25 @@     hsExtra = bool ["--make", "-odir", ".atspkg", "-no-hs-main", "-package-db", "~/.cabal/store/ghc-8.2.2/package.db/"] mempty noHs     noHs = null fc -atsBin :: String -- ^ C compiler we should use-       -> [String] -- ^ Flags to pass to the C compiler-       -> Version -- ^ Library version-       -> Version -- ^ Compiler version-       -> Bool -- ^ Whether to use the garbage collector-       -> [String] -- ^ A list of libraries against which to link-       -> String -- ^ Source file-       -> [ForeignCabal] -- ^ Cabal-based Haskell libraries-       -> [(String, String)] -- ^ Files to be run through @hs2ats@.-       -> String -- ^ Binary target-       -> Rules ()-atsBin cc cFlags v v' gc libs sourceFile hs atg out = do+-- TODO ideally cache C files and use `gcc` on them?+atsBin :: BinaryTarget -> Rules ()+atsBin BinaryTarget{..} = do -    unless (null atg) $-        mapM_ (uncurry genATS) atg+    unless (null genTargets) $+        mapM_ (uncurry genATS) genTargets -    unless (null hs) $-        mapM_ cabalExport hs+    unless (null hsLibs) $+        mapM_ cabalExport hsLibs -    out %> \_ -> do-        h <- patsHome v'+    binTarget %> \_ -> do+        h <- patsHome compilerVer         h' <- pkgHome-        let home = h ++ "lib/ats2-postiats-" ++ show v-        sources <- transitiveDeps (snd <$> atg) [sourceFile]-        need (sources ++ (TL.unpack . objectFile <$> hs))-        copySources v v' sources+        let home = h ++ "lib/ats2-postiats-" ++ show libVersion+        sources <- transitiveDeps (snd <$> genTargets) [src]+        need (sources ++ (TL.unpack . objectFile <$> hsLibs))+        copySources libVersion compilerVer sources -        cmd_ ["mkdir", "-p", dropDirectory1 out]+        cmd_ ["mkdir", "-p", dropDirectory1 binTarget]         path <- fromMaybe "" <$> getEnv "PATH"         let toLibs = fmap ("-l" <>)         let libs' = ("atslib" :) $ bool libs ("gc" : libs) gc@@ -181,26 +125,10 @@             [EchoStderr False, AddEnv "PATSHOME" home, AddEnv "PATH" (home ++ "/bin:" ++ path), AddEnv "PATSHOMELOCS" $ patsHomeLocs 5]             (home ++ "/bin/patscc")             (mconcat-                [ [sourceFile, "-atsccomp", cc ++ " -I" ++ h ++ "/ccomp/runtime/ -I" ++ h ++ " -L" ++ h' ++ "/lib" ++ " -L" ++ home ++ "/ccomp/atslib/lib", "-o", out, "-cleanaft"]-                , makeCFlags cFlags hs gc+                [ [src, "-atsccomp", cc ++ " -I" ++ h ++ "/ccomp/runtime/ -I" ++ h ++ " -L" ++ h' ++ "/lib" ++ " -L" ++ home ++ "/ccomp/atslib/lib", "-o", binTarget, "-cleanaft"]+                , makeCFlags cFlags hsLibs gc                 , toLibs libs'                 ])---- | Build a @.lats@ file.-atsLex :: Rules ()-atsLex =-    "*.dats" %> \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" ["//*"]  handleSource :: Version -> Version -> FilePath -> Action () handleSource v v' sourceFile = do

@@ -0,0 +1,62 @@+module Development.Shake.ATS.Rules ( atsLex+                                   , cleanATS+                                   , cabalExport+                                   , getSubdirs+                                   ) 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           System.Directory           (copyFile, doesDirectoryExist, listDirectory)++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)++-- | Build a @.lats@ file.+atsLex :: Rules ()+atsLex =+    "*.dats" %> \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" ["//*"]

@@ -0,0 +1,51 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric  #-}++-- gcc ats-src/libnumbertheory.o -shared -o ats-src/libnumbertheory.so+-- gcc number-theory-ffi_dats.c -c -fPIC -o ats-src/libnumbertheory.o -IATS2-Postiats-include-0.3.8/ -IATS2-Postiats-include-0.3.8/ccomp/runtime/++module Development.Shake.ATS.Type ( ForeignCabal (..)+                                  , Version (..)+                                  , BinaryTarget (..)+                                  ) where++import           Data.Binary    (Binary (..))+import           Data.List      (intercalate)+import qualified Data.Text.Lazy as TL+import           GHC.Generics   (Generic)++-- We should have four build types:+--+-- 1. Static library+--+-- 2. Dynamic library+--+-- 3. Binary+--+-- 4. C sources+--+-- AND variations on these where a Haskell library is to be built+-- Or a C library.++data BinaryTarget = BinaryTarget { cc          :: String -- ^ C compiler to be used.+                                 , cFlags      :: [String] -- ^ Flags to be passed to the C compiler+                                 , libVersion  :: Version+                                 , compilerVer :: Version+                                 , gc          :: Bool -- ^ Whether to configure build for use with the garbage collector.+                                 , libs        :: [String] -- ^ Libraries against which to link+                                 , src         :: String -- ^ Source file for binary.+                                 , hsLibs      :: [ForeignCabal] -- ^ Cabal-based Haskell libraries+                                 , genTargets  :: [(String, String)] -- ^ Files to be run through @hs2ats@.+                                 , binTarget   :: String -- ^ Binary target+                                 }++-- | Data type containing information about Haskell components of a build.+data ForeignCabal = ForeignCabal { cabalFile  :: TL.Text -- ^ @.cabal@ file associated with the library+                                 , objectFile :: TL.Text -- ^ Object file to be generated+                                 }++newtype Version = Version [Integer]+    deriving (Eq, Generic, Binary)++instance Show Version where+    show (Version is) = intercalate "." (show <$> is)