{-# LANGUAGE CPP                        #-}
{-# 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
    , findPlanJson
    , findProjectRoot
    , decodePlanJson
    ) where

import           Control.Applicative          as App
import           Control.Monad
import           Data.Aeson
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.Key                as AK
#endif
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
                 ((</>), takeExtension, isDrive, takeDirectory)
import           Text.ParserCombinators.ReadP

----------------------------------------------------------------------------

-- | Equivalent to @Cabal@'s @Distribution.Package.Version@
newtype Ver = Ver [Int]
            deriving (Int -> Ver -> ShowS
[Ver] -> ShowS
Ver -> [Char]
(Int -> Ver -> ShowS)
-> (Ver -> [Char]) -> ([Ver] -> ShowS) -> Show Ver
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Ver -> ShowS
showsPrec :: Int -> Ver -> ShowS
$cshow :: Ver -> [Char]
show :: Ver -> [Char]
$cshowList :: [Ver] -> ShowS
showList :: [Ver] -> ShowS
Show,Ver -> Ver -> Bool
(Ver -> Ver -> Bool) -> (Ver -> Ver -> Bool) -> Eq Ver
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Ver -> Ver -> Bool
== :: Ver -> Ver -> Bool
$c/= :: Ver -> Ver -> Bool
/= :: Ver -> Ver -> Bool
Eq,Eq Ver
Eq Ver =>
(Ver -> Ver -> Ordering)
-> (Ver -> Ver -> Bool)
-> (Ver -> Ver -> Bool)
-> (Ver -> Ver -> Bool)
-> (Ver -> Ver -> Bool)
-> (Ver -> Ver -> Ver)
-> (Ver -> Ver -> Ver)
-> Ord Ver
Ver -> Ver -> Bool
Ver -> Ver -> Ordering
Ver -> Ver -> Ver
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Ver -> Ver -> Ordering
compare :: Ver -> Ver -> Ordering
$c< :: Ver -> Ver -> Bool
< :: Ver -> Ver -> Bool
$c<= :: Ver -> Ver -> Bool
<= :: Ver -> Ver -> Bool
$c> :: Ver -> Ver -> Bool
> :: Ver -> Ver -> Bool
$c>= :: Ver -> Ver -> Bool
>= :: Ver -> Ver -> Bool
$cmax :: Ver -> Ver -> Ver
max :: Ver -> Ver -> Ver
$cmin :: Ver -> Ver -> Ver
min :: Ver -> Ver -> Ver
Ord)

-- | Equivalent to @Cabal@'s @Distribution.Package.UnitId@
newtype UnitId = UnitId Text
               deriving (Int -> UnitId -> ShowS
[UnitId] -> ShowS
UnitId -> [Char]
(Int -> UnitId -> ShowS)
-> (UnitId -> [Char]) -> ([UnitId] -> ShowS) -> Show UnitId
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnitId -> ShowS
showsPrec :: Int -> UnitId -> ShowS
$cshow :: UnitId -> [Char]
show :: UnitId -> [Char]
$cshowList :: [UnitId] -> ShowS
showList :: [UnitId] -> ShowS
Show,UnitId -> UnitId -> Bool
(UnitId -> UnitId -> Bool)
-> (UnitId -> UnitId -> Bool) -> Eq UnitId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnitId -> UnitId -> Bool
== :: UnitId -> UnitId -> Bool
$c/= :: UnitId -> UnitId -> Bool
/= :: UnitId -> UnitId -> Bool
Eq,Eq UnitId
Eq UnitId =>
(UnitId -> UnitId -> Ordering)
-> (UnitId -> UnitId -> Bool)
-> (UnitId -> UnitId -> Bool)
-> (UnitId -> UnitId -> Bool)
-> (UnitId -> UnitId -> Bool)
-> (UnitId -> UnitId -> UnitId)
-> (UnitId -> UnitId -> UnitId)
-> Ord UnitId
UnitId -> UnitId -> Bool
UnitId -> UnitId -> Ordering
UnitId -> UnitId -> UnitId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: UnitId -> UnitId -> Ordering
compare :: UnitId -> UnitId -> Ordering
$c< :: UnitId -> UnitId -> Bool
< :: UnitId -> UnitId -> Bool
$c<= :: UnitId -> UnitId -> Bool
<= :: UnitId -> UnitId -> Bool
$c> :: UnitId -> UnitId -> Bool
> :: UnitId -> UnitId -> Bool
$c>= :: UnitId -> UnitId -> Bool
>= :: UnitId -> UnitId -> Bool
$cmax :: UnitId -> UnitId -> UnitId
max :: UnitId -> UnitId -> UnitId
$cmin :: UnitId -> UnitId -> UnitId
min :: UnitId -> UnitId -> UnitId
Ord,Maybe UnitId
Value -> Parser [UnitId]
Value -> Parser UnitId
(Value -> Parser UnitId)
-> (Value -> Parser [UnitId]) -> Maybe UnitId -> FromJSON UnitId
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser UnitId
parseJSON :: Value -> Parser UnitId
$cparseJSONList :: Value -> Parser [UnitId]
parseJSONList :: Value -> Parser [UnitId]
$comittedField :: Maybe UnitId
omittedField :: Maybe UnitId
FromJSON,[UnitId] -> Encoding
[UnitId] -> Value
UnitId -> Bool
UnitId -> Encoding
UnitId -> Value
(UnitId -> Value)
-> (UnitId -> Encoding)
-> ([UnitId] -> Value)
-> ([UnitId] -> Encoding)
-> (UnitId -> Bool)
-> ToJSON UnitId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: UnitId -> Value
toJSON :: UnitId -> Value
$ctoEncoding :: UnitId -> Encoding
toEncoding :: UnitId -> Encoding
$ctoJSONList :: [UnitId] -> Value
toJSONList :: [UnitId] -> Value
$ctoEncodingList :: [UnitId] -> Encoding
toEncodingList :: [UnitId] -> Encoding
$comitField :: UnitId -> Bool
omitField :: UnitId -> Bool
ToJSON,FromJSONKeyFunction [UnitId]
FromJSONKeyFunction UnitId
FromJSONKeyFunction UnitId
-> FromJSONKeyFunction [UnitId] -> FromJSONKey UnitId
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: FromJSONKeyFunction UnitId
fromJSONKey :: FromJSONKeyFunction UnitId
$cfromJSONKeyList :: FromJSONKeyFunction [UnitId]
fromJSONKeyList :: FromJSONKeyFunction [UnitId]
FromJSONKey,ToJSONKeyFunction [UnitId]
ToJSONKeyFunction UnitId
ToJSONKeyFunction UnitId
-> ToJSONKeyFunction [UnitId] -> ToJSONKey UnitId
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction UnitId
toJSONKey :: ToJSONKeyFunction UnitId
$ctoJSONKeyList :: ToJSONKeyFunction [UnitId]
toJSONKeyList :: ToJSONKeyFunction [UnitId]
ToJSONKey)

-- | Equivalent to @Cabal@'s @Distribution.Package.PackageName@
newtype PkgName = PkgName Text
                deriving (Int -> PkgName -> ShowS
[PkgName] -> ShowS
PkgName -> [Char]
(Int -> PkgName -> ShowS)
-> (PkgName -> [Char]) -> ([PkgName] -> ShowS) -> Show PkgName
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PkgName -> ShowS
showsPrec :: Int -> PkgName -> ShowS
$cshow :: PkgName -> [Char]
show :: PkgName -> [Char]
$cshowList :: [PkgName] -> ShowS
showList :: [PkgName] -> ShowS
Show,PkgName -> PkgName -> Bool
(PkgName -> PkgName -> Bool)
-> (PkgName -> PkgName -> Bool) -> Eq PkgName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PkgName -> PkgName -> Bool
== :: PkgName -> PkgName -> Bool
$c/= :: PkgName -> PkgName -> Bool
/= :: PkgName -> PkgName -> Bool
Eq,Eq PkgName
Eq PkgName =>
(PkgName -> PkgName -> Ordering)
-> (PkgName -> PkgName -> Bool)
-> (PkgName -> PkgName -> Bool)
-> (PkgName -> PkgName -> Bool)
-> (PkgName -> PkgName -> Bool)
-> (PkgName -> PkgName -> PkgName)
-> (PkgName -> PkgName -> PkgName)
-> Ord PkgName
PkgName -> PkgName -> Bool
PkgName -> PkgName -> Ordering
PkgName -> PkgName -> PkgName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PkgName -> PkgName -> Ordering
compare :: PkgName -> PkgName -> Ordering
$c< :: PkgName -> PkgName -> Bool
< :: PkgName -> PkgName -> Bool
$c<= :: PkgName -> PkgName -> Bool
<= :: PkgName -> PkgName -> Bool
$c> :: PkgName -> PkgName -> Bool
> :: PkgName -> PkgName -> Bool
$c>= :: PkgName -> PkgName -> Bool
>= :: PkgName -> PkgName -> Bool
$cmax :: PkgName -> PkgName -> PkgName
max :: PkgName -> PkgName -> PkgName
$cmin :: PkgName -> PkgName -> PkgName
min :: PkgName -> PkgName -> PkgName
Ord,Maybe PkgName
Value -> Parser [PkgName]
Value -> Parser PkgName
(Value -> Parser PkgName)
-> (Value -> Parser [PkgName]) -> Maybe PkgName -> FromJSON PkgName
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser PkgName
parseJSON :: Value -> Parser PkgName
$cparseJSONList :: Value -> Parser [PkgName]
parseJSONList :: Value -> Parser [PkgName]
$comittedField :: Maybe PkgName
omittedField :: Maybe PkgName
FromJSON,[PkgName] -> Encoding
[PkgName] -> Value
PkgName -> Bool
PkgName -> Encoding
PkgName -> Value
(PkgName -> Value)
-> (PkgName -> Encoding)
-> ([PkgName] -> Value)
-> ([PkgName] -> Encoding)
-> (PkgName -> Bool)
-> ToJSON PkgName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: PkgName -> Value
toJSON :: PkgName -> Value
$ctoEncoding :: PkgName -> Encoding
toEncoding :: PkgName -> Encoding
$ctoJSONList :: [PkgName] -> Value
toJSONList :: [PkgName] -> Value
$ctoEncodingList :: [PkgName] -> Encoding
toEncodingList :: [PkgName] -> Encoding
$comitField :: PkgName -> Bool
omitField :: PkgName -> Bool
ToJSON,FromJSONKeyFunction [PkgName]
FromJSONKeyFunction PkgName
FromJSONKeyFunction PkgName
-> FromJSONKeyFunction [PkgName] -> FromJSONKey PkgName
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: FromJSONKeyFunction PkgName
fromJSONKey :: FromJSONKeyFunction PkgName
$cfromJSONKeyList :: FromJSONKeyFunction [PkgName]
fromJSONKeyList :: FromJSONKeyFunction [PkgName]
FromJSONKey,ToJSONKeyFunction [PkgName]
ToJSONKeyFunction PkgName
ToJSONKeyFunction PkgName
-> ToJSONKeyFunction [PkgName] -> ToJSONKey PkgName
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction PkgName
toJSONKey :: ToJSONKeyFunction PkgName
$ctoJSONKeyList :: ToJSONKeyFunction [PkgName]
toJSONKeyList :: ToJSONKeyFunction [PkgName]
ToJSONKey)

-- | Equivalent to @Cabal@'s @Distribution.Package.PackageIdentifier@
data PkgId = PkgId !PkgName !Ver
           deriving (Int -> PkgId -> ShowS
[PkgId] -> ShowS
PkgId -> [Char]
(Int -> PkgId -> ShowS)
-> (PkgId -> [Char]) -> ([PkgId] -> ShowS) -> Show PkgId
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PkgId -> ShowS
showsPrec :: Int -> PkgId -> ShowS
$cshow :: PkgId -> [Char]
show :: PkgId -> [Char]
$cshowList :: [PkgId] -> ShowS
showList :: [PkgId] -> ShowS
Show,PkgId -> PkgId -> Bool
(PkgId -> PkgId -> Bool) -> (PkgId -> PkgId -> Bool) -> Eq PkgId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PkgId -> PkgId -> Bool
== :: PkgId -> PkgId -> Bool
$c/= :: PkgId -> PkgId -> Bool
/= :: PkgId -> PkgId -> Bool
Eq,Eq PkgId
Eq PkgId =>
(PkgId -> PkgId -> Ordering)
-> (PkgId -> PkgId -> Bool)
-> (PkgId -> PkgId -> Bool)
-> (PkgId -> PkgId -> Bool)
-> (PkgId -> PkgId -> Bool)
-> (PkgId -> PkgId -> PkgId)
-> (PkgId -> PkgId -> PkgId)
-> Ord PkgId
PkgId -> PkgId -> Bool
PkgId -> PkgId -> Ordering
PkgId -> PkgId -> PkgId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PkgId -> PkgId -> Ordering
compare :: PkgId -> PkgId -> Ordering
$c< :: PkgId -> PkgId -> Bool
< :: PkgId -> PkgId -> Bool
$c<= :: PkgId -> PkgId -> Bool
<= :: PkgId -> PkgId -> Bool
$c> :: PkgId -> PkgId -> Bool
> :: PkgId -> PkgId -> Bool
$c>= :: PkgId -> PkgId -> Bool
>= :: PkgId -> PkgId -> Bool
$cmax :: PkgId -> PkgId -> PkgId
max :: PkgId -> PkgId -> PkgId
$cmin :: PkgId -> PkgId -> PkgId
min :: PkgId -> PkgId -> PkgId
Ord)

-- | Equivalent to @Cabal@'s @Distribution.PackageDescription.FlagName@
--
-- @since 0.3.0.0
newtype FlagName = FlagName Text
                 deriving (Int -> FlagName -> ShowS
[FlagName] -> ShowS
FlagName -> [Char]
(Int -> FlagName -> ShowS)
-> (FlagName -> [Char]) -> ([FlagName] -> ShowS) -> Show FlagName
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FlagName -> ShowS
showsPrec :: Int -> FlagName -> ShowS
$cshow :: FlagName -> [Char]
show :: FlagName -> [Char]
$cshowList :: [FlagName] -> ShowS
showList :: [FlagName] -> ShowS
Show,FlagName -> FlagName -> Bool
(FlagName -> FlagName -> Bool)
-> (FlagName -> FlagName -> Bool) -> Eq FlagName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FlagName -> FlagName -> Bool
== :: FlagName -> FlagName -> Bool
$c/= :: FlagName -> FlagName -> Bool
/= :: FlagName -> FlagName -> Bool
Eq,Eq FlagName
Eq FlagName =>
(FlagName -> FlagName -> Ordering)
-> (FlagName -> FlagName -> Bool)
-> (FlagName -> FlagName -> Bool)
-> (FlagName -> FlagName -> Bool)
-> (FlagName -> FlagName -> Bool)
-> (FlagName -> FlagName -> FlagName)
-> (FlagName -> FlagName -> FlagName)
-> Ord FlagName
FlagName -> FlagName -> Bool
FlagName -> FlagName -> Ordering
FlagName -> FlagName -> FlagName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FlagName -> FlagName -> Ordering
compare :: FlagName -> FlagName -> Ordering
$c< :: FlagName -> FlagName -> Bool
< :: FlagName -> FlagName -> Bool
$c<= :: FlagName -> FlagName -> Bool
<= :: FlagName -> FlagName -> Bool
$c> :: FlagName -> FlagName -> Bool
> :: FlagName -> FlagName -> Bool
$c>= :: FlagName -> FlagName -> Bool
>= :: FlagName -> FlagName -> Bool
$cmax :: FlagName -> FlagName -> FlagName
max :: FlagName -> FlagName -> FlagName
$cmin :: FlagName -> FlagName -> FlagName
min :: FlagName -> FlagName -> FlagName
Ord,Maybe FlagName
Value -> Parser [FlagName]
Value -> Parser FlagName
(Value -> Parser FlagName)
-> (Value -> Parser [FlagName])
-> Maybe FlagName
-> FromJSON FlagName
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser FlagName
parseJSON :: Value -> Parser FlagName
$cparseJSONList :: Value -> Parser [FlagName]
parseJSONList :: Value -> Parser [FlagName]
$comittedField :: Maybe FlagName
omittedField :: Maybe FlagName
FromJSON,[FlagName] -> Encoding
[FlagName] -> Value
FlagName -> Bool
FlagName -> Encoding
FlagName -> Value
(FlagName -> Value)
-> (FlagName -> Encoding)
-> ([FlagName] -> Value)
-> ([FlagName] -> Encoding)
-> (FlagName -> Bool)
-> ToJSON FlagName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: FlagName -> Value
toJSON :: FlagName -> Value
$ctoEncoding :: FlagName -> Encoding
toEncoding :: FlagName -> Encoding
$ctoJSONList :: [FlagName] -> Value
toJSONList :: [FlagName] -> Value
$ctoEncodingList :: [FlagName] -> Encoding
toEncodingList :: [FlagName] -> Encoding
$comitField :: FlagName -> Bool
omitField :: FlagName -> Bool
ToJSON,FromJSONKeyFunction [FlagName]
FromJSONKeyFunction FlagName
FromJSONKeyFunction FlagName
-> FromJSONKeyFunction [FlagName] -> FromJSONKey FlagName
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: FromJSONKeyFunction FlagName
fromJSONKey :: FromJSONKeyFunction FlagName
$cfromJSONKeyList :: FromJSONKeyFunction [FlagName]
fromJSONKeyList :: FromJSONKeyFunction [FlagName]
FromJSONKey,ToJSONKeyFunction [FlagName]
ToJSONKeyFunction FlagName
ToJSONKeyFunction FlagName
-> ToJSONKeyFunction [FlagName] -> ToJSONKey FlagName
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction FlagName
toJSONKey :: ToJSONKeyFunction FlagName
$ctoJSONKeyList :: ToJSONKeyFunction [FlagName]
toJSONKeyList :: ToJSONKeyFunction [FlagName]
ToJSONKey)

-- | <https://en.wikipedia.org/wiki/SHA-2 SHA-256> hash
newtype Sha256 = Sha256 B.ByteString -- internal invariant: exactly 32 bytes long
               deriving (Sha256 -> Sha256 -> Bool
(Sha256 -> Sha256 -> Bool)
-> (Sha256 -> Sha256 -> Bool) -> Eq Sha256
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sha256 -> Sha256 -> Bool
== :: Sha256 -> Sha256 -> Bool
$c/= :: Sha256 -> Sha256 -> Bool
/= :: Sha256 -> Sha256 -> Bool
Eq,Eq Sha256
Eq Sha256 =>
(Sha256 -> Sha256 -> Ordering)
-> (Sha256 -> Sha256 -> Bool)
-> (Sha256 -> Sha256 -> Bool)
-> (Sha256 -> Sha256 -> Bool)
-> (Sha256 -> Sha256 -> Bool)
-> (Sha256 -> Sha256 -> Sha256)
-> (Sha256 -> Sha256 -> Sha256)
-> Ord Sha256
Sha256 -> Sha256 -> Bool
Sha256 -> Sha256 -> Ordering
Sha256 -> Sha256 -> Sha256
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Sha256 -> Sha256 -> Ordering
compare :: Sha256 -> Sha256 -> Ordering
$c< :: Sha256 -> Sha256 -> Bool
< :: Sha256 -> Sha256 -> Bool
$c<= :: Sha256 -> Sha256 -> Bool
<= :: Sha256 -> Sha256 -> Bool
$c> :: Sha256 -> Sha256 -> Bool
> :: Sha256 -> Sha256 -> Bool
$c>= :: Sha256 -> Sha256 -> Bool
>= :: Sha256 -> Sha256 -> Bool
$cmax :: Sha256 -> Sha256 -> Sha256
max :: Sha256 -> Sha256 -> Sha256
$cmin :: Sha256 -> Sha256 -> Sha256
min :: Sha256 -> Sha256 -> Sha256
Ord)
-- | Equivalent to @Cabal@\'s @Distribution.Client.Types.PackageLocation@
--
-- @since 0.5.0.0
data PkgLoc
   = LocalUnpackedPackage    !FilePath
   | LocalTarballPackage     !FilePath
   | RemoteTarballPackage    !URI
   | RepoTarballPackage      !Repo
   | RemoteSourceRepoPackage !SourceRepo
     deriving (Int -> PkgLoc -> ShowS
[PkgLoc] -> ShowS
PkgLoc -> [Char]
(Int -> PkgLoc -> ShowS)
-> (PkgLoc -> [Char]) -> ([PkgLoc] -> ShowS) -> Show PkgLoc
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PkgLoc -> ShowS
showsPrec :: Int -> PkgLoc -> ShowS
$cshow :: PkgLoc -> [Char]
show :: PkgLoc -> [Char]
$cshowList :: [PkgLoc] -> ShowS
showList :: [PkgLoc] -> ShowS
Show,PkgLoc -> PkgLoc -> Bool
(PkgLoc -> PkgLoc -> Bool)
-> (PkgLoc -> PkgLoc -> Bool) -> Eq PkgLoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PkgLoc -> PkgLoc -> Bool
== :: PkgLoc -> PkgLoc -> Bool
$c/= :: PkgLoc -> PkgLoc -> Bool
/= :: PkgLoc -> PkgLoc -> Bool
Eq,Eq PkgLoc
Eq PkgLoc =>
(PkgLoc -> PkgLoc -> Ordering)
-> (PkgLoc -> PkgLoc -> Bool)
-> (PkgLoc -> PkgLoc -> Bool)
-> (PkgLoc -> PkgLoc -> Bool)
-> (PkgLoc -> PkgLoc -> Bool)
-> (PkgLoc -> PkgLoc -> PkgLoc)
-> (PkgLoc -> PkgLoc -> PkgLoc)
-> Ord PkgLoc
PkgLoc -> PkgLoc -> Bool
PkgLoc -> PkgLoc -> Ordering
PkgLoc -> PkgLoc -> PkgLoc
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PkgLoc -> PkgLoc -> Ordering
compare :: PkgLoc -> PkgLoc -> Ordering
$c< :: PkgLoc -> PkgLoc -> Bool
< :: PkgLoc -> PkgLoc -> Bool
$c<= :: PkgLoc -> PkgLoc -> Bool
<= :: PkgLoc -> PkgLoc -> Bool
$c> :: PkgLoc -> PkgLoc -> Bool
> :: PkgLoc -> PkgLoc -> Bool
$c>= :: PkgLoc -> PkgLoc -> Bool
>= :: PkgLoc -> PkgLoc -> Bool
$cmax :: PkgLoc -> PkgLoc -> PkgLoc
max :: PkgLoc -> PkgLoc -> PkgLoc
$cmin :: PkgLoc -> PkgLoc -> PkgLoc
min :: PkgLoc -> PkgLoc -> PkgLoc
Ord)

-- | Equivalent to @Cabal@\'s @Distribution.Types.SourceRepo@
--
-- @since 0.5.0.0
data Repo
   = RepoLocal  !FilePath
   | RepoRemote !URI
   | RepoSecure !URI
   | RepoLocalNoIndex !FilePath
     deriving (Int -> Repo -> ShowS
[Repo] -> ShowS
Repo -> [Char]
(Int -> Repo -> ShowS)
-> (Repo -> [Char]) -> ([Repo] -> ShowS) -> Show Repo
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Repo -> ShowS
showsPrec :: Int -> Repo -> ShowS
$cshow :: Repo -> [Char]
show :: Repo -> [Char]
$cshowList :: [Repo] -> ShowS
showList :: [Repo] -> ShowS
Show,Repo -> Repo -> Bool
(Repo -> Repo -> Bool) -> (Repo -> Repo -> Bool) -> Eq Repo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Repo -> Repo -> Bool
== :: Repo -> Repo -> Bool
$c/= :: Repo -> Repo -> Bool
/= :: Repo -> Repo -> Bool
Eq,Eq Repo
Eq Repo =>
(Repo -> Repo -> Ordering)
-> (Repo -> Repo -> Bool)
-> (Repo -> Repo -> Bool)
-> (Repo -> Repo -> Bool)
-> (Repo -> Repo -> Bool)
-> (Repo -> Repo -> Repo)
-> (Repo -> Repo -> Repo)
-> Ord Repo
Repo -> Repo -> Bool
Repo -> Repo -> Ordering
Repo -> Repo -> Repo
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Repo -> Repo -> Ordering
compare :: Repo -> Repo -> Ordering
$c< :: Repo -> Repo -> Bool
< :: Repo -> Repo -> Bool
$c<= :: Repo -> Repo -> Bool
<= :: Repo -> Repo -> Bool
$c> :: Repo -> Repo -> Bool
> :: Repo -> Repo -> Bool
$c>= :: Repo -> Repo -> Bool
>= :: Repo -> Repo -> Bool
$cmax :: Repo -> Repo -> Repo
max :: Repo -> Repo -> Repo
$cmin :: Repo -> Repo -> Repo
min :: Repo -> Repo -> Repo
Ord)

-- | Equivalent to @Cabal@\'s @Distribution.Client.Types.Repo@
--
-- @since 0.5.0.0
data SourceRepo = SourceRepo
     { SourceRepo -> Maybe RepoType
srType     :: !(Maybe RepoType)
     , SourceRepo -> Maybe Text
srLocation :: !(Maybe Text)
     , SourceRepo -> Maybe Text
srModule   :: !(Maybe Text)
     , SourceRepo -> Maybe Text
srBranch   :: !(Maybe Text)
     , SourceRepo -> Maybe Text
srTag      :: !(Maybe Text)
     , SourceRepo -> Maybe [Char]
srSubdir   :: !(Maybe FilePath)
     } deriving (Int -> SourceRepo -> ShowS
[SourceRepo] -> ShowS
SourceRepo -> [Char]
(Int -> SourceRepo -> ShowS)
-> (SourceRepo -> [Char])
-> ([SourceRepo] -> ShowS)
-> Show SourceRepo
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SourceRepo -> ShowS
showsPrec :: Int -> SourceRepo -> ShowS
$cshow :: SourceRepo -> [Char]
show :: SourceRepo -> [Char]
$cshowList :: [SourceRepo] -> ShowS
showList :: [SourceRepo] -> ShowS
Show,SourceRepo -> SourceRepo -> Bool
(SourceRepo -> SourceRepo -> Bool)
-> (SourceRepo -> SourceRepo -> Bool) -> Eq SourceRepo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SourceRepo -> SourceRepo -> Bool
== :: SourceRepo -> SourceRepo -> Bool
$c/= :: SourceRepo -> SourceRepo -> Bool
/= :: SourceRepo -> SourceRepo -> Bool
Eq,Eq SourceRepo
Eq SourceRepo =>
(SourceRepo -> SourceRepo -> Ordering)
-> (SourceRepo -> SourceRepo -> Bool)
-> (SourceRepo -> SourceRepo -> Bool)
-> (SourceRepo -> SourceRepo -> Bool)
-> (SourceRepo -> SourceRepo -> Bool)
-> (SourceRepo -> SourceRepo -> SourceRepo)
-> (SourceRepo -> SourceRepo -> SourceRepo)
-> Ord SourceRepo
SourceRepo -> SourceRepo -> Bool
SourceRepo -> SourceRepo -> Ordering
SourceRepo -> SourceRepo -> SourceRepo
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SourceRepo -> SourceRepo -> Ordering
compare :: SourceRepo -> SourceRepo -> Ordering
$c< :: SourceRepo -> SourceRepo -> Bool
< :: SourceRepo -> SourceRepo -> Bool
$c<= :: SourceRepo -> SourceRepo -> Bool
<= :: SourceRepo -> SourceRepo -> Bool
$c> :: SourceRepo -> SourceRepo -> Bool
> :: SourceRepo -> SourceRepo -> Bool
$c>= :: SourceRepo -> SourceRepo -> Bool
>= :: SourceRepo -> SourceRepo -> Bool
$cmax :: SourceRepo -> SourceRepo -> SourceRepo
max :: SourceRepo -> SourceRepo -> SourceRepo
$cmin :: SourceRepo -> SourceRepo -> SourceRepo
min :: SourceRepo -> SourceRepo -> SourceRepo
Ord)

-- | Represents an URI (used e.g. by 'Repo')
--
-- @since 0.5.0.0
newtype URI = URI Text
    deriving (Int -> URI -> ShowS
[URI] -> ShowS
URI -> [Char]
(Int -> URI -> ShowS)
-> (URI -> [Char]) -> ([URI] -> ShowS) -> Show URI
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> URI -> ShowS
showsPrec :: Int -> URI -> ShowS
$cshow :: URI -> [Char]
show :: URI -> [Char]
$cshowList :: [URI] -> ShowS
showList :: [URI] -> ShowS
Show,URI -> URI -> Bool
(URI -> URI -> Bool) -> (URI -> URI -> Bool) -> Eq URI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: URI -> URI -> Bool
== :: URI -> URI -> Bool
$c/= :: URI -> URI -> Bool
/= :: URI -> URI -> Bool
Eq,Eq URI
Eq URI =>
(URI -> URI -> Ordering)
-> (URI -> URI -> Bool)
-> (URI -> URI -> Bool)
-> (URI -> URI -> Bool)
-> (URI -> URI -> Bool)
-> (URI -> URI -> URI)
-> (URI -> URI -> URI)
-> Ord URI
URI -> URI -> Bool
URI -> URI -> Ordering
URI -> URI -> URI
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: URI -> URI -> Ordering
compare :: URI -> URI -> Ordering
$c< :: URI -> URI -> Bool
< :: URI -> URI -> Bool
$c<= :: URI -> URI -> Bool
<= :: URI -> URI -> Bool
$c> :: URI -> URI -> Bool
> :: URI -> URI -> Bool
$c>= :: URI -> URI -> Bool
>= :: URI -> URI -> Bool
$cmax :: URI -> URI -> URI
max :: URI -> URI -> URI
$cmin :: URI -> URI -> URI
min :: URI -> URI -> URI
Ord,Maybe URI
Value -> Parser [URI]
Value -> Parser URI
(Value -> Parser URI)
-> (Value -> Parser [URI]) -> Maybe URI -> FromJSON URI
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser URI
parseJSON :: Value -> Parser URI
$cparseJSONList :: Value -> Parser [URI]
parseJSONList :: Value -> Parser [URI]
$comittedField :: Maybe URI
omittedField :: Maybe URI
FromJSON,[URI] -> Encoding
[URI] -> Value
URI -> Bool
URI -> Encoding
URI -> Value
(URI -> Value)
-> (URI -> Encoding)
-> ([URI] -> Value)
-> ([URI] -> Encoding)
-> (URI -> Bool)
-> ToJSON URI
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: URI -> Value
toJSON :: URI -> Value
$ctoEncoding :: URI -> Encoding
toEncoding :: URI -> Encoding
$ctoJSONList :: [URI] -> Value
toJSONList :: [URI] -> Value
$ctoEncodingList :: [URI] -> Encoding
toEncodingList :: [URI] -> Encoding
$comitField :: URI -> Bool
omitField :: URI -> Bool
ToJSON,FromJSONKeyFunction [URI]
FromJSONKeyFunction URI
FromJSONKeyFunction URI
-> FromJSONKeyFunction [URI] -> FromJSONKey URI
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: FromJSONKeyFunction URI
fromJSONKey :: FromJSONKeyFunction URI
$cfromJSONKeyList :: FromJSONKeyFunction [URI]
fromJSONKeyList :: FromJSONKeyFunction [URI]
FromJSONKey,ToJSONKeyFunction [URI]
ToJSONKeyFunction URI
ToJSONKeyFunction URI -> ToJSONKeyFunction [URI] -> ToJSONKey URI
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction URI
toJSONKey :: ToJSONKeyFunction URI
$ctoJSONKeyList :: ToJSONKeyFunction [URI]
toJSONKeyList :: ToJSONKeyFunction [URI]
ToJSONKey)

-- | Equivalent to @Cabal@\'s @Distribution.Client.SourceRepo.RepoType@
--
-- @since 0.5.0.0
data RepoType
   = Darcs
   | Git
   | SVN
   | CVS
   | Mercurial
   | GnuArch
   | Bazaar
   | Monotone
   | OtherRepoType Text
     deriving (Int -> RepoType -> ShowS
[RepoType] -> ShowS
RepoType -> [Char]
(Int -> RepoType -> ShowS)
-> (RepoType -> [Char]) -> ([RepoType] -> ShowS) -> Show RepoType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RepoType -> ShowS
showsPrec :: Int -> RepoType -> ShowS
$cshow :: RepoType -> [Char]
show :: RepoType -> [Char]
$cshowList :: [RepoType] -> ShowS
showList :: [RepoType] -> ShowS
Show,RepoType -> RepoType -> Bool
(RepoType -> RepoType -> Bool)
-> (RepoType -> RepoType -> Bool) -> Eq RepoType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RepoType -> RepoType -> Bool
== :: RepoType -> RepoType -> Bool
$c/= :: RepoType -> RepoType -> Bool
/= :: RepoType -> RepoType -> Bool
Eq,Eq RepoType
Eq RepoType =>
(RepoType -> RepoType -> Ordering)
-> (RepoType -> RepoType -> Bool)
-> (RepoType -> RepoType -> Bool)
-> (RepoType -> RepoType -> Bool)
-> (RepoType -> RepoType -> Bool)
-> (RepoType -> RepoType -> RepoType)
-> (RepoType -> RepoType -> RepoType)
-> Ord RepoType
RepoType -> RepoType -> Bool
RepoType -> RepoType -> Ordering
RepoType -> RepoType -> RepoType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RepoType -> RepoType -> Ordering
compare :: RepoType -> RepoType -> Ordering
$c< :: RepoType -> RepoType -> Bool
< :: RepoType -> RepoType -> Bool
$c<= :: RepoType -> RepoType -> Bool
<= :: RepoType -> RepoType -> Bool
$c> :: RepoType -> RepoType -> Bool
> :: RepoType -> RepoType -> Bool
$c>= :: RepoType -> RepoType -> Bool
>= :: RepoType -> RepoType -> Bool
$cmax :: RepoType -> RepoType -> RepoType
max :: RepoType -> RepoType -> RepoType
$cmin :: RepoType -> RepoType -> RepoType
min :: RepoType -> RepoType -> RepoType
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
     { PlanJson -> Ver
pjCabalVersion    :: !Ver                     -- ^ Version of @cabal@ frontend
     , PlanJson -> Ver
pjCabalLibVersion :: !Ver                     -- ^ Version of Cabal library
     , PlanJson -> PkgId
pjCompilerId      :: !PkgId                   -- ^ Name and version of Haskell compiler
     , PlanJson -> Text
pjArch            :: !Text                    -- ^ Architecture name
     , PlanJson -> Text
pjOs              :: !Text                    -- ^ Operating system name
     , PlanJson -> Map UnitId Unit
pjUnits           :: !(M.Map UnitId Unit) -- ^ install/build plan
     } deriving Int -> PlanJson -> ShowS
[PlanJson] -> ShowS
PlanJson -> [Char]
(Int -> PlanJson -> ShowS)
-> (PlanJson -> [Char]) -> ([PlanJson] -> ShowS) -> Show PlanJson
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PlanJson -> ShowS
showsPrec :: Int -> PlanJson -> ShowS
$cshow :: PlanJson -> [Char]
show :: PlanJson -> [Char]
$cshowList :: [PlanJson] -> ShowS
showList :: [PlanJson] -> ShowS
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 (Int -> UnitType -> ShowS
[UnitType] -> ShowS
UnitType -> [Char]
(Int -> UnitType -> ShowS)
-> (UnitType -> [Char]) -> ([UnitType] -> ShowS) -> Show UnitType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnitType -> ShowS
showsPrec :: Int -> UnitType -> ShowS
$cshow :: UnitType -> [Char]
show :: UnitType -> [Char]
$cshowList :: [UnitType] -> ShowS
showList :: [UnitType] -> ShowS
Show,UnitType -> UnitType -> Bool
(UnitType -> UnitType -> Bool)
-> (UnitType -> UnitType -> Bool) -> Eq UnitType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnitType -> UnitType -> Bool
== :: UnitType -> UnitType -> Bool
$c/= :: UnitType -> UnitType -> Bool
/= :: UnitType -> UnitType -> Bool
Eq)

-- | Represents a build-plan unit uniquely identified by its 'UnitId'
data Unit = Unit
     { Unit -> UnitId
uId          :: !UnitId      -- ^ Unit ID uniquely identifying a 'Unit' in install plan
     , Unit -> PkgId
uPId         :: !PkgId       -- ^ Package name and version (not necessarily unique within plan)
     , Unit -> UnitType
uType        :: !UnitType      -- ^ Describes type of build item, see 'UnitType'
     , Unit -> Maybe Sha256
uSha256      :: !(Maybe Sha256) -- ^ SHA256 source tarball checksum (as used by e.g. @hackage-security@)
     , Unit -> Maybe Sha256
uCabalSha256 :: !(Maybe Sha256) -- ^ SHA256 package description metadata checksum
        --
        -- In other words, the checksum of the @.cabal@ file that was used as input to the build planning
        --
        -- __NOTE__: This meta-information is available only for 'pjCabalVersion' >= 2.4.1.0
        --
        -- @since 0.5.0.0
     , Unit -> Map CompName CompInfo
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.
     , Unit -> Map FlagName Bool
uFlags       :: !(Map FlagName Bool) -- ^ cabal flag settings (not available for 'UnitTypeBuiltin')
     , Unit -> Maybe [Char]
uDistDir     :: !(Maybe FilePath) -- ^ In-place dist-dir (if available)
                                     --
                                     -- @since 0.3.0.0
     , Unit -> Maybe PkgLoc
uPkgSrc      :: !(Maybe PkgLoc)
       -- ^ Source of the package
       --
       -- __NOTE__: This meta-information is available only for 'pjCabalVersion' >= 2.4.0.0
       --
       -- @since 0.5.0.0
     } deriving Int -> Unit -> ShowS
[Unit] -> ShowS
Unit -> [Char]
(Int -> Unit -> ShowS)
-> (Unit -> [Char]) -> ([Unit] -> ShowS) -> Show Unit
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Unit -> ShowS
showsPrec :: Int -> Unit -> ShowS
$cshow :: Unit -> [Char]
show :: Unit -> [Char]
$cshowList :: [Unit] -> ShowS
showList :: [Unit] -> ShowS
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 (Int -> CompName -> ShowS
[CompName] -> ShowS
CompName -> [Char]
(Int -> CompName -> ShowS)
-> (CompName -> [Char]) -> ([CompName] -> ShowS) -> Show CompName
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompName -> ShowS
showsPrec :: Int -> CompName -> ShowS
$cshow :: CompName -> [Char]
show :: CompName -> [Char]
$cshowList :: [CompName] -> ShowS
showList :: [CompName] -> ShowS
Show, CompName -> CompName -> Bool
(CompName -> CompName -> Bool)
-> (CompName -> CompName -> Bool) -> Eq CompName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompName -> CompName -> Bool
== :: CompName -> CompName -> Bool
$c/= :: CompName -> CompName -> Bool
/= :: CompName -> CompName -> Bool
Eq, Eq CompName
Eq CompName =>
(CompName -> CompName -> Ordering)
-> (CompName -> CompName -> Bool)
-> (CompName -> CompName -> Bool)
-> (CompName -> CompName -> Bool)
-> (CompName -> CompName -> Bool)
-> (CompName -> CompName -> CompName)
-> (CompName -> CompName -> CompName)
-> Ord CompName
CompName -> CompName -> Bool
CompName -> CompName -> Ordering
CompName -> CompName -> CompName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CompName -> CompName -> Ordering
compare :: CompName -> CompName -> Ordering
$c< :: CompName -> CompName -> Bool
< :: CompName -> CompName -> Bool
$c<= :: CompName -> CompName -> Bool
<= :: CompName -> CompName -> Bool
$c> :: CompName -> CompName -> Bool
> :: CompName -> CompName -> Bool
$c>= :: CompName -> CompName -> Bool
>= :: CompName -> CompName -> Bool
$cmax :: CompName -> CompName -> CompName
max :: CompName -> CompName -> CompName
$cmin :: CompName -> CompName -> CompName
min :: CompName -> CompName -> CompName
Ord)

-- | Describes component-specific information inside a 'Unit'
data CompInfo = CompInfo
    { CompInfo -> Set UnitId
ciLibDeps :: Set UnitId     -- ^ library dependencies
    , CompInfo -> Set UnitId
ciExeDeps :: Set UnitId     -- ^ executable dependencies
    , CompInfo -> Maybe [Char]
ciBinFile :: Maybe FilePath -- ^ path-name of artifact if available
    } deriving Int -> CompInfo -> ShowS
[CompInfo] -> ShowS
CompInfo -> [Char]
(Int -> CompInfo -> ShowS)
-> (CompInfo -> [Char]) -> ([CompInfo] -> ShowS) -> Show CompInfo
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompInfo -> ShowS
showsPrec :: Int -> CompInfo -> ShowS
$cshow :: CompInfo -> [Char]
show :: CompInfo -> [Char]
$cshowList :: [CompInfo] -> ShowS
showList :: [CompInfo] -> ShowS
Show

----------------------------------------------------------------------------
----------------------------------------------------------------------------
----------------------------------------------------------------------------

-- JSON instances

instance FromJSON CompName where
    parseJSON :: Value -> Parser CompName
parseJSON = [Char] -> (Text -> Parser CompName) -> Value -> Parser CompName
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"CompName" (Parser CompName
-> (CompName -> Parser CompName)
-> Maybe CompName
-> Parser CompName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Parser CompName
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"invalid CompName") CompName -> Parser CompName
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe CompName -> Parser CompName)
-> (Text -> Maybe CompName) -> Text -> Parser CompName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe CompName
parseCompName)

instance ToJSON CompName where
    toJSON :: CompName -> Value
toJSON     = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (CompName -> Text) -> CompName -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompName -> Text
dispCompName

instance FromJSONKey CompName where
    fromJSONKey :: FromJSONKeyFunction CompName
fromJSONKey = (Text -> Parser CompName) -> FromJSONKeyFunction CompName
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser (Parser CompName
-> (CompName -> Parser CompName)
-> Maybe CompName
-> Parser CompName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Parser CompName
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"CompName") CompName -> Parser CompName
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe CompName -> Parser CompName)
-> (Text -> Maybe CompName) -> Text -> Parser CompName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe CompName
parseCompName)

instance ToJSONKey   CompName where
    toJSONKey :: ToJSONKeyFunction CompName
toJSONKey = (CompName -> Text) -> ToJSONKeyFunction CompName
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText CompName -> Text
dispCompName

----

instance FromJSON CompInfo where
    parseJSON :: Value -> Parser CompInfo
parseJSON = [Char] -> (Object -> Parser CompInfo) -> Value -> Parser CompInfo
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"CompInfo" ((Object -> Parser CompInfo) -> Value -> Parser CompInfo)
-> (Object -> Parser CompInfo) -> Value -> Parser CompInfo
forall a b. (a -> b) -> a -> b
$ \Object
o ->
        Set UnitId -> Set UnitId -> Maybe [Char] -> CompInfo
CompInfo (Set UnitId -> Set UnitId -> Maybe [Char] -> CompInfo)
-> Parser (Set UnitId)
-> Parser (Set UnitId -> Maybe [Char] -> CompInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Set UnitId)
forall a. (FromJSON a, Monoid a) => Object -> Text -> Parser a
.:?! Text
"depends"
                 Parser (Set UnitId -> Maybe [Char] -> CompInfo)
-> Parser (Set UnitId) -> Parser (Maybe [Char] -> CompInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Set UnitId)
forall a. (FromJSON a, Monoid a) => Object -> Text -> Parser a
.:?! Text
"exe-depends"
                 Parser (Maybe [Char] -> CompInfo)
-> Parser (Maybe [Char]) -> Parser CompInfo
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe [Char])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"bin-file"

----

instance FromJSON PkgId where
    parseJSON :: Value -> Parser PkgId
parseJSON = [Char] -> (Text -> Parser PkgId) -> Value -> Parser PkgId
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"PkgId" (Parser PkgId
-> (PkgId -> Parser PkgId) -> Maybe PkgId -> Parser PkgId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Parser PkgId
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"invalid PkgId") PkgId -> Parser PkgId
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe PkgId -> Parser PkgId)
-> (Text -> Maybe PkgId) -> Text -> Parser PkgId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe PkgId
parsePkgId)

instance ToJSON PkgId where
    toJSON :: PkgId -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (PkgId -> Text) -> PkgId -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgId -> Text
dispPkgId

instance FromJSONKey PkgId where
    fromJSONKey :: FromJSONKeyFunction PkgId
fromJSONKey = (Text -> Parser PkgId) -> FromJSONKeyFunction PkgId
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser (Parser PkgId
-> (PkgId -> Parser PkgId) -> Maybe PkgId -> Parser PkgId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Parser PkgId
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"PkgId") PkgId -> Parser PkgId
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe PkgId -> Parser PkgId)
-> (Text -> Maybe PkgId) -> Text -> Parser PkgId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe PkgId
parsePkgId)

instance ToJSONKey PkgId where
    toJSONKey :: ToJSONKeyFunction PkgId
toJSONKey = (PkgId -> Text) -> ToJSONKeyFunction PkgId
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText PkgId -> Text
dispPkgId

----

instance FromJSON PkgLoc where
    parseJSON :: Value -> Parser PkgLoc
parseJSON = [Char] -> (Object -> Parser PkgLoc) -> Value -> Parser PkgLoc
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"PkgSrc" ((Object -> Parser PkgLoc) -> Value -> Parser PkgLoc)
-> (Object -> Parser PkgLoc) -> Value -> Parser PkgLoc
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
ty <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
        case Text
ty :: Text of
          Text
"local"       -> [Char] -> PkgLoc
LocalUnpackedPackage    ([Char] -> PkgLoc) -> Parser [Char] -> Parser PkgLoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser [Char]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"path"
          Text
"local-tar"   -> [Char] -> PkgLoc
LocalTarballPackage     ([Char] -> PkgLoc) -> Parser [Char] -> Parser PkgLoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser [Char]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"path"
          Text
"remote-tar"  -> URI -> PkgLoc
RemoteTarballPackage    (URI -> PkgLoc) -> Parser URI -> Parser PkgLoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser URI
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"uri"
          Text
"repo-tar"    -> Repo -> PkgLoc
RepoTarballPackage      (Repo -> PkgLoc) -> Parser Repo -> Parser PkgLoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Repo
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"repo"
          Text
"source-repo" -> SourceRepo -> PkgLoc
RemoteSourceRepoPackage (SourceRepo -> PkgLoc) -> Parser SourceRepo -> Parser PkgLoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser SourceRepo
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"source-repo"
          Text
_             -> [Char] -> Parser PkgLoc
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"invalid PkgSrc \"type\""

instance FromJSON Repo where
    parseJSON :: Value -> Parser Repo
parseJSON = [Char] -> (Object -> Parser Repo) -> Value -> Parser Repo
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"Repo" ((Object -> Parser Repo) -> Value -> Parser Repo)
-> (Object -> Parser Repo) -> Value -> Parser Repo
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
ty <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
        case Text
ty :: Text of
          Text
"local-repo"          -> [Char] -> Repo
RepoLocal        ([Char] -> Repo) -> Parser [Char] -> Parser Repo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser [Char]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"path"
          Text
"remote-repo"         -> URI -> Repo
RepoRemote       (URI -> Repo) -> Parser URI -> Parser Repo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser URI
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"uri"
          Text
"secure-repo"         -> URI -> Repo
RepoSecure       (URI -> Repo) -> Parser URI -> Parser Repo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser URI
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"uri"
          Text
"local-repo-no-index" -> [Char] -> Repo
RepoLocalNoIndex ([Char] -> Repo) -> Parser [Char] -> Parser Repo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser [Char]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"path"
          Text
_                     -> [Char] -> Parser Repo
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"invalid Repo \"type\""

instance FromJSON SourceRepo where
    parseJSON :: Value -> Parser SourceRepo
parseJSON = [Char]
-> (Object -> Parser SourceRepo) -> Value -> Parser SourceRepo
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"SourceRepo" ((Object -> Parser SourceRepo) -> Value -> Parser SourceRepo)
-> (Object -> Parser SourceRepo) -> Value -> Parser SourceRepo
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Maybe RepoType
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe [Char]
-> SourceRepo
SourceRepo (Maybe RepoType
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe [Char]
 -> SourceRepo)
-> Parser (Maybe RepoType)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Char]
      -> SourceRepo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe RepoType)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"type"
                   Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Char]
   -> SourceRepo)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text -> Maybe Text -> Maybe [Char] -> SourceRepo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"location"
                   Parser
  (Maybe Text
   -> Maybe Text -> Maybe Text -> Maybe [Char] -> SourceRepo)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> Maybe [Char] -> SourceRepo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"module"
                   Parser (Maybe Text -> Maybe Text -> Maybe [Char] -> SourceRepo)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe [Char] -> SourceRepo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"branch"
                   Parser (Maybe Text -> Maybe [Char] -> SourceRepo)
-> Parser (Maybe Text) -> Parser (Maybe [Char] -> SourceRepo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tag"
                   Parser (Maybe [Char] -> SourceRepo)
-> Parser (Maybe [Char]) -> Parser SourceRepo
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe [Char])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"subdir"

instance FromJSON RepoType where
    parseJSON :: Value -> Parser RepoType
parseJSON = [Char] -> (Text -> Parser RepoType) -> Value -> Parser RepoType
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"RepoType" ((Text -> Parser RepoType) -> Value -> Parser RepoType)
-> (Text -> Parser RepoType) -> Value -> Parser RepoType
forall a b. (a -> b) -> a -> b
$ \Text
ty -> RepoType -> Parser RepoType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (RepoType -> Parser RepoType) -> RepoType -> Parser RepoType
forall a b. (a -> b) -> a -> b
$
        case Text
ty of
          Text
"darcs"     -> RepoType
Darcs
          Text
"git"       -> RepoType
Git
          Text
"svn"       -> RepoType
SVN
          Text
"cvs"       -> RepoType
CVS
          Text
"mercurial" -> RepoType
Mercurial
          Text
"gnuarch"   -> RepoType
GnuArch
          Text
"bazaar"    -> RepoType
Bazaar
          Text
"monotone"  -> RepoType
Monotone
          Text
_           -> Text -> RepoType
OtherRepoType Text
ty

----------------------------------------------------------------------------
-- parser helpers

parseCompName :: Text -> Maybe CompName
parseCompName :: Text -> Maybe CompName
parseCompName Text
t0 = case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
":" Text
t0 of
                     [Text
"lib"]     -> CompName -> Maybe CompName
forall a. a -> Maybe a
Just CompName
CompNameLib
                     [Text
"lib",Text
n]   -> CompName -> Maybe CompName
forall a. a -> Maybe a
Just (CompName -> Maybe CompName) -> CompName -> Maybe CompName
forall a b. (a -> b) -> a -> b
$! Text -> CompName
CompNameSubLib Text
n
                     [Text
"flib",Text
n]  -> CompName -> Maybe CompName
forall a. a -> Maybe a
Just (CompName -> Maybe CompName) -> CompName -> Maybe CompName
forall a b. (a -> b) -> a -> b
$! Text -> CompName
CompNameFLib Text
n
                     [Text
"exe",Text
n]   -> CompName -> Maybe CompName
forall a. a -> Maybe a
Just (CompName -> Maybe CompName) -> CompName -> Maybe CompName
forall a b. (a -> b) -> a -> b
$! Text -> CompName
CompNameExe Text
n
                     [Text
"bench",Text
n] -> CompName -> Maybe CompName
forall a. a -> Maybe a
Just (CompName -> Maybe CompName) -> CompName -> Maybe CompName
forall a b. (a -> b) -> a -> b
$! Text -> CompName
CompNameBench Text
n
                     [Text
"test",Text
n]  -> CompName -> Maybe CompName
forall a. a -> Maybe a
Just (CompName -> Maybe CompName) -> CompName -> Maybe CompName
forall a b. (a -> b) -> a -> b
$! Text -> CompName
CompNameTest Text
n
                     [Text
"setup"]   -> CompName -> Maybe CompName
forall a. a -> Maybe a
Just CompName
CompNameSetup
                     [Text]
_           -> Maybe CompName
forall a. Maybe a
Nothing

-- | Pretty print 'CompName' in cabal's target-selector syntax.
--
-- @since 0.5.0.0
dispCompNameTarget :: PkgName -> CompName -> Text
dispCompNameTarget :: PkgName -> CompName -> Text
dispCompNameTarget (PkgName Text
pkg) CompName
cn = case CompName
cn of
    CompName
CompNameLib -> Text
"lib:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pkg
    CompName
_           -> CompName -> Text
dispCompName CompName
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 :: CompName -> Text
dispCompName CompName
cn = case CompName
cn of
    CompName
CompNameLib      -> Text
"lib"
    CompNameSubLib Text
n -> Text
"lib:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n
    CompNameFLib Text
n   -> Text
"flib:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n
    CompNameExe Text
n    -> Text
"exe:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n
    CompNameBench Text
n  -> Text
"bench:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n
    CompNameTest Text
n   -> Text
"test:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n
    CompName
CompNameSetup    -> Text
"setup"

instance FromJSON PlanJson where
    parseJSON :: Value -> Parser PlanJson
parseJSON = [Char] -> (Object -> Parser PlanJson) -> Value -> Parser PlanJson
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"PlanJson" ((Object -> Parser PlanJson) -> Value -> Parser PlanJson)
-> (Object -> Parser PlanJson) -> Value -> Parser PlanJson
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Ver
pjCabalVersion    <- Object
o Object -> Key -> Parser Ver
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cabal-version"

        Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Ver
pjCabalVersion Ver -> Ver -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Ver
Ver [Int
2]) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
            [Char] -> Parser ()
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"plan.json version " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack (Ver -> Text
dispVer Ver
pjCabalVersion) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" not supported")

        Ver
pjCabalLibVersion <- Object
o Object -> Key -> Parser Ver
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cabal-lib-version"
        PkgId
pjCompilerId      <- Object
o Object -> Key -> Parser PkgId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"compiler-id"
        Text
pjArch            <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"arch"
        Text
pjOs              <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"os"
        Map UnitId Unit
pjUnits           <- [Unit] -> Parser (Map UnitId Unit)
forall {m :: * -> *}. MonadFail m => [Unit] -> m (Map UnitId Unit)
toMap ([Unit] -> Parser (Map UnitId Unit))
-> Parser [Unit] -> Parser (Map UnitId Unit)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Key -> Parser [Unit]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"install-plan"

        PlanJson -> Parser PlanJson
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
App.pure PlanJson{Text
Map UnitId Unit
PkgId
Ver
pjCabalVersion :: Ver
pjCabalLibVersion :: Ver
pjCompilerId :: PkgId
pjArch :: Text
pjOs :: Text
pjUnits :: Map UnitId Unit
pjCabalVersion :: Ver
pjCabalLibVersion :: Ver
pjCompilerId :: PkgId
pjArch :: Text
pjOs :: Text
pjUnits :: Map UnitId Unit
..}
      where
        toMap :: [Unit] -> m (Map UnitId Unit)
toMap [Unit]
pil = do
            let pim :: Map UnitId Unit
pim = [(UnitId, Unit)] -> Map UnitId Unit
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ (Unit -> UnitId
uId Unit
pi',Unit
pi') | Unit
pi' <- [Unit]
pil ]
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Map UnitId Unit -> Int
forall k a. Map k a -> Int
M.size Map UnitId Unit
pim Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Unit] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Unit]
pil) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                [Char] -> m ()
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"install-plan[] has duplicate ids"
            Map UnitId Unit -> m (Map UnitId Unit)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map UnitId Unit
pim

(.:?!) :: (FromJSON a, Monoid a) => Object -> Text -> Parser a
Object
o .:?! :: forall a. (FromJSON a, Monoid a) => Object -> Text -> Parser a
.:?! Text
fld = Object
o Object -> Key -> Parser (Maybe a)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Text -> Key
fT Text
fld Parser (Maybe a) -> a -> Parser a
forall a. Parser (Maybe a) -> a -> Parser a
.!= a
forall a. Monoid a => a
Data.Monoid.mempty
  where
#if MIN_VERSION_aeson(2,0,0)
    fT :: Text -> Key
fT = Text -> Key
AK.fromText
#else
    fT = id   
#endif

planItemAllDeps :: Unit -> Set UnitId
planItemAllDeps :: Unit -> Set UnitId
planItemAllDeps Unit{Maybe [Char]
Maybe PkgLoc
Maybe Sha256
Map CompName CompInfo
Map FlagName Bool
UnitType
PkgId
UnitId
uId :: Unit -> UnitId
uPId :: Unit -> PkgId
uType :: Unit -> UnitType
uSha256 :: Unit -> Maybe Sha256
uCabalSha256 :: Unit -> Maybe Sha256
uComps :: Unit -> Map CompName CompInfo
uFlags :: Unit -> Map FlagName Bool
uDistDir :: Unit -> Maybe [Char]
uPkgSrc :: Unit -> Maybe PkgLoc
uId :: UnitId
uPId :: PkgId
uType :: UnitType
uSha256 :: Maybe Sha256
uCabalSha256 :: Maybe Sha256
uComps :: Map CompName CompInfo
uFlags :: Map FlagName Bool
uDistDir :: Maybe [Char]
uPkgSrc :: Maybe PkgLoc
..} = [Set UnitId] -> Set UnitId
forall a. Monoid a => [a] -> a
mconcat [ Set UnitId
ciLibDeps Set UnitId -> Set UnitId -> Set UnitId
forall a. Semigroup a => a -> a -> a
<> Set UnitId
ciExeDeps | CompInfo{Maybe [Char]
Set UnitId
ciLibDeps :: CompInfo -> Set UnitId
ciExeDeps :: CompInfo -> Set UnitId
ciBinFile :: CompInfo -> Maybe [Char]
ciLibDeps :: Set UnitId
ciExeDeps :: Set UnitId
ciBinFile :: Maybe [Char]
..} <- Map CompName CompInfo -> [CompInfo]
forall k a. Map k a -> [a]
M.elems Map CompName CompInfo
uComps ]

instance FromJSON Unit where
    parseJSON :: Value -> Parser Unit
parseJSON = [Char] -> (Object -> Parser Unit) -> Value -> Parser Unit
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"Unit" ((Object -> Parser Unit) -> Value -> Parser Unit)
-> (Object -> Parser Unit) -> Value -> Parser Unit
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Maybe (Map CompName CompInfo)
mcomponents    <- Object
o Object -> Key -> Parser (Maybe (Map CompName CompInfo))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"components"
        Maybe CompName
mcomponentname <- Object
o Object -> Key -> Parser (Maybe CompName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"component-name"
        Text
ty             <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"type"
        Maybe Text
mstyle         <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"style"

        UnitId
uId     <- Object
o Object -> Key -> Parser UnitId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
        PkgId
uPId    <- PkgName -> Ver -> PkgId
PkgId (PkgName -> Ver -> PkgId)
-> Parser PkgName -> Parser (Ver -> PkgId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser PkgName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pkg-name" Parser (Ver -> PkgId) -> Parser Ver -> Parser PkgId
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Ver
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pkg-version"
        UnitType
uType   <- case (Text
ty :: Text, Maybe Text
mstyle :: Maybe Text) of
                   (Text
"pre-existing",Maybe Text
Nothing)      -> UnitType -> Parser UnitType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UnitType
UnitTypeBuiltin
                   (Text
"configured",Just Text
"global")  -> UnitType -> Parser UnitType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UnitType
UnitTypeGlobal
                   (Text
"configured",Just Text
"local")   -> UnitType -> Parser UnitType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UnitType
UnitTypeLocal
                   (Text
"configured",Just Text
"inplace") -> UnitType -> Parser UnitType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UnitType
UnitTypeInplace
                   (Text, Maybe Text)
_                             -> [Char] -> Parser UnitType
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ((Text, Maybe Text) -> [Char]
forall a. Show a => a -> [Char]
show (Text
ty,Maybe Text
mstyle))
        Map FlagName Bool
uFlags  <- Object
o Object -> Text -> Parser (Map FlagName Bool)
forall a. (FromJSON a, Monoid a) => Object -> Text -> Parser a
.:?! Text
"flags"
        Maybe Sha256
uSha256 <- Object
o Object -> Key -> Parser (Maybe Sha256)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"pkg-src-sha256"
        Maybe Sha256
uCabalSha256 <- Object
o Object -> Key -> Parser (Maybe Sha256)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"pkg-cabal-sha256"
        Map CompName CompInfo
uComps  <- case (Maybe (Map CompName CompInfo)
mcomponents, Maybe CompName
mcomponentname) of
          (Just Map CompName CompInfo
comps0, Maybe CompName
Nothing) ->
              Map CompName CompInfo -> Parser (Map CompName CompInfo)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map CompName CompInfo
comps0
          (Maybe (Map CompName CompInfo)
Nothing, Just CompName
cname) ->
              CompName -> CompInfo -> Map CompName CompInfo
forall k a. k -> a -> Map k a
M.singleton CompName
cname (CompInfo -> Map CompName CompInfo)
-> Parser CompInfo -> Parser (Map CompName CompInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser CompInfo
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
          (Maybe (Map CompName CompInfo)
Nothing, Maybe CompName
Nothing) | UnitType
uType UnitType -> UnitType -> Bool
forall a. Eq a => a -> a -> Bool
== UnitType
UnitTypeBuiltin ->
              CompName -> CompInfo -> Map CompName CompInfo
forall k a. k -> a -> Map k a
M.singleton CompName
CompNameLib (CompInfo -> Map CompName CompInfo)
-> Parser CompInfo -> Parser (Map CompName CompInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser CompInfo
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
          (Maybe (Map CompName CompInfo), Maybe CompName)
_ -> [Char] -> Parser (Map CompName CompInfo)
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail (Object -> [Char]
forall a. Show a => a -> [Char]
show Object
o)

        Maybe [Char]
uDistDir <- Object
o Object -> Key -> Parser (Maybe [Char])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"dist-dir"

        Maybe PkgLoc
uPkgSrc <- Object
o Object -> Key -> Parser (Maybe PkgLoc)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"pkg-src"

        Unit -> Parser Unit
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Unit{Maybe [Char]
Maybe PkgLoc
Maybe Sha256
Map CompName CompInfo
Map FlagName Bool
UnitType
PkgId
UnitId
uId :: UnitId
uPId :: PkgId
uType :: UnitType
uSha256 :: Maybe Sha256
uCabalSha256 :: Maybe Sha256
uComps :: Map CompName CompInfo
uFlags :: Map FlagName Bool
uDistDir :: Maybe [Char]
uPkgSrc :: Maybe PkgLoc
uId :: UnitId
uPId :: PkgId
uType :: UnitType
uFlags :: Map FlagName Bool
uSha256 :: Maybe Sha256
uCabalSha256 :: Maybe Sha256
uComps :: Map CompName CompInfo
uDistDir :: Maybe [Char]
uPkgSrc :: Maybe PkgLoc
..}

----------------------------------------------------------------------------
-- 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.
    | ExactPath FilePath            -- ^ Exact location of plan.json
    deriving (SearchPlanJson -> SearchPlanJson -> Bool
(SearchPlanJson -> SearchPlanJson -> Bool)
-> (SearchPlanJson -> SearchPlanJson -> Bool) -> Eq SearchPlanJson
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SearchPlanJson -> SearchPlanJson -> Bool
== :: SearchPlanJson -> SearchPlanJson -> Bool
$c/= :: SearchPlanJson -> SearchPlanJson -> Bool
/= :: SearchPlanJson -> SearchPlanJson -> Bool
Eq, Int -> SearchPlanJson -> ShowS
[SearchPlanJson] -> ShowS
SearchPlanJson -> [Char]
(Int -> SearchPlanJson -> ShowS)
-> (SearchPlanJson -> [Char])
-> ([SearchPlanJson] -> ShowS)
-> Show SearchPlanJson
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SearchPlanJson -> ShowS
showsPrec :: Int -> SearchPlanJson -> ShowS
$cshow :: SearchPlanJson -> [Char]
show :: SearchPlanJson -> [Char]
$cshowList :: [SearchPlanJson] -> ShowS
showList :: [SearchPlanJson] -> ShowS
Show, ReadPrec [SearchPlanJson]
ReadPrec SearchPlanJson
Int -> ReadS SearchPlanJson
ReadS [SearchPlanJson]
(Int -> ReadS SearchPlanJson)
-> ReadS [SearchPlanJson]
-> ReadPrec SearchPlanJson
-> ReadPrec [SearchPlanJson]
-> Read SearchPlanJson
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SearchPlanJson
readsPrec :: Int -> ReadS SearchPlanJson
$creadList :: ReadS [SearchPlanJson]
readList :: ReadS [SearchPlanJson]
$creadPrec :: ReadPrec SearchPlanJson
readPrec :: ReadPrec SearchPlanJson
$creadListPrec :: ReadPrec [SearchPlanJson]
readListPrec :: ReadPrec [SearchPlanJson]
Read)

-- | Find and decode @plan.json@.
--
-- See 'findPlanJson' and 'decodePlanJson'.
--
findAndDecodePlanJson
    :: SearchPlanJson
    -> IO PlanJson
findAndDecodePlanJson :: SearchPlanJson -> IO PlanJson
findAndDecodePlanJson SearchPlanJson
searchLoc = SearchPlanJson -> IO [Char]
findPlanJson SearchPlanJson
searchLoc IO [Char] -> ([Char] -> IO PlanJson) -> IO PlanJson
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> IO PlanJson
decodePlanJson

-- | Find @plan.json@.
--
-- When 'ProjectRelativeToDir' is passed 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.
--
-- 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.
--
-- @since 0.6.2.0
--
findPlanJson
    :: SearchPlanJson
    -> IO FilePath
findPlanJson :: SearchPlanJson -> IO [Char]
findPlanJson SearchPlanJson
searchLoc = do
    [Char]
planJsonFn <- case SearchPlanJson
searchLoc of
        ExactPath [Char]
fp -> [Char] -> IO [Char]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
fp
        InBuildDir [Char]
builddir -> [Char] -> IO [Char]
fromBuilddir [Char]
builddir
        ProjectRelativeToDir [Char]
fp -> do
            Maybe [Char]
mRoot <- [Char] -> IO (Maybe [Char])
findProjectRoot [Char]
fp
            case Maybe [Char]
mRoot of
                Maybe [Char]
Nothing  -> [Char] -> IO [Char]
forall a. [Char] -> IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"missing project root relative to: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
fp)
                Just [Char]
dir -> [Char] -> IO [Char]
fromBuilddir ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
dir [Char] -> ShowS
</> [Char]
"dist-newstyle"

    Bool
havePlanJson <- [Char] -> IO Bool
Dir.doesFileExist [Char]
planJsonFn

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
havePlanJson (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        [Char] -> IO ()
forall a. [Char] -> IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"missing 'plan.json' file; do you need to run 'cabal new-build'?"

    [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
planJsonFn  
  where
    fromBuilddir :: [Char] -> IO [Char]
fromBuilddir [Char]
distFolder = do
        Bool
haveDistFolder <- [Char] -> IO Bool
Dir.doesDirectoryExist [Char]
distFolder

        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
haveDistFolder (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            [Char] -> IO ()
forall a. [Char] -> IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"missing " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show [Char]
distFolder [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" folder; do you need to run 'cabal new-build'?")

        [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
distFolder [Char] -> ShowS
</> [Char]
"cache" [Char] -> ShowS
</> [Char]
"plan.json"

-- | 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 :: [Char] -> IO PlanJson
decodePlanJson [Char]
planJsonFn = do
    ByteString
jsraw <- [Char] -> IO ByteString
B.readFile [Char]
planJsonFn
    ([Char] -> IO PlanJson)
-> (PlanJson -> IO PlanJson)
-> Either [Char] PlanJson
-> IO PlanJson
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> IO PlanJson
forall a. [Char] -> IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail PlanJson -> IO PlanJson
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [Char] PlanJson -> IO PlanJson)
-> Either [Char] PlanJson -> IO PlanJson
forall a b. (a -> b) -> a -> b
$ ByteString -> Either [Char] PlanJson
forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecodeStrict' ByteString
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 :: [Char] -> IO (Maybe [Char])
findProjectRoot [Char]
dir = do
    [Char]
normalisedPath <- [Char] -> IO [Char]
Dir.canonicalizePath [Char]
dir
    let checkCabalProject :: [Char] -> IO (Maybe [Char])
checkCabalProject [Char]
d = do
            Bool
ex <- [Char] -> IO Bool
Dir.doesFileExist [Char]
fn
            Maybe [Char] -> IO (Maybe [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Char] -> IO (Maybe [Char]))
-> Maybe [Char] -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ if Bool
ex then [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
d else Maybe [Char]
forall a. Maybe a
Nothing
          where
            fn :: [Char]
fn = [Char]
d [Char] -> ShowS
</> [Char]
"cabal.project"

        checkCabal :: [Char] -> IO (Maybe [Char])
checkCabal [Char]
d = do
            [[Char]]
files <- [Char] -> IO [[Char]]
listDirectory [Char]
d
            Maybe [Char] -> IO (Maybe [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Char] -> IO (Maybe [Char]))
-> Maybe [Char] -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ if ([Char] -> Bool) -> [[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ([Char] -> [Char] -> Bool
isExtensionOf [Char]
".cabal") [[Char]]
files
                        then [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
d
                        else Maybe [Char]
forall a. Maybe a
Nothing

    Maybe [Char]
result <- ([Char] -> IO (Maybe [Char])) -> [Char] -> IO (Maybe [Char])
forall a. ([Char] -> IO (Maybe a)) -> [Char] -> IO (Maybe a)
walkUpFolders [Char] -> IO (Maybe [Char])
checkCabalProject [Char]
normalisedPath
    case Maybe [Char]
result of
        Just [Char]
rootDir -> Maybe [Char] -> IO (Maybe [Char])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Char] -> IO (Maybe [Char]))
-> Maybe [Char] -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
rootDir
        Maybe [Char]
Nothing      -> ([Char] -> IO (Maybe [Char])) -> [Char] -> IO (Maybe [Char])
forall a. ([Char] -> IO (Maybe a)) -> [Char] -> IO (Maybe a)
walkUpFolders [Char] -> IO (Maybe [Char])
checkCabal [Char]
normalisedPath
  where
    isExtensionOf :: String -> FilePath -> Bool
    isExtensionOf :: [Char] -> [Char] -> Bool
isExtensionOf [Char]
ext [Char]
fp = [Char]
ext [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== ShowS
takeExtension [Char]
fp

    listDirectory :: FilePath -> IO [FilePath]
    listDirectory :: [Char] -> IO [[Char]]
listDirectory [Char]
fp = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter [Char] -> Bool
forall {a}. (Eq a, IsString a) => a -> Bool
isSpecialDir ([[Char]] -> [[Char]]) -> IO [[Char]] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [[Char]]
Dir.getDirectoryContents [Char]
fp
      where
        isSpecialDir :: a -> Bool
isSpecialDir a
f = a
f a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
"." Bool -> Bool -> Bool
&& a
f a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
".."

walkUpFolders
    :: (FilePath -> IO (Maybe a)) -> FilePath -> IO (Maybe a)
walkUpFolders :: forall a. ([Char] -> IO (Maybe a)) -> [Char] -> IO (Maybe a)
walkUpFolders [Char] -> IO (Maybe a)
dtest [Char]
d0 = do
    [Char]
home <- IO [Char]
Dir.getHomeDirectory

    let go :: [Char] -> IO (Maybe a)
go [Char]
d | [Char]
d [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
home  = Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
             | [Char] -> Bool
isDrive [Char]
d  = Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
             | Bool
otherwise  = do
                   Maybe a
t <- [Char] -> IO (Maybe a)
dtest [Char]
d
                   case Maybe a
t of
                     Maybe a
Nothing  -> [Char] -> IO (Maybe a)
go ([Char] -> IO (Maybe a)) -> [Char] -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ ShowS
takeDirectory [Char]
d
                     x :: Maybe a
x@Just{} -> Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
x

    [Char] -> IO (Maybe a)
go [Char]
d0

parseVer :: Text -> Maybe Ver
parseVer :: Text -> Maybe Ver
parseVer Text
str = case [(Version, [Char])] -> [(Version, [Char])]
forall a. [a] -> [a]
reverse ([(Version, [Char])] -> [(Version, [Char])])
-> [(Version, [Char])] -> [(Version, [Char])]
forall a b. (a -> b) -> a -> b
$ ReadP Version -> ReadS Version
forall a. ReadP a -> ReadS a
readP_to_S ReadP Version
DV.parseVersion (Text -> [Char]
T.unpack Text
str) of
  (Version
ver, [Char]
"") : [(Version, [Char])]
_ | Bool -> Bool
not ([Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Version -> [Int]
DV.versionBranch Version
ver)), (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (Version -> [Int]
DV.versionBranch Version
ver)
      -> Ver -> Maybe Ver
forall a. a -> Maybe a
Just ([Int] -> Ver
Ver ([Int] -> Ver) -> [Int] -> Ver
forall a b. (a -> b) -> a -> b
$ Version -> [Int]
DV.versionBranch Version
ver)
  [(Version, [Char])]
_   -> Maybe Ver
forall a. Maybe a
Nothing

-- | Pretty print 'Ver'
dispVer :: Ver -> Text
dispVer :: Ver -> Text
dispVer (Ver [Int]
ns) = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"." ((Int -> [Char]) -> [Int] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Int -> [Char]
forall a. Show a => a -> [Char]
show [Int]
ns)

instance FromJSON Ver where
    parseJSON :: Value -> Parser Ver
parseJSON = [Char] -> (Text -> Parser Ver) -> Value -> Parser Ver
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"Ver" (Parser Ver -> (Ver -> Parser Ver) -> Maybe Ver -> Parser Ver
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Parser Ver
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Ver") Ver -> Parser Ver
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Ver -> Parser Ver)
-> (Text -> Maybe Ver) -> Text -> Parser Ver
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Ver
parseVer)

instance ToJSON Ver where
    toJSON :: Ver -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (Ver -> Text) -> Ver -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ver -> Text
dispVer

parsePkgId :: Text -> Maybe PkgId
parsePkgId :: Text -> Maybe PkgId
parsePkgId Text
t = do
  let (Text
pns_, Text
pvs) = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOnEnd Text
"-" Text
t
  Ver
pv <- Text -> Maybe Ver
parseVer Text
pvs

  Text
pn <- Text -> Text -> Maybe Text
T.stripSuffix Text
"-" Text
pns_

  -- TODO: validate pn
  PkgId -> Maybe PkgId
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PkgName -> Ver -> PkgId
PkgId (Text -> PkgName
PkgName Text
pn) Ver
pv)

-- | Pretty print 'PkgId'
dispPkgId :: PkgId -> Text
dispPkgId :: PkgId -> Text
dispPkgId (PkgId (PkgName Text
pn) Ver
pv) = Text
pn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ver -> Text
dispVer Ver
pv


-- | Pretty print 'Sha256' as base-16.
dispSha256 :: Sha256 -> Text
dispSha256 :: Sha256 -> Text
dispSha256 (Sha256 ByteString
s) = ByteString -> Text
T.decodeLatin1 (ByteString -> ByteString
B16.encode ByteString
s)

-- | Parse base-16 encoded 'Sha256'.
--
-- Returns 'Nothing' in case of parsing failure.
--
-- @since 0.3.0.0
parseSha256 :: Text -> Maybe Sha256
parseSha256 :: Text -> Maybe Sha256
parseSha256 Text
t
#if MIN_VERSION_base16_bytestring(1,0,0)
  = case ByteString -> Either [Char] ByteString
B16.decode (Text -> ByteString
T.encodeUtf8 Text
t) of
      Right ByteString
s | ByteString -> Int
B.length ByteString
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32 -> Sha256 -> Maybe Sha256
forall a. a -> Maybe a
Just (ByteString -> Sha256
Sha256 ByteString
s)
      Either [Char] ByteString
_                          -> Maybe Sha256
forall a. Maybe a
Nothing
#else
  | B.length s == 32, B.null rest = Just (Sha256 s)
  | otherwise                     = Nothing
  where
    (s, rest) = B16.decode $ T.encodeUtf8 t
#endif

-- | Export the 'Sha256' digest to a 32-byte 'B.ByteString'.
--
-- @since 0.3.0.0
sha256ToByteString :: Sha256 -> B.ByteString
sha256ToByteString :: Sha256 -> ByteString
sha256ToByteString (Sha256 ByteString
bs) = ByteString
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 :: ByteString -> Maybe Sha256
sha256FromByteString ByteString
bs
  | ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32  = Sha256 -> Maybe Sha256
forall a. a -> Maybe a
Just (ByteString -> Sha256
Sha256 ByteString
bs)
  | Bool
otherwise          = Maybe Sha256
forall a. Maybe a
Nothing

instance FromJSON Sha256 where
    parseJSON :: Value -> Parser Sha256
parseJSON = [Char] -> (Text -> Parser Sha256) -> Value -> Parser Sha256
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"Sha256" (Parser Sha256
-> (Sha256 -> Parser Sha256) -> Maybe Sha256 -> Parser Sha256
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Parser Sha256
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Sha256") Sha256 -> Parser Sha256
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Sha256 -> Parser Sha256)
-> (Text -> Maybe Sha256) -> Text -> Parser Sha256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Sha256
parseSha256)

instance ToJSON Sha256 where
    toJSON :: Sha256 -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (Sha256 -> Text) -> Sha256 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sha256 -> Text
dispSha256

instance Show Sha256 where
    show :: Sha256 -> [Char]
show = Text -> [Char]
forall a. Show a => a -> [Char]
show (Text -> [Char]) -> (Sha256 -> Text) -> Sha256 -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sha256 -> Text
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 -> Map UnitId (Set UnitId)
planJsonIdGraph PlanJson{Text
Map UnitId Unit
PkgId
Ver
pjCabalVersion :: PlanJson -> Ver
pjCabalLibVersion :: PlanJson -> Ver
pjCompilerId :: PlanJson -> PkgId
pjArch :: PlanJson -> Text
pjOs :: PlanJson -> Text
pjUnits :: PlanJson -> Map UnitId Unit
pjCabalVersion :: Ver
pjCabalLibVersion :: Ver
pjCompilerId :: PkgId
pjArch :: Text
pjOs :: Text
pjUnits :: Map UnitId Unit
..} = [(UnitId, Set UnitId)] -> Map UnitId (Set UnitId)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ (Unit -> UnitId
uId Unit
unit, Unit -> Set UnitId
planItemAllDeps Unit
unit)
                                          | Unit
unit <- Map UnitId Unit -> [Unit]
forall k a. Map k a -> [a]
M.elems Map UnitId Unit
pjUnits
                                          ]

-- | Extract 'UnitId' root nodes from dependency graph computed by 'planJsonIdGraph'
planJsonIdRoots :: PlanJson -> Set UnitId
planJsonIdRoots :: PlanJson -> Set UnitId
planJsonIdRoots PlanJson{Text
Map UnitId Unit
PkgId
Ver
pjCabalVersion :: PlanJson -> Ver
pjCabalLibVersion :: PlanJson -> Ver
pjCompilerId :: PlanJson -> PkgId
pjArch :: PlanJson -> Text
pjOs :: PlanJson -> Text
pjUnits :: PlanJson -> Map UnitId Unit
pjCabalVersion :: Ver
pjCabalLibVersion :: Ver
pjCompilerId :: PkgId
pjArch :: Text
pjOs :: Text
pjUnits :: Map UnitId Unit
..} = Map UnitId Unit -> Set UnitId
forall k a. Map k a -> Set k
M.keysSet Map UnitId Unit
pjUnits Set UnitId -> Set UnitId -> Set UnitId
forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set UnitId
nonRoots
  where
    nonRoots :: Set UnitId
    nonRoots :: Set UnitId
nonRoots = [Set UnitId] -> Set UnitId
forall a. Monoid a => [a] -> a
mconcat ([Set UnitId] -> Set UnitId) -> [Set UnitId] -> Set UnitId
forall a b. (a -> b) -> a -> b
$ Map UnitId (Set UnitId) -> [Set UnitId]
forall k a. Map k a -> [a]
M.elems (Map UnitId (Set UnitId) -> [Set UnitId])
-> Map UnitId (Set UnitId) -> [Set UnitId]
forall a b. (a -> b) -> a -> b
$ PlanJson -> Map UnitId (Set UnitId)
planJsonIdGraph PlanJson{Text
Map UnitId Unit
PkgId
Ver
pjCabalVersion :: Ver
pjCabalLibVersion :: Ver
pjCompilerId :: PkgId
pjArch :: Text
pjOs :: Text
pjUnits :: Map UnitId Unit
pjCabalVersion :: Ver
pjCabalLibVersion :: Ver
pjCompilerId :: PkgId
pjArch :: Text
pjOs :: Text
pjUnits :: Map UnitId Unit
..}