ats-pkg-3.2.5.3: app/Main.hs
{-# LANGUAGE OverloadedStrings #-}
module Main ( main
) where
import Control.Concurrent.ParallelIO.Global
import qualified Data.Text.Lazy as TL
import Data.Version hiding (Version (..))
import Development.Shake.ATS
import Development.Shake.FilePath
import Distribution.CommandLine
import Language.ATS.Package
import Language.ATS.Package.Dhall
import Language.ATS.Package.Upgrade
import Lens.Micro
import Options.Applicative
import Paths_ats_pkg
import Quaalude hiding (command, pack)
import System.IO.Temp (withSystemTempDirectory)
-- TODO command to list available packages.
wrapper :: ParserInfo Command
wrapper = info (helper <*> versionInfo <*> command')
(fullDesc
<> progDesc "The atspkg build tool for ATS-Postiats."
<> header "atspkg - a build tool for ATS\nsee 'man atspkg' for more detailed help")
versionInfo :: Parser (a -> a)
versionInfo = infoOption ("atspkg version: " ++ showVersion atspkgVersion) (short 'V' <> long "version" <> help "Show version")
data Command = Install { _archTarget :: Maybe String
, _atspkgArg :: Maybe String
}
| Build { _targets :: [String]
, _archTarget :: Maybe String
, _atspkgArg :: Maybe String
, _rebuildAll :: Bool
, _verbosity :: Int
, _lint :: Bool
, _prof :: Bool
}
| Clean
| Test { _targets :: [String]
, _atspkgArg :: Maybe String
, _rebuildAll :: Bool
, _verbosity :: Int
, _lint :: Bool
, _prof :: Bool
}
| Fetch { _url :: String
, _atspkgArg :: Maybe String
, _verbosity :: Int
}
| Nuke
| Upgrade
| Valgrind { _targets :: [String]
, _atspkgArg :: Maybe String
}
| Run { _targets :: [String]
, _atspkgArg :: Maybe String
, _rebuildAll :: Bool
, _verbosity :: Int
, _lint :: Bool
, _prof :: Bool
}
| Check { _filePath :: String, _details :: Bool }
| CheckSet { _filePath :: String, _details :: Bool }
| List
| Setup
command' :: Parser Command
command' = hsubparser
(command "install" (info install (progDesc "Install all binaries to $HOME/.local/bin"))
<> command "clean" (info (pure Clean) (progDesc "Clean current project directory"))
<> command "remote" (info fetch (progDesc "Fetch and install a binary package"))
<> command "build" (info build' (progDesc "Build current package targets"))
<> command "test" (info test' (progDesc "Test current package"))
<> command "nuke" (info (pure Nuke) (progDesc "Uninstall all globally installed libraries"))
<> command "upgrade" (info (pure Upgrade) (progDesc "Upgrade to the latest version of atspkg"))
<> command "valgrind" (info valgrind (progDesc "Run generated binaries through valgrind"))
<> command "run" (info run' (progDesc "Run generated binaries"))
<> command "check" (info check' (progDesc "Check that a pkg.dhall file is well-typed."))
<> command "check-set" (info checkSet (progDesc "Audit a package set to ensure it is well-typed."))
<> command "list" (info (pure List) (progDesc "List available packages"))
<> command "setup" (info (pure Setup) (progDesc "Install manpages and shell completions."))
)
install :: Parser Command
install = Install
<$> triple
<*> pkgArgs
checkSet :: Parser Command
checkSet = CheckSet
<$> targetP dhallCompletions id "check"
<*> details
check' :: Parser Command
check' = Check
<$> targetP dhallCompletions id "check-set"
<*> details
details :: Parser Bool
details = switch
(long "detailed"
<> short 'd'
<> help "Enable detailed error messages")
ftypeCompletions :: String -> Mod ArgumentFields a
ftypeCompletions ext = completer . bashCompleter $ "file -X '!*." ++ ext ++ "' -o plusdirs"
dhallCompletions :: Mod ArgumentFields a
dhallCompletions = ftypeCompletions "dhall"
run' :: Parser Command
run' = Run
<$> targets "run"
<*> pkgArgs
<*> rebuild
<*> verbosity
<*> noLint
<*> profile
test' :: Parser Command
test' = Test
<$> targets "test"
<*> pkgArgs
<*> rebuild
<*> verbosity
<*> noLint
<*> profile
valgrind :: Parser Command
valgrind = Valgrind
<$> targets "run with valgrind"
<*> pkgArgs
targets :: String -> Parser [String]
targets = targetP mempty many
targetP :: Mod ArgumentFields String -> (Parser String -> a) -> String -> a
targetP completions' f s = f
(argument str
(metavar "TARGET"
<> help ("Targets to " <> s)
<> completions'))
profile :: Parser Bool
profile = switch
(long "profile"
<> short 'p'
<> help "Print profiling information for the build")
rebuild :: Parser Bool
rebuild = switch
(long "rebuild"
<> short 'r'
<> help "Force rebuild of all targets")
triple :: Parser (Maybe String)
triple = optional
(strOption
(long "target"
<> short 't'
<> help "Set target by using its triple"))
pkgArgs :: Parser (Maybe String)
pkgArgs = optional
(strOption
(long "pkg-args"
<> help "Arguments to be passed to 'atspkg.dhall'"))
verbosity :: Parser Int
verbosity = length <$>
many (flag' () (short 'v' <> long "verbose" <> help "Turn up verbosity"))
build' :: Parser Command
build' = Build
<$> targets "build"
<*> pkgArgs
<*> triple
<*> rebuild
<*> verbosity
<*> noLint
<*> profile
noLint :: Parser Bool
noLint = fmap not
(switch
(long "no-lint"
<> short 'l'
<> help "Disable the shake linter"))
fetch :: Parser Command
fetch = Fetch <$>
argument str
(metavar "URL"
<> help "URL pointing to a tarball containing the package to be installed.")
<*> pkgArgs
<*> verbosity
fetchPkg :: Maybe String -> String -> Int -> IO ()
fetchPkg mStr pkg v = withSystemTempDirectory "atspkg" $ \p -> do
let (dirName, url') = (p, pkg) & each %~ TL.pack
buildHelper True (ATSDependency mempty dirName url' undefined undefined mempty mempty mempty mempty)
ps <- getSubdirs p
pkgDir <- fromMaybe p <$> findFile (p:ps) "atspkg.dhall"
let setup = [buildAll v mStr Nothing (Just pkgDir)]
withCurrentDirectory (takeDirectory pkgDir) (mkPkg mStr False False False setup ["install"] Nothing 0)
stopGlobalPool
main :: IO ()
main = execParser wrapper >>= run
runHelper :: Bool -> Bool -> Bool -> [String] -> Maybe String -> Maybe String -> Int -> IO ()
runHelper rba lint tim rs mStr tgt v = g . bool x y . (&& isNothing tgt) =<< check mStr Nothing
where g xs = mkPkg mStr rba lint tim xs rs tgt v *> stopGlobalPool
y = mempty
x = [buildAll v mStr tgt Nothing]
run :: Command -> IO ()
run List = displayList "https://raw.githubusercontent.com/vmchale/atspkg/master/ats-pkg/pkgs/pkg-set.dhall"
run (Check p b) = void $ ($ Version [0,1,0]) <$> checkPkg p b
run (CheckSet p b) = void $ checkPkgSet p b
run Upgrade = upgradeBin "vmchale" "atspkg"
run Nuke = cleanAll
run (Fetch u mArg v) = fetchPkg mArg u v
run Clean = mkPkg Nothing False True False mempty ["clean"] Nothing 0
run (Build rs mArg tgt rba v lint tim) = runHelper rba lint tim rs mArg tgt v
run (Test ts mArg rba v lint tim) = runHelper rba lint tim ("test" : ts) mArg Nothing v
run (Run ts mArg rba v lint tim) = runHelper rba lint tim ("run" : ts) mArg Nothing v
run (Install tgt mArg) = runHelper False True False ["install"] mArg tgt 0
run (Valgrind ts mArg) = runHelper False True False ("valgrind" : ts) mArg Nothing 0
run Setup = installActions
installActions :: IO ()
installActions = do
path <- getDataFileName ("man" </> "atspkg.1")
fold
[ writeManpages path "atspkg.1"
, writeTheFuck
, writeBashCompletions "atspkg"
]