Use cabal-plan-0.5 from Hackage

1 files changed, 0 insertions, 586 deletions

diff --git a/cabal-plan/src/Cabal/Plan.hs b/cabal-plan/src/Cabal/Plan.hs
deleted file mode 100755
index d65c581..0000000
--- a/cabal-plan/src/Cabal/Plan.hs
+++ /dev/null
@@ -1,586 +0,0 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE OverloadedStrings          #-}
-{-# LANGUAGE RecordWildCards            #-}
-
--- | SPDX-License-Identifier: GPL-2.0-or-later
---
--- Utilities for reading @cabal@'s @plan.json@ file
---
--- @plan.json@ are generated when using @cabal@
--- <http://cabal.readthedocs.io/en/latest/nix-local-build-overview.html Nix-style Local Builds>.
-module Cabal.Plan
-    (
-      PlanJson(..)
-    , Unit(..)
-    , CompName(..)
-    , dispCompName
-    , dispCompNameTarget
-    , CompInfo(..)
-    , UnitType(..)
-
-    -- * Basic types
-    , Ver(..)
-    , dispVer
-    , PkgName(..)
-    , PkgId(..)
-    , dispPkgId
-    , UnitId(..)
-    , FlagName(..)
-
-    -- ** SHA-256
-    , Sha256
-    , dispSha256
-    , parseSha256
-    , sha256ToByteString
-    , sha256FromByteString
-
-    -- ** PkgLoc
-    , PkgLoc(..)
-    , Repo(..)
-    , SourceRepo(..)
-    , URI(..)
-    , RepoType(..)
-
-    -- * Utilities
-    , planJsonIdGraph
-    , planJsonIdRoots
-
-    -- * Convenience functions
-    , SearchPlanJson(..)
-    , findAndDecodePlanJson
-    , findProjectRoot
-    , decodePlanJson
-    ) where
-
-import           Control.Applicative          as App
-import           Control.Monad
-import           Data.Aeson
-import           Data.Aeson.Types
-import qualified Data.ByteString              as B
-import qualified Data.ByteString.Base16       as B16
-import           Data.List
-import           Data.Map                     (Map)
-import qualified Data.Map                     as M
-import           Data.Monoid
-import           Data.Set                     (Set)
-import qualified Data.Set                     as S
-import           Data.Text                    (Text)
-import qualified Data.Text                    as T
-import qualified Data.Text.Encoding           as T
-import qualified Data.Version                 as DV
-import qualified System.Directory             as Dir
-import           System.FilePath
-import           Text.ParserCombinators.ReadP
-
-----------------------------------------------------------------------------
-
--- | Equivalent to @Cabal@'s @Distribution.Package.Version@
-newtype Ver = Ver [Int]
-            deriving (Show,Eq,Ord)
-
--- | Equivalent to @Cabal@'s @Distribution.Package.UnitId@
-newtype UnitId = UnitId Text
-               deriving (Show,Eq,Ord,FromJSON,ToJSON,FromJSONKey,ToJSONKey)
-
--- | Equivalent to @Cabal@'s @Distribution.Package.PackageName@
-newtype PkgName = PkgName Text
-                deriving (Show,Eq,Ord,FromJSON,ToJSON,FromJSONKey,ToJSONKey)
-
--- | Equivalent to @Cabal@'s @Distribution.Package.PackageIdentifier@
-data PkgId = PkgId !PkgName !Ver
-           deriving (Show,Eq,Ord)
-
--- | Equivalent to @Cabal@'s @Distribution.PackageDescription.FlagName@
---
--- @since 0.3.0.0
-newtype FlagName = FlagName Text
-                 deriving (Show,Eq,Ord,FromJSON,ToJSON,FromJSONKey,ToJSONKey)
-
--- | <https://en.wikipedia.org/wiki/SHA-2 SHA-256> hash
-newtype Sha256 = Sha256 B.ByteString -- internal invariant: exactly 32 bytes long
-               deriving (Eq,Ord)
--- | Equivalent to @Cabal@\'s @Distribution.Client.Types.PackageLocation@
-data PkgLoc
-   = LocalUnpackedPackage    !FilePath
-   | LocalTarballPackage     !FilePath
-   | RemoteTarballPackage    !URI
-   | RepoTarballPackage      !Repo
-   | RemoteSourceRepoPackage !SourceRepo
-     deriving (Show,Eq,Ord)
-
--- | Equivalent to @Cabal@\'s @Distribution.Types.SourceRepo@
-data Repo
-   = RepoLocal  !FilePath
-   | RepoRemote !URI
-   | RepoSecure !URI
-     deriving (Show,Eq,Ord)
-
--- | Equivalent to @Cabal@\'s @Distribution.Client.Types.Repo@
-data SourceRepo = SourceRepo
-     { srType     :: !(Maybe RepoType)
-     , srLocation :: !(Maybe Text)
-     , srModule   :: !(Maybe Text)
-     , srBranch   :: !(Maybe Text)
-     , srTag      :: !(Maybe Text)
-     , srSubdir   :: !(Maybe FilePath)
-     } deriving (Show,Eq,Ord)
-
-newtype URI = URI Text
-    deriving (Show,Eq,Ord,FromJSON,ToJSON,FromJSONKey,ToJSONKey)
-
--- | Equivalent to @Cabal@\'s @Distribution.Client.SourceRepo.RepoType@
-data RepoType
-   = Darcs
-   | Git
-   | SVN
-   | CVS
-   | Mercurial
-   | GnuArch
-   | Bazaar
-   | Monotone
-   | OtherRepoType Text
-     deriving (Show,Eq,Ord)
-
--- | Represents the information contained in cabal's @plan.json@ file.
---
--- This comprises basic information describing the environment as well
--- as the install/build plan computed by @cabal@.
-data PlanJson = PlanJson
-     { pjCabalVersion    :: !Ver                     -- ^ Version of @cabal@ frontend
-     , pjCabalLibVersion :: !Ver                     -- ^ Version of Cabal library
-     , pjCompilerId      :: !PkgId                   -- ^ Name and version of Haskell compiler
-     , pjArch            :: !Text                    -- ^ Architecture name
-     , pjOs              :: !Text                    -- ^ Operating system name
-     , pjUnits           :: !(M.Map UnitId Unit) -- ^ install/build plan
-     } deriving Show
-
--- | Describes kind of build unit and its provenance
-data UnitType = UnitTypeBuiltin -- ^ Lives in global (non-nix-style) package db
-              | UnitTypeGlobal  -- ^ Lives in Nix-store cache
-              | UnitTypeLocal   -- ^ Local package
-              | UnitTypeInplace -- ^ Local in-place package
-              deriving (Show,Eq)
-
--- | Represents a build-plan unit uniquely identified by its 'UnitId'
-data Unit = Unit
-     { uId      :: !UnitId      -- ^ Unit ID uniquely identifying a 'Unit' in install plan
-     , uPId     :: !PkgId       -- ^ Package name and version (not necessarily unique within plan)
-     , uType    :: !UnitType      -- ^ Describes type of build item, see 'UnitType'
-     , uSha256  :: !(Maybe Sha256) -- ^ SHA256 source tarball checksum (as used by e.g. @hackage-security@)
-     , uComps   :: !(Map CompName CompInfo) -- ^ Components identified by 'UnitId'
-       --
-       -- When @cabal@ needs to fall back to legacy-mode (currently for
-       -- @custom@ build-types or obsolete @cabal-version@ values), 'uComps'
-       -- may contain more than one element.
-     , uFlags   :: !(Map FlagName Bool) -- ^ cabal flag settings (not available for 'UnitTypeBuiltin')
-     , uDistDir :: !(Maybe FilePath) -- ^ In-place dist-dir (if available)
-                                     --
-                                     -- @since 0.3.0.0
-     , uPkgSrc  :: !(Maybe PkgLoc)
-       -- ^ Source of the package
-       --
-       -- @since 0.5.0.0 (TODO)
-     } deriving Show
-
--- | Component name inside a build-plan unit
---
--- A similiar type exists in @Cabal@ codebase, see
--- @Distribution.Simple.LocalBuildInfo.ComponentName@
-data CompName =
-    CompNameLib
-  | CompNameSubLib !Text
-  | CompNameFLib   !Text -- ^ @since 0.3.0.0
-  | CompNameExe    !Text
-  | CompNameTest   !Text
-  | CompNameBench  !Text
-  | CompNameSetup
-  deriving (Show, Eq, Ord)
-
--- | Describes component-specific information inside a 'Unit'
-data CompInfo = CompInfo
-    { ciLibDeps :: Set UnitId     -- ^ library dependencies
-    , ciExeDeps :: Set UnitId     -- ^ executable dependencies
-    , ciBinFile :: Maybe FilePath -- ^ path-name of artifact if available
-    } deriving Show
-
-----------------------------------------------------------------------------
-----------------------------------------------------------------------------
-----------------------------------------------------------------------------
-
--- JSON instances
-
-instance FromJSON CompName where
-    parseJSON = withText "CompName" (maybe (fail "invalid CompName") pure . parseCompName)
-
-instance ToJSON CompName where
-    toJSON     = toJSON . dispCompName
-
-instance FromJSONKey CompName where
-    fromJSONKey = FromJSONKeyTextParser (maybe (fail "CompName") pure . parseCompName)
-
-instance ToJSONKey   CompName where
-    toJSONKey = toJSONKeyText dispCompName
-
-----
-
-instance FromJSON CompInfo where
-    parseJSON = withObject "CompInfo" $ \o ->
-        CompInfo <$> o .:?! "depends"
-                 <*> o .:?! "exe-depends"
-                 <*> o .:? "bin-file"
-
-----
-
-instance FromJSON PkgId where
-    parseJSON = withText "PkgId" (maybe (fail "invalid PkgId") pure . parsePkgId)
-
-instance ToJSON PkgId where
-    toJSON = toJSON . dispPkgId
-
-instance FromJSONKey PkgId where
-    fromJSONKey = FromJSONKeyTextParser (maybe (fail "PkgId") pure . parsePkgId)
-
-instance ToJSONKey PkgId where
-    toJSONKey = toJSONKeyText dispPkgId
-
-----
-
-instance FromJSON PkgLoc where
-    parseJSON = withObject "PkgSrc" $ \o -> do
-        ty <- o .: "type"
-        case ty :: Text of
-          "local"       -> LocalUnpackedPackage    <$> o .: "path"
-          "local-tar"   -> LocalTarballPackage     <$> o .: "path"
-          "remote-tar"  -> RemoteTarballPackage    <$> o .: "uri"
-          "repo-tar"    -> RepoTarballPackage      <$> o .: "repo"
-          "source-repo" -> RemoteSourceRepoPackage <$> o .: "source-repo"
-          _ -> fail "invalid PkgSrc \"type\""
-
-instance FromJSON Repo where
-    parseJSON = withObject "Repo" $ \o -> do
-        ty <- o .: "type"
-        case ty :: Text of
-          "local-repo"  -> RepoLocal  <$> o .: "path"
-          "remote-repo" -> RepoRemote <$> o .: "uri"
-          "secure-repo" -> RepoSecure <$> o .: "uri"
-          _ -> fail "invalid Repo \"type\""
-
-instance FromJSON SourceRepo where
-    parseJSON = withObject "SourceRepo" $ \o -> do
-        SourceRepo <$> o .:? "type"
-                   <*> o .:? "location"
-                   <*> o .:? "module"
-                   <*> o .:? "branch"
-                   <*> o .:? "tag"
-                   <*> o .:? "subdir"
-
-instance FromJSON RepoType where
-    parseJSON = withText "RepoType" $ \ty -> return $
-        case ty of
-          "darcs"     -> Darcs
-          "git"       -> Git
-          "svn"       -> SVN
-          "cvs"       -> CVS
-          "mercurial" -> Mercurial
-          "gnuarch"   -> GnuArch
-          "bazaar"    -> Bazaar
-          "monotone"  -> Monotone
-          _ -> OtherRepoType ty
-
-----------------------------------------------------------------------------
--- parser helpers
-
-parseCompName :: Text -> Maybe CompName
-parseCompName t0 = case T.splitOn ":" t0 of
-                     ["lib"]     -> Just CompNameLib
-                     ["lib",n]   -> Just $! CompNameSubLib n
-                     ["flib",n]  -> Just $! CompNameFLib n
-                     ["exe",n]   -> Just $! CompNameExe n
-                     ["bench",n] -> Just $! CompNameBench n
-                     ["test",n]  -> Just $! CompNameTest n
-                     ["setup"]   -> Just CompNameSetup
-                     _           -> Nothing
-
--- | Pretty print 'CompName' in cabal's target-selector syntax.
-dispCompNameTarget :: PkgName -> CompName -> Text
-dispCompNameTarget (PkgName pkg) cn = case cn of
-    CompNameLib      -> "lib:" <> pkg
-    _                -> dispCompName cn
-
--- | Pretty print 'CompName' in the same syntax that is used in
--- @plan.json@. Note that this string can not be used as a target-selector on
--- the cabal command-line. See 'dispCompNameTarget' for a target-selector
--- compatible pretty printer.
-dispCompName :: CompName -> Text
-dispCompName cn = case cn of
-    CompNameLib      -> "lib"
-    CompNameSubLib n -> "lib:" <> n
-    CompNameFLib n   -> "flib:" <> n
-    CompNameExe n    -> "exe:" <> n
-    CompNameBench n  -> "bench:" <> n
-    CompNameTest n   -> "test:" <> n
-    CompNameSetup    -> "setup"
-
-instance FromJSON PlanJson where
-    parseJSON = withObject "PlanJson" $ \o -> do
-        pjCabalVersion    <- o .: "cabal-version"
-
-        unless (pjCabalVersion >= Ver [2]) $
-            fail ("plan.json version " ++ T.unpack (dispVer pjCabalVersion) ++ " not supported")
-
-        pjCabalLibVersion <- o .: "cabal-lib-version"
-        pjCompilerId      <- o .: "compiler-id"
-        pjArch            <- o .: "arch"
-        pjOs              <- o .: "os"
-        pjUnits           <- toMap =<< o .: "install-plan"
-
-        App.pure PlanJson{..}
-      where
-        toMap pil = do
-            let pim = M.fromList [ (uId pi',pi') | pi' <- pil ]
-            unless (M.size pim == length pil) $
-                fail "install-plan[] has duplicate ids"
-            pure pim
-
-(.:?!) :: (FromJSON a, Monoid a) => Object -> Text -> Parser a
-o .:?! fld = o .:? fld .!= mempty
-
-planItemAllDeps :: Unit -> Set UnitId
-planItemAllDeps Unit{..} = mconcat [ ciLibDeps <> ciExeDeps | CompInfo{..} <- M.elems uComps ]
-
-instance FromJSON Unit where
-    parseJSON = withObject "Unit" $ \o -> do
-        mcomponents    <- o .:? "components"
-        mcomponentname <- o .:? "component-name"
-        ty             <- o .:  "type"
-        mstyle         <- o .:? "style"
-
-        uId     <- o .: "id"
-        uPId    <- PkgId <$> o .: "pkg-name" <*> o .: "pkg-version"
-        uType   <- case (ty :: Text, mstyle :: Maybe Text) of
-                   ("pre-existing",Nothing)      -> pure UnitTypeBuiltin
-                   ("configured",Just "global")  -> pure UnitTypeGlobal
-                   ("configured",Just "local")   -> pure UnitTypeLocal
-                   ("configured",Just "inplace") -> pure UnitTypeInplace
-                   _                             -> fail (show (ty,mstyle))
-        uFlags  <- o .:?! "flags"
-        uSha256 <- o .:? "pkg-src-sha256"
-        uComps  <- case (mcomponents, mcomponentname) of
-          (Just comps0, Nothing) ->
-              pure comps0
-          (Nothing, Just cname) ->
-              M.singleton cname <$> parseJSON (Object o)
-          (Nothing, Nothing) | uType == UnitTypeBuiltin ->
-              M.singleton CompNameLib <$> parseJSON (Object o)
-          _ -> fail (show o)
-
-        uDistDir <- o .:? "dist-dir"
-
-        uPkgSrc <- o .:? "pkg-src"
-
-        pure Unit{..}
-
-----------------------------------------------------------------------------
--- Convenience helper
-
--- | Where/how to search for the plan.json file.
-data SearchPlanJson
-    = ProjectRelativeToDir FilePath -- ^ Find the project root relative to
-                                    --   specified directory and look for
-                                    --   plan.json there.
-    | InBuildDir FilePath           -- ^ Look for plan.json in specified build
-                                    --   directory.
-    deriving (Eq, Show, Read)
-
--- | Locates the project root for cabal project relative to specified
--- directory.
---
--- @plan.json@ is located from either the optional build dir argument, or in
--- the default directory (@dist-newstyle@) relative to the project root.
---
--- The folder assumed to be the project-root is returned as well.
---
--- This function determines the project root in a slightly more liberal manner
--- than cabal-install. If no cabal.project is found, cabal-install assumes an
--- implicit cabal.project if the current directory contains any *.cabal files.
---
--- This function looks for any *.cabal files in directories above the current
--- one and behaves as if there is an implicit cabal.project in that directory
--- when looking for a plan.json.
---
--- Throws 'IO' exceptions on errors.
---
-findAndDecodePlanJson
-    :: SearchPlanJson
-    -> IO PlanJson
-findAndDecodePlanJson searchLoc = do
-    distFolder <- case searchLoc of
-        InBuildDir builddir -> pure builddir
-        ProjectRelativeToDir fp -> do
-            mRoot <- findProjectRoot fp
-            case mRoot of
-                Nothing -> fail ("missing project root relative to: " ++ fp)
-                Just dir -> pure $ dir </> "dist-newstyle"
-
-    haveDistFolder <- Dir.doesDirectoryExist distFolder
-
-    unless haveDistFolder $
-        fail ("missing " ++ show distFolder ++ " folder; do you need to run 'cabal new-build'?")
-
-    let planJsonFn = distFolder </> "cache" </> "plan.json"
-
-    havePlanJson <- Dir.doesFileExist planJsonFn
-
-    unless havePlanJson $
-        fail "missing 'plan.json' file; do you need to run 'cabal new-build'?"
-
-    decodePlanJson planJsonFn
-
--- | Decodes @plan.json@ file location provided as 'FilePath'
---
--- This is a trivial convenience function so that the caller doesn't
--- have to depend on @aeson@ directly
---
--- Throws 'IO' exceptions on errors.
---
-decodePlanJson :: FilePath -> IO PlanJson
-decodePlanJson planJsonFn = do
-    jsraw <- B.readFile planJsonFn
-    either fail pure $ eitherDecodeStrict' jsraw
-
--- | Find project root relative to a directory, this emulates cabal's current
--- heuristic, but is slightly more liberal. If no cabal.project is found,
--- cabal-install looks for *.cabal files in the specified directory only. This
--- function also considers *.cabal files in directories higher up in the
--- hierarchy.
-findProjectRoot :: FilePath -> IO (Maybe FilePath)
-findProjectRoot dir = do
-    normalisedPath <- Dir.canonicalizePath dir
-    let checkCabalProject d = do
-            ex <- Dir.doesFileExist fn
-            return $ if ex then Just d else Nothing
-          where
-            fn = d </> "cabal.project"
-
-        checkCabal d = do
-            files <- listDirectory d
-            return $ if any (isExtensionOf ".cabal") files
-                        then Just d
-                        else Nothing
-
-    result <- walkUpFolders checkCabalProject normalisedPath
-    case result of
-        Just rootDir -> pure $ Just rootDir
-        Nothing -> walkUpFolders checkCabal normalisedPath
-  where
-    isExtensionOf :: String -> FilePath -> Bool
-    isExtensionOf ext fp = ext == takeExtension fp
-
-    listDirectory :: FilePath -> IO [FilePath]
-    listDirectory fp = filter isSpecialDir <$> Dir.getDirectoryContents fp
-      where
-        isSpecialDir f = f /= "." && f /= ".."
-
-walkUpFolders
-    :: (FilePath -> IO (Maybe a)) -> FilePath -> IO (Maybe a)
-walkUpFolders dtest d0 = do
-    home <- Dir.getHomeDirectory
-
-    let go d | d == home  = pure Nothing
-             | isDrive d  = pure Nothing
-             | otherwise  = do
-                   t <- dtest d
-                   case t of
-                     Nothing -> go $ takeDirectory d
-                     x@Just{} -> pure x
-
-    go d0
-
-parseVer :: Text -> Maybe Ver
-parseVer str = case reverse $ readP_to_S DV.parseVersion (T.unpack str) of
-  (ver, "") : _ | not (null (DV.versionBranch ver)), all (>= 0) (DV.versionBranch ver)
-      -> Just (Ver $ DV.versionBranch ver)
-  _   -> Nothing
-
--- | Pretty print 'Ver'
-dispVer :: Ver -> Text
-dispVer (Ver ns) = T.pack $ intercalate "." (map show ns)
-
-instance FromJSON Ver where
-    parseJSON = withText "Ver" (maybe (fail "Ver") pure . parseVer)
-
-instance ToJSON Ver where
-    toJSON = toJSON . dispVer
-
-parsePkgId :: Text -> Maybe PkgId
-parsePkgId t = do
-  let (pns_, pvs) = T.breakOnEnd "-" t
-  pv <- parseVer pvs
-
-  pn <- T.stripSuffix "-" pns_
-
-  -- TODO: validate pn
-  pure (PkgId (PkgName pn) pv)
-
--- | Pretty print 'PkgId'
-dispPkgId :: PkgId -> Text
-dispPkgId (PkgId (PkgName pn) pv) = pn <> "-" <> dispVer pv
-
-
--- | Pretty print 'Sha256' as base-16.
-dispSha256 :: Sha256 -> Text
-dispSha256 (Sha256 s) = T.decodeLatin1 (B16.encode s)
-
--- | Parse base-16 encoded 'Sha256'.
---
--- Returns 'Nothing' in case of parsing failure.
---
--- @since 0.3.0.0
-parseSha256 :: Text -> Maybe Sha256
-parseSha256 t
-  | B.length s == 32, B.null rest = Just (Sha256 s)
-  | otherwise                     = Nothing
-  where
-    (s, rest) = B16.decode $ T.encodeUtf8 t
-
--- | Export the 'Sha256' digest to a 32-byte 'B.ByteString'.
---
--- @since 0.3.0.0
-sha256ToByteString :: Sha256 -> B.ByteString
-sha256ToByteString (Sha256 bs) = bs
-
--- | Import the 'Sha256' digest from a 32-byte 'B.ByteString'.
---
--- Returns 'Nothing' if input 'B.ByteString' has incorrect length.
---
--- @since 0.3.0.0
-sha256FromByteString :: B.ByteString -> Maybe Sha256
-sha256FromByteString bs
-  | B.length bs == 32  = Just (Sha256 bs)
-  | otherwise          = Nothing
-
-instance FromJSON Sha256 where
-    parseJSON = withText "Sha256" (maybe (fail "Sha256") pure . parseSha256)
-
-instance ToJSON Sha256 where
-    toJSON = toJSON . dispSha256
-
-instance Show Sha256 where
-    show = show . dispSha256
-
-----------------------------------------------------------------------------
-
--- | Extract directed 'UnitId' dependency graph edges from 'pjUnits'
---
--- This graph contains both, library and executable dependencies edges
-planJsonIdGraph :: PlanJson -> Map UnitId (Set UnitId)
-planJsonIdGraph PlanJson{..} = M.fromList [ (uId unit, planItemAllDeps unit)
-                                          | unit <- M.elems pjUnits
-                                          ]
-
--- | Extract 'UnitId' root nodes from dependency graph computed by 'planJsonIdGraph'
-planJsonIdRoots :: PlanJson -> Set UnitId
-planJsonIdRoots PlanJson{..} = M.keysSet pjUnits `S.difference` nonRoots
-  where
-    nonRoots :: Set UnitId
-    nonRoots = mconcat $ M.elems $ planJsonIdGraph PlanJson{..}