stackage-cabal (empty) → 0.1.0
raw patch · 8 files changed
+502/−0 lines, 8 filesdep +basedep +bytestringdep +exceptionssetup-changed
Dependencies added: base, bytestring, exceptions, http-client, http-client-tls, http-types, optparse-applicative, parsec, process, stackage-cli, system-fileio, text
Files
- ChangeLog.md +3/−0
- LICENSE +20/−0
- README.md +22/−0
- Setup.hs +2/−0
- main/Init.hs +107/−0
- main/Purge.hs +206/−0
- main/Upgrade.hs +77/−0
- stackage-cabal.cabal +65/−0
+ ChangeLog.md view
@@ -0,0 +1,3 @@+## 0.1.0++* Initial release
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2012 FP Complete, http://www.fpcomplete.com/++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,22 @@+stackage-cli+============++[](https://travis-ci.org/fpco/stackage-cabal)++A command-line interface for leveraging stackage.++You must have `ghc`, `ghc-pkg`, and `cabal` on your $PATH. This program will make various calls to those executables on your behalf.++This package provides the following stackage plugins:++## stackage init++Downloads a `cabal.config` file from `stackage.org`. That's all it does! The `cabal.config` file constrains the package versions used to build your project. Stackage.org is constantly calculating the best compatible build plans for a big subset of Hackage.++## stackage purge++Calls `ghc-pkg unregister` on your package databases. (You will be prompted on a per-db basis; use `stackage purge --force` if you don't want to be prompted.) This is an easy way to clean out your sandbox.++## stackage upgrade++A `stackage purge` followed by `stackage init`.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ main/Init.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TemplateHaskell #-}++module Main where++import Filesystem+import Control.Applicative+import Control.Monad+import Stackage.CLI+import Options.Applicative (Parser)+import Options.Applicative.Builder (strArgument, metavar, value)+import Data.Monoid+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Data.Typeable (Typeable)+import Network.HTTP.Client+import Network.HTTP.Client.TLS (tlsManagerSettings)+import Network.HTTP.Types.Status (statusCode)+import Network.HTTP.Types.Header (hUserAgent)+import qualified Data.ByteString.Lazy as LBS+import System.Exit (exitFailure)+import System.Environment (getArgs)+import System.IO (hPutStrLn, stderr)+import Control.Exception+import qualified Paths_stackage_cabal as CabalInfo++type Snapshot = String++data InitException+ = InvalidSnapshot+ | SnapshotNotFound+ | UnexpectedHttpException HttpException+ | CabalConfigExists+ deriving (Show, Typeable)+instance Exception InitException++version :: String+version = $(simpleVersion CabalInfo.version)++header :: String+header = "Initializes cabal.config"++progDesc :: String+progDesc = header++userAgent :: Text+userAgent = "stackage-init/" <> T.pack version++snapshotParser :: Parser Snapshot+snapshotParser = strArgument mods where+ mods = (metavar "SNAPSHOT" <> value "lts")++toUrl :: Snapshot -> String+toUrl t = "https://www.stackage.org/" <> t <> "/cabal.config"++snapshotReq :: Snapshot -> IO Request+snapshotReq snapshot = case parseUrl (toUrl snapshot) of+ Left _ -> throwIO $ InvalidSnapshot+ Right req -> return req+ { requestHeaders = [(hUserAgent, T.encodeUtf8 userAgent)]+ }++downloadSnapshot :: Snapshot -> IO LBS.ByteString+downloadSnapshot snapshot = withManager tlsManagerSettings $ \manager -> do+ let getResponseLbs req = do+ response <- httpLbs req manager+ return $ responseBody response+ let handle404 firstTry (StatusCodeException s _ _)+ | statusCode s == 404 = if firstTry+ then do+ req <- snapshotReq $ "snapshot/" <> snapshot+ getResponseLbs req `catch` handle404 False+ else do+ throwIO $ SnapshotNotFound+ handle404 _ e = throwIO $ UnexpectedHttpException e+ req <- snapshotReq snapshot+ getResponseLbs req `catch` handle404 True++initSnapshot :: Snapshot -> IO ()+initSnapshot snapshot = do+ configExists <- isFile "cabal.config"+ when configExists $ throwIO $ CabalConfigExists+ downloadSnapshot snapshot >>= LBS.writeFile "cabal.config"++handleInitExceptions :: Snapshot -> InitException -> IO ()+handleInitExceptions snapshot e = hPutStrLn stderr (err e) >> exitFailure where+ err InvalidSnapshot+ = "Invalid snapshot: " <> snapshot+ err SnapshotNotFound+ = "Snapshot not found: " <> snapshot+ err CabalConfigExists+ = "Warning: Cabal config already exists.\n"+ <> "No action taken."+ err (UnexpectedHttpException e)+ = "Unexpected http exception:\n"+ <> show e++main = do+ (snapshot, ()) <- simpleOptions+ version+ header+ progDesc+ snapshotParser -- global parser+ empty -- subcommands+ initSnapshot snapshot `catch` handleInitExceptions snapshot
+ main/Purge.hs view
@@ -0,0 +1,206 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-}++module Main where++import Data.Maybe (listToMaybe, mapMaybe)+import Stackage.CLI+import Filesystem+import Control.Exception (Exception, catch)+import Control.Monad+import Control.Monad.Catch (MonadThrow, throwM)+import Control.Applicative+import Data.Monoid+import Data.Typeable (Typeable)+import Options.Applicative (Parser, flag, long, help)+import System.Process (readProcess)+import Data.Char (toLower)+import System.IO (stdout, stderr, hFlush, hPutStrLn)+import qualified Data.Text.Encoding as T+import qualified Data.Text as T+import System.Environment (getArgs)+import System.Exit (exitFailure)+import qualified Paths_stackage_cabal as CabalInfo++import Text.Parsec hiding ((<|>), many)+type ParsecParser = Parsec String ()++data Force = Prompt | Force+data PurgeOpts = PurgeOpts+ { purgeOptsForce :: Force }++data PackageGroup = PackageGroup+ { packageGroupDb :: String+ , packageGroupPackages :: [String]+ }++data PurgeException+ = ParsePackagesError ParseError+ deriving (Show, Typeable)+instance Exception PurgeException++prompt :: String -> IO String+prompt str = putStr str >> hFlush stdout >> getLine++whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()+whenJust (Just a) f = f a+whenJust Nothing _ = return ()++pluralize :: Int -> a -> a -> a+pluralize 1 a _ = a+pluralize _ _ a = a++unregisterPackages :: String -> [String] -> IO ()+unregisterPackages packageDb = mapM_ unregister where+ unregister package = do+ putStrLn $ "Unregistering: " <> package+ _ <- readProcess "ghc-pkg" (args package) ""+ return ()+ args package =+ [ "unregister"+ , package+ , "--force"+ ] <> dbToArgs (Just packageDb)++parsePackageDb :: IO (Maybe String)+parsePackageDb = do+ cabalSandboxConfigExists <- isFile "cabal.sandbox.config"+ if cabalSandboxConfigExists+ then do+ t <- Filesystem.readTextFile "cabal.sandbox.config"+ let packageDbLine = T.stripPrefix "package-db: "+ return $ fmap T.unpack $ listToMaybe $ mapMaybe packageDbLine $ T.lines t+ else+ return Nothing++dbToArgs :: Maybe String -> [String]+dbToArgs Nothing = []+dbToArgs (Just packageDb) =+ [ "--package-db"+ , packageDb+ ]++getGlobalPackageDb :: IO (Maybe String)+getGlobalPackageDb = do+ let fakePackage = "asdklfjasdklfajsdlkghaiwojgadjfkq"+ output <- readProcess "ghc-pkg" ["list", fakePackage] ""+ return $ fmap init $ listToMaybe (lines output)+ -- fmap init is to get rid of the trailing colon++getPackages :: Maybe String -> IO [PackageGroup]+getPackages mPackageDb = parsePackages =<< readProcess "ghc-pkg" args "" where+ args = ["list"] <> dbToArgs mPackageDb++parsePackages :: MonadThrow m => String -> m [PackageGroup]+parsePackages+ = either (throwM . ParsePackagesError) return+ . parse packagesParser ""++-- #28+#if !MIN_VERSION_parsec(3,1,6)+crlf :: ParsecParser Char+crlf = char '\r' *> char '\n' <?> "crlf new-line"++endOfLine :: ParsecParser Char+endOfLine = newline <|> crlf <?> "new-line"+#endif++ending :: ParsecParser ()+ending = eof <|> void endOfLine++packagesParser :: ParsecParser [PackageGroup]+packagesParser = many1 parseGroup++parseGroup :: ParsecParser PackageGroup+parseGroup = PackageGroup <$> parseDb <*> parseDbPackages <* many endOfLine++parseDb :: ParsecParser String+parseDb = manyTill anyChar $ try (char ':' *> ending)++parseDbPackages :: ParsecParser [String]+parseDbPackages = try parseNoPackages <|> many1 parsePackage++parseNoPackages :: ParsecParser [String]+parseNoPackages = many1 (char ' ') *> string "(no packages)" *> ending *> pure []++parsePackage :: ParsecParser String+parsePackage = many1 (char ' ') *> manyTill anyChar ending+++purge :: PurgeOpts -> IO ()+purge opts = do+ cabalConfigExists <- isFile "cabal.config"+ when cabalConfigExists $ do+ removeFile "cabal.config"++ globalPackageDbMay <- getGlobalPackageDb+ sandboxPackageDbMay <- parsePackageDb++ let displaySandbox s+ | Just s == globalPackageDbMay =+ "(Global) " <> s+ | Just s == sandboxPackageDbMay =+ "(Sandbox) " <> s+ | otherwise = s++ packages <- getPackages sandboxPackageDbMay+ forM_ packages $ \(PackageGroup db packages) -> do+ putStrLn $ displaySandbox db+ let nPackages = length packages+ let showNPackages+ = show nPackages+ <> " "+ <> pluralize nPackages "package" "packages"++ putStrLn+ $ "Detected "+ <> showNPackages+ <> " to purge from this database"++ when (nPackages > 0) $ do+ when (nPackages < 15) $ mapM_ putStrLn packages+ shouldUnregister <- case purgeOptsForce opts of+ Force -> do+ putStrLn $ "(--force) Unregistering " <> showNPackages+ return True+ Prompt -> do+ line <- prompt+ $ "Unregister " <> showNPackages <> " (y/n)? [default: n] "+ case map toLower line of+ "y" -> return True+ "yes" -> return True+ _ -> return False+ when shouldUnregister $ unregisterPackages db packages+ return ()++purgeOptsParser :: Parser PurgeOpts+purgeOptsParser = PurgeOpts <$> forceOpt where+ forceOpt = flag Prompt Force mods+ mods = long "force"+ <> help "Purge all packages without prompt"++version :: String+version = $(simpleVersion CabalInfo.version)++header :: String+header = "Delete cabal.config and purge your package database"++progDesc :: String+progDesc = header++handlePurgeExceptions :: PurgeException -> IO ()+handlePurgeExceptions (ParsePackagesError _) = do+ hPutStrLn stderr $ "Failed to parse ghc-pkg output"+ exitFailure++main :: IO ()+main = do+ (opts, ()) <- simpleOptions+ version+ header+ progDesc+ purgeOptsParser -- global parser+ empty -- subcommands+ purge opts `catch` handlePurgeExceptions
+ main/Upgrade.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Main where++import Control.Applicative+import Control.Exception (catch)+import Stackage.CLI+import System.Environment (getArgs)+import Data.Monoid+import Data.Text (unpack)+import Options.Applicative (long, short, help, metavar, value, switch, Parser, strArgument)+import System.IO (hPutStrLn, stderr)+import System.Exit (exitFailure, exitWith, ExitCode (..))+import qualified Paths_stackage_cabal as CabalInfo++data Opts = Opts+ { purgeArgs :: [String]+ , initArgs :: [String]+ }+++version :: String+version = $(simpleVersion CabalInfo.version)++summary :: String+summary = "Upgrade your cabal.config file"++header :: String+header = summary++progDesc :: String+progDesc = summary++optsParser :: Parser Opts+optsParser = Opts <$> purgeArgsParser <*> initArgsParser++initArgsParser :: Parser [String]+initArgsParser = targetToArgs <$> initOptsParser where+ targetToArgs t = [t]++-- As seen in Init.hs+initOptsParser :: Parser String+initOptsParser = strArgument mods where+ mods = metavar "SNAPSHOT" <> value "lts"++purgeArgsParser :: Parser [String]+purgeArgsParser = forceToArgs <$> purgeOptsParser where+ forceToArgs force = if force then ["--force"] else []++-- As seen in Purge.hs+purgeOptsParser :: Parser Bool+purgeOptsParser = switch mods where+ mods = long "force"+ <> help "Purge all packages without prompt"++handlePluginException :: PluginException -> IO ()+handlePluginException (PluginNotFound _ p) = do+ hPutStrLn stderr $ "stackage-upgrade: requires plugin stackage " <> unpack p+ exitFailure+handlePluginException (PluginExitFailure _ i) = do+ exitWith (ExitFailure i)++-- TODO: no-op if at desired target already+main = do+ (opts, ()) <- simpleOptions+ version+ header+ progDesc+ optsParser -- global parser+ empty -- subcommands++ stackage <- findPlugins "stackage"+ callPlugin stackage "purge" (purgeArgs opts)+ `catch` handlePluginException+ callPlugin stackage "init" (initArgs opts)+ `catch` handlePluginException
+ stackage-cabal.cabal view
@@ -0,0 +1,65 @@+name: stackage-cabal+version: 0.1.0+synopsis:+ A CLI executable for cabal-based stackage commands+description:+ A CLI executable for cabal-based stackage commands+homepage:+ https://www.stackage.org/package/stackage-cabal+bug-reports:+ https://github.com/fpco/stackage-cabal/issues++license: MIT+license-file: LICENSE+author: Dan Burton+maintainer: danburton@fpcomplete.com+copyright: 2015 FP Complete Corporation++build-type: Simple+cabal-version: >=1.10+category: Development+extra-source-files: README.md ChangeLog.md++source-repository head+ type: git+ location: git://github.com/fpco/stackage-cabal.git++executable stackage-init+ hs-source-dirs: main+ main-is: Init.hs+ build-depends:+ base >=4.7 && <5+ , text+ , stackage-cli+ , system-fileio+ , optparse-applicative+ , http-client+ , http-client-tls+ , http-types+ , bytestring+ default-language: Haskell2010++executable stackage-purge+ hs-source-dirs: main+ main-is: Purge.hs+ build-depends:+ base >=4.7 && <5+ , text+ , stackage-cli+ , system-fileio+ , optparse-applicative+ , process+ , parsec+ , exceptions+ default-language: Haskell2010++executable stackage-upgrade+ hs-source-dirs: main+ main-is: Upgrade.hs+ build-depends:+ base >=4.7 && <5+ , text+ , stackage-cli+ , system-fileio+ , optparse-applicative+ default-language: Haskell2010