stackage-sandbox (empty) → 0.1.0

raw patch · 6 files changed

+518/−0 lines, 6 filesdep +basedep +filepathdep +optparse-applicativesetup-changed

Dependencies added: base, filepath, optparse-applicative, process, stackage-cli, system-fileio, system-filepath, text

Files

• ChangeLog.md +3/−0
• LICENSE +20/−0
• README.md +51/−0
• Setup.hs +2/−0
• main/Sandbox.hs +403/−0
• stackage-sandbox.cabal +39/−0

@@ -0,0 +1,3 @@+## 0.1.0++* Initial release

@@ -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.

@@ -0,0 +1,51 @@+stackage-cli+============++[![Build Status](https://travis-ci.org/fpco/stackage-cli.svg)](https://travis-ci.org/fpco/stackage-cli)++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 a number of executables. Primary among these is the `stackage` executable (and its alias `stk`). The `stackage` command-line program will inspect your path for stackage plugins, and will dispatch to them. Anything on your $PATH prefixed `stackage-` that responds to the `--summary` flag is considered a stackage plugin.++(This package also provides a library, `Stackage.CLI`, which is intended to make the process of writing stackage plugins easier.)++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`.++## stackage sandbox++The sandbox plugin has a few commands of its own that mirror the above three stackage commands:++### stackage sandbox init++In addition to downloading a `cabal.config` file, this will also set up a shared sandbox (via `cabal.sandbox.config`) corresponding to whatever stackage snapshot is used. By default, the latest available Stackage LTS snapshot will be used.++Shared sandboxes are located at `$HOME/.stackage/sandboxes`. Be aware! Anything you `cabal install` to this sandbox will be available to any other projects that share the same sandbox. The `cabal.config` file should help make sure you don't install anything incompatible.++### stackage sandbox delete++Delete `cabal.config` and `cabal.sandbox.config`.++Unlike `stackage purge`, this does not alter any package databases. The shared sandbox will remain untouched. You can use `stackage sandbox delete NAME` to delete the shared sandbox called NAME (e.g. lts-2.0) from your system.++### stackage sandbox upgrade++Replace `cabal.config` and `cabal.sandbox.config` with newer versions and (possibly) a new shared sandbox.+++## Further reading++See also: [this example on the stackage-cli wiki](https://github.com/fpco/stackage-cli/wiki/Example).

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,403 @@+{-# 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_sandbox 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

@@ -0,0 +1,39 @@+name:                stackage-sandbox+version:             0.1.0+synopsis:+  Work with shared stackage sandboxes+description:+  Work with shared stackage sandboxes+homepage:+  https://www.stackage.org/package/stackage-sandbox+bug-reports:+  https://github.com/fpco/stackage-sandbox/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-sandbox.git++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