diff --git a/cabal.project.local b/cabal.project.local deleted file mode 100644 --- a/cabal.project.local +++ /dev/null @@ -1,10 +0,0 @@ -constraints: shake-ext +development -with-compiler: ghc-8.2.2 -tests: True -documentation: True -haddock-hoogle: True -haddock-internal: True - -program-options - happy-options: -gcsa - alex-options: -g diff --git a/shake-ext.cabal b/shake-ext.cabal --- a/shake-ext.cabal +++ b/shake-ext.cabal @@ -1,5 +1,5 @@ name: shake-ext -version: 1.3.0.2 +version: 1.4.0.0 synopsis: Helper functions for linting with shake description: This package provides several linters out of the box, as well as functionality for building ATS source files with [shake](http://shakebuild.com/). homepage: https://hub.darcs.net/vmchale/shake-ext @@ -11,7 +11,6 @@ category: Development build-type: Simple extra-doc-files: README.md -extra-source-files: cabal.project.local cabal-version: 1.18 Flag development { @@ -24,8 +23,6 @@ hs-source-dirs: src exposed-modules: Development.Shake.FileDetect , Development.Shake.Linters - , Development.Shake.ATS - , Development.Shake.C , Development.Shake.Man build-depends: base >= 4.10 && < 5 , shake @@ -43,4 +40,4 @@ source-repository head type: darcs - location: https://hub.darcs.net/vmchale/shake-ext + location: https://hub.darcs.net/vmchale/ats diff --git a/src/Development/Shake/ATS.hs b/src/Development/Shake/ATS.hs deleted file mode 100644 --- a/src/Development/Shake/ATS.hs +++ /dev/null @@ -1,158 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeSynonymInstances #-} - -module Development.Shake.ATS ( -- * Shake Rules - cgen - , cgenPretty - , cleanATS - , atsBin - , atsLex - -- * Actions - , patsHome - -- Types - , Version (..) - ) where - -import Control.Monad -import Control.Monad.IO.Class -import Data.Either (fromRight) -import Data.Maybe (fromMaybe) -import Data.Semigroup (Semigroup (..)) -import qualified Data.Text.Lazy as TL -import Development.Shake -import Development.Shake.FilePath -import Language.ATS -import System.Directory (copyFile, createDirectoryIfMissing) -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 :: Version -> Action String -patsHome v = fromMaybe "/usr/local/lib/ats2-postiats-0.3.9" <$> mh - where mh = fmap (++ ("/.atspkg/" ++ show v ++ "/")) <$> getEnv "HOME" - -atsCommand :: CmdResult r => Version -> Version -> String -> String -> Action r -atsCommand v v' sourceFile out = do - h <- patsHome v' - let home = h ++ "lib/ats2-postiats-" ++ show v - 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" - --- Copy source files to the appropriate place. This is necessary because --- @#include@s in ATS are fucked up. -copySources :: Version -> Version -> [FilePath] -> Action () -copySources v v' sources = - forM_ sources $ \dep -> do - h <- patsHome v' - let home = h ++ "lib/ats2-postiats-" ++ show v - liftIO $ createDirectoryIfMissing True (home ++ "/" ++ takeDirectory dep) - liftIO $ copyFile dep (home ++ "/" ++ dep) - --- TODO musl? -atsBin :: 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 - -> String -- ^ Binary target - -> Rules () -atsBin v v' gc libs sourceFile out = - - out %> \_ -> do - sources <- transitiveDeps [sourceFile] - h <- patsHome v' - let home = h ++ "lib/ats2-postiats-" ++ show v - need sources - copySources v v' sources - cmd_ ["mkdir", "-p", dropDirectory1 out] - path <- fromMaybe "" <$> getEnv "PATH" - let toLibs = fmap ("-l" <>) - command - [EchoStderr False, AddEnv "PATSHOME" home, AddEnv "PATH" (home ++ "/bin:" ++ path), AddEnv "PATSHOMELOCS" "./.atspkg/contrib"] - (home ++ "/bin/patscc") - ([sourceFile, "-atsccomp", "gcc -flto -I" ++ h ++ "/ccomp/runtime/ -I" ++ h, gcFlag gc, "-o", out, "-cleanaft", "-O2", "-mtune=native", "-flto"] <> 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 - sources <- transitiveDeps [sourceFile] - need sources - copySources v v' sources - --- | This provides rules for generating C code from ATS source files in the --- @ats-src@ directory. -cgen :: Version -- ^ Library version - -> Version -- ^ Compiler version - -> FilePath -- ^ Directory for the generated C code - -> Rules () -cgen v v' dir = - - "//*.c" %> \out -> do - let sourceFile = dir ++ "/" ++ (dropDirectory1 out -<.> "dats") - handleSource v v' sourceFile - atsCommand v v' sourceFile out - -fixDir :: FilePath -> String -> String -fixDir p = - TL.unpack - . TL.replace (TL.pack "./") (TL.pack $ p ++ "/") - . TL.replace (TL.pack "../") (TL.pack $ joinPath (init $ splitPath p) ++ "/") - . TL.replace (TL.pack "$PATSHOMELOCS") (TL.pack ".atspkg/contrib") - . TL.replace (TL.pack "\\\n") mempty - . TL.pack - -trim :: String -> String -trim = init . drop 1 - -transitiveDeps :: [FilePath] -> Action [FilePath] -transitiveDeps [] = pure [] -transitiveDeps ps = fmap join $ forM ps $ \p -> do - contents <- liftIO $ readFile p - let ats = fromRight mempty . parseATS . lexATS $ contents - let dir = takeDirectory p - deps <- filterM doesFileExist $ fixDir dir . trim <$> getDependencies ats - deps' <- transitiveDeps deps - pure $ (p:deps) ++ deps' - --- | This uses @pats-filter@ to prettify the errors. -cgenPretty :: Version -- ^ Library version - -> Version -- ^ Compiler version - -> FilePath - -> Rules () -cgenPretty v v' dir = - - "//*.c" %> \out -> do - - let sourceFile = dir ++ "/" ++ (dropDirectory1 out -<.> "dats") - handleSource v v' sourceFile - (Exit c, Stderr err) :: (Exit, Stderr String) <- atsCommand v v' sourceFile out - cmd_ [Stdin err] Shell "pats-filter" - if c /= ExitSuccess - then error "patscc failure" - else pure () diff --git a/src/Development/Shake/C.hs b/src/Development/Shake/C.hs deleted file mode 100644 --- a/src/Development/Shake/C.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Development.Shake.C ( cBinary - ) where - -import Development.Shake -import Development.Shake.ATS - --- | Build a C binary, including relevant ATS-related paths. -cBinary :: Version -> FilePath -> FilePath -> Action () -cBinary v src target = do - need [src] - home <- patsHome v - let atsArgs = [EchoStderr False, AddEnv "PATSHOME" home] - command atsArgs "gcc" [src, "-flto", "-I" ++ home ++ "/ccomp/runtime", "-I" ++ home, "-o", target, "-O2"] - -- cmd ["strip", out] diff --git a/src/Development/Shake/FileDetect.hs b/src/Development/Shake/FileDetect.hs --- a/src/Development/Shake/FileDetect.hs +++ b/src/Development/Shake/FileDetect.hs @@ -2,6 +2,7 @@ ( getAts , getSats , getHats + , getCats , getYml , getToml , getHs @@ -45,6 +46,9 @@ getAllDir :: FilePath -> [String] -> Action [FilePath] getAllDir dir ss = getDirectoryFiles "" (((dir ++ "//*.") ++) <$> ss) +getCats :: Action [FilePath] +getCats = get "cats" + getSats :: Action [FilePath] getSats = get "sats" @@ -54,5 +58,6 @@ getHats :: Action [FilePath] getHats = get "hats" +-- | Get files ending in @.sats@ or @.dats@. getAts :: Action [FilePath] getAts = (<>) <$> getDats <*> getSats diff --git a/src/Development/Shake/Linters.hs b/src/Development/Shake/Linters.hs --- a/src/Development/Shake/Linters.hs +++ b/src/Development/Shake/Linters.hs @@ -5,9 +5,11 @@ , hlint , shellcheck , ghc + , dhall + -- * Formatters + , clangFormat , atsfmt , stylishHaskell - , dhall , module Development.Shake.FileDetect ) where @@ -28,6 +30,7 @@ trim = join fmap f where f = reverse . dropWhile isSpace +-- | Check a given formatter is idempotent. checkIdempotent :: String -> FilePath -> Action () checkIdempotent s p = do contents <- liftIO $ readFile p @@ -39,6 +42,9 @@ atsfmt :: [FilePath] -> Action () atsfmt = mapM_ (checkIdempotent "atsfmt") + +clangFormat :: [FilePath] -> Action () +clangFormat = mapM_ (checkIdempotent "clang-format") checkFiles :: String -> [FilePath] -> Action () checkFiles str = mapM_ (cmd_ . ((str ++ " ") ++))