module Development.Shakers
( module Exports
, (<:>)
, (<->)
, (<=>)
, timestamp
, buildFile
, fakeFile
, metaFile
, mirrorDir
, parentDir
, getVar
, getFlag
, cmdArgs
, cmdArgs_
, cmdArgsDir
, cmdArgsDir_
, stack
, stack_
, stackExec
, stackExec_
, git
, git_
, schemaApply_
, m4
, aws
, rsync_
, ssh
, ssh_
, sshDir
, sshDir_
, rssh
, rssh_
, rdocker_
, docker_
, xdocker_
, convox_
, fake
, meta
, preprocess
, getHashedVersion
, hsRules
, stackRules
, stackTargetRules
, cabalRules
, dbRules
, dockerRules
, shakeMain
) where
import BasicPrelude as Exports hiding ((*>))
#if MIN_VERSION_basic_prelude(0,7,0)
import Control.Exception.Lifted
#endif
import Control.DeepSeq
import Data.Char
import Development.Shake as Exports
import Development.Shake.FilePath
import System.Directory
import Text.Regex
(<:>) :: (IsString m, Monoid m) => m -> m -> m
(<:>) = (<>) . (<> ":")
(<->) :: (IsString m, Monoid m) => m -> m -> m
(<->) = (<>) . (<> "-")
(<=>) :: (IsString m, Monoid m) => m -> m -> m
(<=>) = (<>) . (<> "=")
timestamp :: Action String
timestamp = cmdArgs "date" [ "-u", "+%Y-%m-%dT%H:%M:%SZ" ]
shakeFile :: FilePath
shakeFile = "Shakefile.hs"
buildDir :: FilePath
buildDir = ".build"
buildFile :: FilePath -> FilePath
buildFile = (buildDir </>)
fakeDir :: FilePath
fakeDir = buildFile "fake"
fakeFile :: FilePath -> FilePath
fakeFile = (fakeDir </>)
metaDir :: FilePath
metaDir = buildFile "meta"
metaFile :: FilePath -> FilePath
metaFile = (metaDir </>)
parentDir :: Action FilePath
parentDir = liftIO $ takeFileName <$> getCurrentDirectory
mirrorDir :: Action FilePath
mirrorDir = buildFile <$> parentDir
getVar :: String -> Action String
getVar k = getEnv k >>= maybe (liftIO $ throwIO $ userError $ "No env: " <> k) pure
getFlag :: String -> Action Bool
getFlag k = isJust <$> getEnv k
remoteVar :: Action String
remoteVar = getVar "REMOTE"
remoteFlag :: Action Bool
remoteFlag = getFlag "REMOTE"
rstrip :: String -> String
rstrip = reverse . dropWhile isSpace . reverse
cmdArgs :: String -> [String] -> Action String
cmdArgs c as = rstrip . fromStdout <$> cmd c as
cmdArgs_ :: String -> [String] -> Action ()
cmdArgs_ c as = unit $ cmd c as
cmdArgsDir :: FilePath -> String -> [String] -> Action String
cmdArgsDir d c as = rstrip . fromStdout <$> cmd (Cwd d) c as
cmdArgsDir_ :: FilePath -> String -> [String] -> Action ()
cmdArgsDir_ d c as = unit $ cmd (Cwd d) c as
stack :: FilePath -> [String] -> Action String
stack d = cmdArgsDir d "stack"
stack_ :: FilePath -> [String] -> Action ()
stack_ d = cmdArgsDir_ d "stack"
stackExec :: FilePath -> String -> [String] -> Action String
stackExec d cmd' as = stack d $ "exec" : cmd' : "--" : as
stackExec_ :: FilePath -> String -> [String] -> Action ()
stackExec_ d cmd' as = stack_ d $ "exec" : cmd' : "--" : as
stylish_ :: [String] -> Action ()
stylish_ = cmdArgs_ "stylish-haskell"
lint_ :: [String] -> Action ()
lint_ = cmdArgs_ "hlint"
weeder_ :: [String] -> Action ()
weeder_ = cmdArgs_ "weeder"
git :: FilePath -> [String] -> Action String
git d = cmdArgsDir d "git"
git_ :: FilePath -> [String] -> Action ()
git_ d = cmdArgsDir_ d "git"
schemaApply_ :: FilePath -> [String] -> Action ()
schemaApply_ d = cmdArgsDir_ d "schema-apply"
m4 :: [String] -> Action String
m4 = cmdArgs "m4"
tar_ :: FilePath -> [String] -> Action ()
tar_ d = cmdArgsDir_ d "tar"
aws :: [String] -> Action String
aws = cmdArgs "aws"
rsync_ :: [String] -> Action ()
rsync_ = cmdArgs_ "rsync"
ssh :: String -> [String] -> Action String
ssh h as = cmdArgs "ssh" $ h : as
ssh_ :: String -> [String] -> Action ()
ssh_ h as = cmdArgs_ "ssh" $ h : as
sshDir :: FilePath -> String -> [String] -> Action String
sshDir d h as = cmdArgs "ssh" $ h : "cd" : d : "&&" : as
sshDir_ :: FilePath -> String -> [String] -> Action ()
sshDir_ d h as = cmdArgs_ "ssh" $ h : "cd" : d : "&&" : as
rssh :: [String] -> Action String
rssh as = do
r <- remoteVar
p <- parentDir
sshDir p r as
rssh_ :: [String] -> Action ()
rssh_ as = do
r <- remoteVar
p <- parentDir
sshDir_ p r as
rdocker_ :: [String] -> Action ()
rdocker_ = rssh_ . ("docker" :)
docker_ :: [String] -> Action ()
docker_ as = do
d <- mirrorDir
cmdArgsDir_ d "docker" as
xdocker_ :: [String] -> Action ()
xdocker_ as = do
ok <- remoteFlag
bool (docker_ as) (rdocker_ as) ok
convox_ :: [String] -> Action ()
convox_ as = do
d <- mirrorDir
cmdArgsDir_ d "convox" as
gitVersion :: FilePath -> Action String
gitVersion d = git d [ "describe", "--tags", "--abbrev=0" ]
fake :: FilePath -> [FilePattern] -> String -> ([FilePath] -> Action ()) -> Rules ()
fake dir pats target act = do
meta target $
getDirectoryFiles dir pats >>=
liftIO . getHashedShakeVersion
fakeFile target %> \out -> do
need [ metaFile target ]
getDirectoryFiles dir pats >>=
act
writeFile' out mempty
phony target $
need [ fakeFile target ]
meta :: FilePath -> Action String -> Rules ()
meta target act =
metaFile target %> \out -> do
alwaysRerun
content <- act
writeFileChanged out content
preprocess :: FilePattern -> FilePath -> Action [(String, String)] -> Rules ()
preprocess target file macros =
target %> \out -> do
alwaysRerun
let f k v = "-D" <> k <=> v
macros' <- macros
content <- m4 $ file : (uncurry f <$> macros')
writeFileChanged out content
getHashedVersion :: FilePath -> [FilePattern] -> Action String
getHashedVersion dir pats = do
files <- getDirectoryFiles dir pats
liftIO $ getHashedShakeVersion $ (dir </>) <$> files
shakeRules :: Rules ()
shakeRules =
phony "clear" $
removeFilesAfter buildDir [ "//*" ]
hsRules :: FilePath -> [FilePattern] -> Rules ()
hsRules dir pats = do
fake dir pats "format" $ \files -> do
need [ ".stylish-haskell.yaml" ]
stylish_ $ [ "-c", ".stylish-haskell.yaml", "-i" ] <> files
fake dir pats "lint" $ \files ->
lint_ files
fake dir pats "weed" $ const $
weeder_ [ dir, "--build" ]
stackRules :: FilePath -> [FilePattern] -> Rules ()
stackRules dir pats = do
fake dir pats "build" $ const $
stack_ dir [ "build", "--fast" ]
fake dir pats "build-error" $ const $
stack_ dir [ "build", "--fast", "--ghc-options=-Werror" ]
fake dir pats "build-tests" $ const $
stack_ dir [ "build", "--fast", "--test", "--no-run-tests" ]
fake dir pats "build-tests-error" $ const $
stack_ dir [ "build", "--fast", "--test", "--no-run-tests", "--ghc-options=-Werror" ]
fake dir pats "install" $ const $
stack_ dir [ "build", "--fast", "--copy-bins" ]
phony "tests" $
stack_ dir [ "build", "--fast", "--test" ]
phony "tests-error" $
stack_ dir [ "build", "--fast", "--test", "--ghc-options=-Werror" ]
phony "repl" $
stack_ dir [ "ghci" ]
phony "repl-tests" $
stack_ dir [ "ghci", "--test" ]
phony "docs" $
stack_ dir [ "haddock" ]
phony "clean" $ do
need [ "clear" ]
stack_ dir [ "clean" ]
phony "clobber" $ do
need [ "clear" ]
removeFilesAfter dir [ "//*.stack-work" ]
stackTargetRules :: FilePath -> String -> [FilePattern] -> Rules ()
stackTargetRules dir target pats = do
fake dir pats ("build:" <> target) $ const $
stack_ dir [ "build", target, "--fast" ]
fake dir pats ("build-error:" <> target) $ const $
stack_ dir [ "build", target, "--fast", "--ghc-options=-Werror" ]
fake dir pats ("build-tests:" <> target) $ const $
stack_ dir [ "build", target, "--fast", "--test", "--no-run-tests" ]
fake dir pats ("build-tests-error:" <> target) $ const $
stack_ dir [ "build", target, "--fast", "--test", "--no-run-tests", "--ghc-options=-Werror" ]
fake dir pats ("install:" <> target) $ const $
stack_ dir [ "build", target, "--fast", "--copy-bins" ]
phony ("tests:" <> target) $
stack_ dir [ "build", target, "--fast", "--test" ]
phony ("tests-error:" <> target) $
stack_ dir [ "build", target, "--fast", "--test", "--ghc-options=-Werror" ]
phony ("ghci:" <> target) $
stack_ dir [ "ghci", target ]
phony ("ghci-tests:" <> target) $
stack_ dir [ "ghci", target, "--test" ]
cabalRules :: FilePath -> FilePath -> Rules ()
cabalRules dir file = do
meta "cabalVersion" $ gitVersion dir
preprocess file (file <.> "m4") $ do
need [ metaFile "cabalVersion" ]
version <- dropWhile (not . isDigit) <$> gitVersion dir
pure [ ("VERSION", version) ]
phony "publish" $ do
need [ file ]
stack_ dir [ "upload", dir, "--no-signature" ]
phony "publish-lower" $ do
need [file, metaFile "cabalVersion" ]
version <- dropWhile (not . isDigit) <$> gitVersion dir
yaml <- fromMaybe "stack.yaml" <$> getEnv "STACK_YAML"
dist <- stack dir [ "path", "--dist-dir" ]
stack_ dir [ "sdist", dir, "--pvp-bounds", "lower" ]
let pkg = dropExtension file
hkg = pkg <-> version
[sdist] <- getDirectoryFiles dist [ hkg <.> "tar.gz" ]
withTempDir $ \d -> do
tar_ dist [ "xzf", sdist, "-C", d ]
let e = d </> hkg
f = e </> file
contents <- readFile' f
let contents' = subRegex (mkRegex $ pkg <> " >=" <> version) contents pkg
contents' `deepseq` writeFile' f contents'
copyFile' yaml $ e </> yaml
stack_ e [ "upload", e, "--no-signature" ]
dbRules :: FilePath -> Rules ()
dbRules dir =
phony "schema:apply" $
schemaApply_ dir [ "--dir", "schema/migrations" ]
dockerRules :: FilePath -> [FilePattern] -> Rules ()
dockerRules dir pats = do
phony "mirror" $ do
dir' <- mirrorDir
liftIO $ removeFiles dir' [ "//*" ]
files <- getDirectoryFiles dir pats
forM_ files $ \file ->
liftIO $ do
createDirectoryIfMissing True $ dropFileName (dir' </> file)
copyFile file (dir' </> file)
phony "mirror-remote" $ do
need [ "mirror" ]
r <- remoteVar
p <- parentDir
rsync_ [ "-Laz", "--delete", buildFile p <> "/", r <:> p <> "/" ]
phony "mirrored" $ do
ok <- remoteFlag
need [ bool "mirror" "mirror-remote" ok ]
phony "docker:login" $ do
login <- aws [ "ecr", "get-login", "--no-include-email", "--region", "us-west-2" ]
unit $ cmd login
phony "docker:login-remote" $ do
login <- aws [ "ecr", "get-login", "--no-include-email", "--region", "us-west-2" ]
rssh_ [ login ]
phony "docker:logined" $ do
ok <- remoteFlag
need [ bool "docker:login" "docker:login-remote" ok ]
shakeMain :: Rules () -> IO ()
shakeMain act = do
version <- getHashedShakeVersion [ shakeFile ]
shakeArgs shakeOptions { shakeFiles = buildDir, shakeVersion = version, shakeThreads = 0 } $ do
shakeRules
act