packages feed

stackage-cli 0.0.0.4 → 0.1.0

raw patch · 5 files changed

+1/−848 lines, 5 filesdep −bytestringdep −http-clientdep −http-client-tls

Dependencies removed: bytestring, http-client, http-client-tls, http-types, parsec, system-fileio, system-filepath

Files

− main/Init.hs 
@@ -1,107 +0,0 @@-{-# 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_cli 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 
@@ -1,206 +0,0 @@-{-# 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_cli 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/Sandbox.hs 
@@ -1,403 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE TemplateHaskell #-}--module Main where--import Control.Exception (Exception, bracket_, catch, throwIO)-import Control.Monad (when)-import Data.Maybe-import Data.Monoid-import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.IO as T-import Data.Typeable (Typeable)-import Filesystem.Path.CurrentOS as Path-import Filesystem-import Options.Applicative hiding (header, progDesc)-import Stackage.CLI-import System.Environment (lookupEnv)-import System.Exit-import System.FilePath (addTrailingPathSeparator)-import System.IO (hPutStrLn, stderr)-import System.IO.Error (isDoesNotExistError)-import System.Process (callProcess, readProcess)-import qualified Paths_stackage_cli as CabalInfo--type Snapshot = Text-type Package = Text-data Action-  = Init (Maybe Snapshot)-  | PackageDb-  | List (Maybe Package)-  | Unregister Package-  | Delete (Maybe Snapshot)-  | Upgrade (Maybe Snapshot)--data SandboxException-  = NoHomeEnvironmentVariable-  | AlreadyAtSnapshot-  | PackageDbLocMismatch Text Text-  | MissingConfig Bool Bool-  | SnapshotMismatch Text Text-  | NonStackageCabalConfig-  | EmptyCabalConfig-  | DecodePathFail Text-  | ConfigAlreadyExists-  | InvalidSnapshot Snapshot-  | GhcVersionFail-  | PackageDbNotFound-  deriving (Show, Typeable)-instance Exception SandboxException--mSnapshotToArgs :: Maybe Snapshot -> [String]-mSnapshotToArgs = fmap T.unpack . maybeToList--version :: String-version = $(simpleVersion CabalInfo.version)--header :: String-header = "Manages shared stackage sandboxes"--progDesc :: String-progDesc = header--snapshotParser :: Parser Snapshot-snapshotParser = T.pack <$> strArgument mods where-  mods = metavar "SNAPSHOT"--packageParser :: Parser Package-packageParser = T.pack <$> strArgument mods where-  mods = metavar "PACKAGE"--packageDbDesc :: String-packageDbDesc = "Prints '--package-db $db', or prints nothing"--listDesc :: String-listDesc = "Calls `ghc-pkg list` with the sandbox package-db"--unregisterDesc :: String-unregisterDesc = "Calls `ghc-pkg unregister PACKAGE with the sandbox package-db"--deleteDesc :: String-deleteDesc = "Deletes cabal.config and cabal.sandbox.config. "-  <> "If provided with a SNAPSHOT, instead deletes that snapshot's folder."--upgradeDesc :: String-upgradeDesc = "Upgrade to the given SNAPSHOT. Defaults to the latest LTS."--subcommands = do-  addCommand "init" "Init" Init (optional snapshotParser)-  addCommand "package-db" packageDbDesc (const PackageDb) (pure ())-  addCommand "list" listDesc List (optional packageParser)-  addCommand "unregister" unregisterDesc Unregister packageParser-  addCommand "delete" deleteDesc Delete (optional snapshotParser)-  addCommand "upgrade" upgradeDesc Upgrade (optional snapshotParser)--toText' :: Path.FilePath -> IO Text-toText' p = case toText p of-  Left e -> throwIO $ DecodePathFail e-  Right t -> return t--cabalSandboxInit :: Path.FilePath -> IO ()-cabalSandboxInit dir = do-  dirText <- toText' dir-  let args =-        [ "sandbox"-        , "init"-        , "--sandbox"-        , T.unpack dirText-        ]-  callProcess "cabal" args---- precondition: cabal.config exists-parseConfigSnapshot :: IO Snapshot-parseConfigSnapshot = do-  ls <- T.lines <$> T.readFile "cabal.config"-  let p = "-- Stackage snapshot from: http://www.stackage.org/snapshot/"-  case ls of-    (l:_) -> case T.stripPrefix p l of-      Just snapshot -> return snapshot-      Nothing -> throwIO NonStackageCabalConfig-    _ -> throwIO EmptyCabalConfig---- TODO: a stricter check?-snapshotEq :: Snapshot -> Snapshot -> Bool-snapshotEq short full = T.isPrefixOf (T.replace "/" "-" short) full---- TODO: verify things about the packages in the sandbox-sandboxVerify :: IO ()-sandboxVerify = do-  cabalConfigExists <- isFile "cabal.config"-  cabalSandboxConfigExists <- isFile "cabal.sandbox.config"-  if (cabalConfigExists && cabalSandboxConfigExists)-    then do-      packageDb <- getPackageDb-      snapshot <- parseConfigSnapshot-      snapshotDir <- getSnapshotDir snapshot-      snapshotDirText <- toText' snapshotDir-      when (not $ T.isPrefixOf snapshotDirText packageDb) $ do-        throwIO $ PackageDbLocMismatch snapshotDirText packageDb-    else do-      throwIO $ MissingConfig cabalConfigExists cabalSandboxConfigExists--getGhcVersion :: IO Text-getGhcVersion = do-  output <- readProcess "ghc" ["--version"] ""-  case words output of-    [] -> throwIO $ GhcVersionFail-    ws -> return $ "ghc-" <> T.pack (last ws)--sandboxInit :: Maybe Snapshot -> IO ()-sandboxInit msnapshot = do-  cabalSandboxConfigExists <- isFile "cabal.sandbox.config"-  when cabalSandboxConfigExists $ do-    throwIO ConfigAlreadyExists--  cabalConfigExists <- isFile "cabal.config"-  when (not cabalConfigExists) $ do-    runStackagePlugin "init" (mSnapshotToArgs msnapshot)--  configSnapshot <- parseConfigSnapshot-  snapshot <- case msnapshot of-    Just s | snapshotEq s configSnapshot -> return configSnapshot-    Just s -> throwIO $ SnapshotMismatch s configSnapshot-    Nothing -> return configSnapshot--  T.putStrLn $ "Initializing at snapshot: " <> snapshot--  dir <- getSnapshotDir snapshot-  createTree dir-  cabalSandboxInit dir-  sandboxVerify--getHome :: IO Text-getHome = T.pack <$> do-  mHome <- lookupEnv "HOME"-  case mHome of-    Just home -> return home-    Nothing -> do-      mHomePath <- lookupEnv "HOMEPATH"-      mHomeDrive <- lookupEnv "HOMEDRIVE"-      case (++) <$> mHomeDrive <*> mHomePath of-        Just home -> return home-        Nothing -> throwIO NoHomeEnvironmentVariable--getSnapshotDirPrefix :: IO Path.FilePath-getSnapshotDirPrefix = do-  home <- getHome-  ghcVersion <- getGhcVersion-  let dir = Path.fromText home </> ".stackage" </> "sandboxes"-        </> Path.fromText ghcVersion-  return dir--getSnapshotDir :: Snapshot -> IO Path.FilePath-getSnapshotDir snapshot = do-  dir <- getSnapshotDirPrefix-  return $ dir </> Path.fromText snapshot----- copied from Purge.hs, tweaked--- TODO: remove duplication-parsePackageDb :: IO (Maybe Text)-parsePackageDb = do-  cabalSandboxConfigExists <- isFile "cabal.sandbox.config"-  if cabalSandboxConfigExists-    then do-      t <- T.readFile "cabal.sandbox.config"-      let packageDbLine = T.stripPrefix "package-db: "-      return $ listToMaybe $ mapMaybe packageDbLine $ T.lines t-    else-      return Nothing--getPackageDb :: IO Text-getPackageDb = parsePackageDb >>= \mdb -> case mdb of-  Just packageDb -> return packageDb-  Nothing -> throwIO $ PackageDbNotFound--getPackageDbArg :: IO Text-getPackageDbArg = parsePackageDb >>= \mdb -> case mdb of-  Just packageDb -> return $ "--package-db=" <> packageDb-  Nothing -> return ""---printPackageDb :: IO ()-printPackageDb = getPackageDbArg >>= T.putStrLn--ghcPkgList :: Maybe Package -> IO ()-ghcPkgList mPackage = do-  packageDb <- getPackageDbArg-  let args-        = ["list"]-       <> case mPackage of-            Nothing -> []-            Just package -> [T.unpack package]-       <> [T.unpack packageDb]-  callProcess "ghc-pkg" args--ghcPkgUnregister :: Package -> IO ()-ghcPkgUnregister package = do-  packageDb <- getPackageDbArg-  callProcess "ghc-pkg" ["unregister", T.unpack package, T.unpack packageDb]--sandboxDelete :: IO ()-sandboxDelete = do-  cabalConfigExists <- isFile "cabal.config"-  when cabalConfigExists $ do-    removeFile "cabal.config"-  cabalSandboxConfigExists <- isFile "cabal.sandbox.config"-  when cabalSandboxConfigExists $ do-    oldSandboxNotice-    removeFile "cabal.sandbox.config"--snapshotSanityCheck :: Snapshot -> IO ()-snapshotSanityCheck snapshot =-  if any (`T.isInfixOf` snapshot) ["..", "/"]-    then throwIO $ InvalidSnapshot snapshot-    else return ()--sandboxDeleteSnapshot :: Snapshot -> IO ()-sandboxDeleteSnapshot snapshot = do-  snapshotSanityCheck snapshot-  getSnapshotDir snapshot >>= removeTree---- Find the canonical name for a snapshot by looking it up on stackage.org.--- This can change over time. e.g. "lts" used to mean lts-1.0.-downloadSnapshot :: Maybe Snapshot -> IO Snapshot-downloadSnapshot mSnapshot = do-  workingDir <- getWorkingDirectory-  let tempDir = ".stackage-sandbox-tmp"-      enterTempDir = do-        createDirectory False tempDir-        setWorkingDirectory tempDir-      exitTempDir = do-        setWorkingDirectory workingDir-        removeTree tempDir-  bracket_ enterTempDir exitTempDir $ do-    runStackagePlugin "init" (mSnapshotToArgs mSnapshot)-    parseConfigSnapshot---sandboxUpgrade :: Maybe Snapshot -> IO ()-sandboxUpgrade mSnapshot = do-  cabalConfigExists <- isFile "cabal.config"-  cabalSandboxConfigExists <- isFile "cabal.sandbox.config"--  mConfigSnapshot <- if cabalConfigExists-    then Just <$> parseConfigSnapshot-    else return Nothing--  snapshot <- downloadSnapshot mSnapshot--  when (Just snapshot == mConfigSnapshot && cabalSandboxConfigExists) $ do-    packageDb <- getPackageDb-    snapshotDir <- getSnapshotDir snapshot-    snapshotDirText <- toText' snapshotDir-    if T.isPrefixOf snapshotDirText packageDb-      then do-        T.putStrLn $ "Already at snapshot: " <> snapshot-        -- TODO: more verification-        throwIO AlreadyAtSnapshot-      else return ()--  sandboxDelete-  sandboxInit mSnapshot--getSandboxPrefix :: IO Text-getSandboxPrefix = do-  dirPath <- getSnapshotDirPrefix-  dirPathText <- toText' dirPath-  let viaString f = T.pack . f . T.unpack-  return $ viaString addTrailingPathSeparator dirPathText--oldSandboxNotice :: IO ()-oldSandboxNotice = do-  db <- getPackageDb-  sandboxPrefix <- getSandboxPrefix-  case T.stripPrefix sandboxPrefix db of-    Nothing -> do-      putStrLn "Notice: Your old sandbox remains intact:"-      T.putStrLn db-    Just db' -> case T.takeWhile (not . flip elem ("/\\" :: String)) db' of-      snapshot | not (T.null snapshot) -> do-        T.putStrLn $ "Notice: The " <> snapshot <> " shared sandbox remains intact."-        T.putStrLn $ "You may delete it from your system by calling:"-        T.putStrLn $ "stackage sandbox delete " <> snapshot-      _ -> do-        putStrLn "Notice: Your old sandbox remains untouched:"-        T.putStrLn db-  T.putStrLn ""---handleSandboxExceptions :: SandboxException -> IO ()-handleSandboxExceptions NoHomeEnvironmentVariable = do-  hPutStrLn stderr "Couldn't find the HOME environment variable"-  exitFailure-handleSandboxExceptions AlreadyAtSnapshot = exitSuccess-handleSandboxExceptions (PackageDbLocMismatch dir db) = do-  hPutStrLn stderr "verify: package db isn't in the expected location:"-  T.hPutStrLn stderr $ "dir: " <> dir-  T.hPutStrLn stderr $ "db: " <> db-  exitFailure-handleSandboxExceptions (MissingConfig cabalConfigExists cabalSandboxConfigExists) = do-  when (not cabalConfigExists) $-    hPutStrLn stderr "verify: cabal.config not present"-  when (not cabalSandboxConfigExists) $-    hPutStrLn stderr "verify: cabal.sandbox.config not present"-  exitFailure-handleSandboxExceptions (SnapshotMismatch s configSnapshot) = do-  T.hPutStrLn stderr-     $ "Warning: given snapshot [" <> s <> "] "-    <> "doesn't match cabal.config snapshot [" <> configSnapshot <> "]"-  hPutStrLn stderr "No action taken"-  exitFailure-handleSandboxExceptions ConfigAlreadyExists = do-  hPutStrLn stderr $ "Warning: cabal.sandbox.config already exists"-  hPutStrLn stderr $ "No action taken"-  exitFailure-handleSandboxExceptions NonStackageCabalConfig = do-  hPutStrLn stderr $ "cabal.config doesn't look like it's from stackage"-  exitFailure-handleSandboxExceptions EmptyCabalConfig = do-  hPutStrLn stderr $ "No contents found in cabal.config"-  exitFailure-handleSandboxExceptions (DecodePathFail e) = do-  hPutStrLn stderr $ "Unexpected failure decoding path:"-  T.hPutStrLn stderr e-  exitFailure-handleSandboxExceptions (InvalidSnapshot snapshot) = do-  T.hPutStrLn stderr $ "Invalid snapshot: " <> snapshot-  exitFailure-handleSandboxExceptions GhcVersionFail = do-  hPutStrLn stderr $ "Couldn't determine ghc version"-  exitFailure-handleSandboxExceptions PackageDbNotFound = do-  hPutStrLn stderr $ "Couldn't find sandbox package-db"-  exitFailure--handlePluginExceptions :: PluginException -> IO ()-handlePluginExceptions (PluginNotFound _ p) = do-  hPutStrLn stderr $ "stackage-sandbox: requires plugin stackage " <> T.unpack p-  exitFailure-handlePluginExceptions (PluginExitFailure _ i) = do-  exitWith (ExitFailure i)--main :: IO ()-main = do-  ((), action) <- simpleOptions-    version-    header-    progDesc-    (pure ())-    subcommands-  let go = case action of-        Init mSnapshot -> sandboxInit mSnapshot-        PackageDb -> printPackageDb-        List mPackage -> ghcPkgList mPackage-        Unregister package -> ghcPkgUnregister package-        Delete mSnapshot -> case mSnapshot of-          Just snapshot -> sandboxDeleteSnapshot snapshot-          Nothing -> sandboxDelete-        Upgrade mSnapshot -> sandboxUpgrade mSnapshot-  go `catch` handleSandboxExceptions-     `catch` handlePluginExceptions
− main/Upgrade.hs 
@@ -1,77 +0,0 @@-{-# 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_cli 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-cli.cabal view
@@ -1,5 +1,5 @@ name:                stackage-cli-version:             0.0.0.4+version:             0.1.0 synopsis:   A CLI library for stackage commands description:@@ -65,58 +65,4 @@       base >=4.7 && <5     , text     , stackage-cli-  default-language:    Haskell2010--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--executable stackage-sandbox-  hs-source-dirs:      main-  main-is:             Sandbox.hs-  build-depends:-      base >=4.7 && <5-    , text-    , stackage-cli-    , system-fileio-    , system-filepath-    , optparse-applicative-    , process-    , filepath   default-language:    Haskell2010