{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Cabal.Plan
(
PlanJson(..)
, Unit(..)
, CompName(..)
, dispCompName
, dispCompNameTarget
, CompInfo(..)
, UnitType(..)
, Ver(..)
, dispVer
, PkgName(..)
, PkgId(..)
, dispPkgId
, UnitId(..)
, FlagName(..)
, Sha256
, dispSha256
, parseSha256
, sha256ToByteString
, sha256FromByteString
, PkgLoc(..)
, Repo(..)
, SourceRepo(..)
, URI(..)
, RepoType(..)
, planJsonIdGraph
, planJsonIdRoots
, SearchPlanJson(..)
, findAndDecodePlanJson
, findPlanJson
, 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
((</>), takeExtension, isDrive, takeDirectory)
import Text.ParserCombinators.ReadP
newtype Ver = Ver [Int]
deriving (Int -> Ver -> ShowS
[Ver] -> ShowS
Ver -> String
(Int -> Ver -> ShowS)
-> (Ver -> String) -> ([Ver] -> ShowS) -> Show Ver
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ver] -> ShowS
$cshowList :: [Ver] -> ShowS
show :: Ver -> String
$cshow :: Ver -> String
showsPrec :: Int -> Ver -> ShowS
$cshowsPrec :: Int -> Ver -> ShowS
Show,Ver -> Ver -> Bool
(Ver -> Ver -> Bool) -> (Ver -> Ver -> Bool) -> Eq Ver
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ver -> Ver -> Bool
$c/= :: Ver -> Ver -> Bool
== :: Ver -> Ver -> Bool
$c== :: 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
min :: Ver -> Ver -> Ver
$cmin :: Ver -> Ver -> Ver
max :: Ver -> Ver -> Ver
$cmax :: Ver -> Ver -> Ver
>= :: Ver -> Ver -> Bool
$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
compare :: Ver -> Ver -> Ordering
$ccompare :: Ver -> Ver -> Ordering
$cp1Ord :: Eq Ver
Ord)
newtype UnitId = UnitId Text
deriving (Int -> UnitId -> ShowS
[UnitId] -> ShowS
UnitId -> String
(Int -> UnitId -> ShowS)
-> (UnitId -> String) -> ([UnitId] -> ShowS) -> Show UnitId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnitId] -> ShowS
$cshowList :: [UnitId] -> ShowS
show :: UnitId -> String
$cshow :: UnitId -> String
showsPrec :: Int -> UnitId -> ShowS
$cshowsPrec :: Int -> UnitId -> ShowS
Show,UnitId -> UnitId -> Bool
(UnitId -> UnitId -> Bool)
-> (UnitId -> UnitId -> Bool) -> Eq UnitId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnitId -> UnitId -> Bool
$c/= :: UnitId -> UnitId -> Bool
== :: UnitId -> UnitId -> Bool
$c== :: 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
min :: UnitId -> UnitId -> UnitId
$cmin :: UnitId -> UnitId -> UnitId
max :: UnitId -> UnitId -> UnitId
$cmax :: UnitId -> UnitId -> UnitId
>= :: UnitId -> UnitId -> Bool
$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
compare :: UnitId -> UnitId -> Ordering
$ccompare :: UnitId -> UnitId -> Ordering
$cp1Ord :: Eq UnitId
Ord,Value -> Parser [UnitId]
Value -> Parser UnitId
(Value -> Parser UnitId)
-> (Value -> Parser [UnitId]) -> FromJSON UnitId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [UnitId]
$cparseJSONList :: Value -> Parser [UnitId]
parseJSON :: Value -> Parser UnitId
$cparseJSON :: Value -> Parser UnitId
FromJSON,[UnitId] -> Encoding
[UnitId] -> Value
UnitId -> Encoding
UnitId -> Value
(UnitId -> Value)
-> (UnitId -> Encoding)
-> ([UnitId] -> Value)
-> ([UnitId] -> Encoding)
-> ToJSON UnitId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [UnitId] -> Encoding
$ctoEncodingList :: [UnitId] -> Encoding
toJSONList :: [UnitId] -> Value
$ctoJSONList :: [UnitId] -> Value
toEncoding :: UnitId -> Encoding
$ctoEncoding :: UnitId -> Encoding
toJSON :: UnitId -> Value
$ctoJSON :: UnitId -> Value
ToJSON,FromJSONKeyFunction [UnitId]
FromJSONKeyFunction UnitId
FromJSONKeyFunction UnitId
-> FromJSONKeyFunction [UnitId] -> FromJSONKey UnitId
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [UnitId]
$cfromJSONKeyList :: FromJSONKeyFunction [UnitId]
fromJSONKey :: FromJSONKeyFunction UnitId
$cfromJSONKey :: FromJSONKeyFunction UnitId
FromJSONKey,ToJSONKeyFunction [UnitId]
ToJSONKeyFunction UnitId
ToJSONKeyFunction UnitId
-> ToJSONKeyFunction [UnitId] -> ToJSONKey UnitId
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [UnitId]
$ctoJSONKeyList :: ToJSONKeyFunction [UnitId]
toJSONKey :: ToJSONKeyFunction UnitId
$ctoJSONKey :: ToJSONKeyFunction UnitId
ToJSONKey)
newtype PkgName = PkgName Text
deriving (Int -> PkgName -> ShowS
[PkgName] -> ShowS
PkgName -> String
(Int -> PkgName -> ShowS)
-> (PkgName -> String) -> ([PkgName] -> ShowS) -> Show PkgName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PkgName] -> ShowS
$cshowList :: [PkgName] -> ShowS
show :: PkgName -> String
$cshow :: PkgName -> String
showsPrec :: Int -> PkgName -> ShowS
$cshowsPrec :: Int -> PkgName -> ShowS
Show,PkgName -> PkgName -> Bool
(PkgName -> PkgName -> Bool)
-> (PkgName -> PkgName -> Bool) -> Eq PkgName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PkgName -> PkgName -> Bool
$c/= :: PkgName -> PkgName -> Bool
== :: PkgName -> PkgName -> Bool
$c== :: 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
min :: PkgName -> PkgName -> PkgName
$cmin :: PkgName -> PkgName -> PkgName
max :: PkgName -> PkgName -> PkgName
$cmax :: PkgName -> PkgName -> PkgName
>= :: PkgName -> PkgName -> Bool
$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
compare :: PkgName -> PkgName -> Ordering
$ccompare :: PkgName -> PkgName -> Ordering
$cp1Ord :: Eq PkgName
Ord,Value -> Parser [PkgName]
Value -> Parser PkgName
(Value -> Parser PkgName)
-> (Value -> Parser [PkgName]) -> FromJSON PkgName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PkgName]
$cparseJSONList :: Value -> Parser [PkgName]
parseJSON :: Value -> Parser PkgName
$cparseJSON :: Value -> Parser PkgName
FromJSON,[PkgName] -> Encoding
[PkgName] -> Value
PkgName -> Encoding
PkgName -> Value
(PkgName -> Value)
-> (PkgName -> Encoding)
-> ([PkgName] -> Value)
-> ([PkgName] -> Encoding)
-> ToJSON PkgName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PkgName] -> Encoding
$ctoEncodingList :: [PkgName] -> Encoding
toJSONList :: [PkgName] -> Value
$ctoJSONList :: [PkgName] -> Value
toEncoding :: PkgName -> Encoding
$ctoEncoding :: PkgName -> Encoding
toJSON :: PkgName -> Value
$ctoJSON :: PkgName -> Value
ToJSON,FromJSONKeyFunction [PkgName]
FromJSONKeyFunction PkgName
FromJSONKeyFunction PkgName
-> FromJSONKeyFunction [PkgName] -> FromJSONKey PkgName
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [PkgName]
$cfromJSONKeyList :: FromJSONKeyFunction [PkgName]
fromJSONKey :: FromJSONKeyFunction PkgName
$cfromJSONKey :: FromJSONKeyFunction PkgName
FromJSONKey,ToJSONKeyFunction [PkgName]
ToJSONKeyFunction PkgName
ToJSONKeyFunction PkgName
-> ToJSONKeyFunction [PkgName] -> ToJSONKey PkgName
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [PkgName]
$ctoJSONKeyList :: ToJSONKeyFunction [PkgName]
toJSONKey :: ToJSONKeyFunction PkgName
$ctoJSONKey :: ToJSONKeyFunction PkgName
ToJSONKey)
data PkgId = PkgId !PkgName !Ver
deriving (Int -> PkgId -> ShowS
[PkgId] -> ShowS
PkgId -> String
(Int -> PkgId -> ShowS)
-> (PkgId -> String) -> ([PkgId] -> ShowS) -> Show PkgId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PkgId] -> ShowS
$cshowList :: [PkgId] -> ShowS
show :: PkgId -> String
$cshow :: PkgId -> String
showsPrec :: Int -> PkgId -> ShowS
$cshowsPrec :: Int -> PkgId -> ShowS
Show,PkgId -> PkgId -> Bool
(PkgId -> PkgId -> Bool) -> (PkgId -> PkgId -> Bool) -> Eq PkgId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PkgId -> PkgId -> Bool
$c/= :: PkgId -> PkgId -> Bool
== :: PkgId -> PkgId -> Bool
$c== :: 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
min :: PkgId -> PkgId -> PkgId
$cmin :: PkgId -> PkgId -> PkgId
max :: PkgId -> PkgId -> PkgId
$cmax :: PkgId -> PkgId -> PkgId
>= :: PkgId -> PkgId -> Bool
$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
compare :: PkgId -> PkgId -> Ordering
$ccompare :: PkgId -> PkgId -> Ordering
$cp1Ord :: Eq PkgId
Ord)
newtype FlagName = FlagName Text
deriving (Int -> FlagName -> ShowS
[FlagName] -> ShowS
FlagName -> String
(Int -> FlagName -> ShowS)
-> (FlagName -> String) -> ([FlagName] -> ShowS) -> Show FlagName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlagName] -> ShowS
$cshowList :: [FlagName] -> ShowS
show :: FlagName -> String
$cshow :: FlagName -> String
showsPrec :: Int -> FlagName -> ShowS
$cshowsPrec :: Int -> FlagName -> ShowS
Show,FlagName -> FlagName -> Bool
(FlagName -> FlagName -> Bool)
-> (FlagName -> FlagName -> Bool) -> Eq FlagName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FlagName -> FlagName -> Bool
$c/= :: FlagName -> FlagName -> Bool
== :: FlagName -> FlagName -> Bool
$c== :: 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
min :: FlagName -> FlagName -> FlagName
$cmin :: FlagName -> FlagName -> FlagName
max :: FlagName -> FlagName -> FlagName
$cmax :: FlagName -> FlagName -> FlagName
>= :: FlagName -> FlagName -> Bool
$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
compare :: FlagName -> FlagName -> Ordering
$ccompare :: FlagName -> FlagName -> Ordering
$cp1Ord :: Eq FlagName
Ord,Value -> Parser [FlagName]
Value -> Parser FlagName
(Value -> Parser FlagName)
-> (Value -> Parser [FlagName]) -> FromJSON FlagName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [FlagName]
$cparseJSONList :: Value -> Parser [FlagName]
parseJSON :: Value -> Parser FlagName
$cparseJSON :: Value -> Parser FlagName
FromJSON,[FlagName] -> Encoding
[FlagName] -> Value
FlagName -> Encoding
FlagName -> Value
(FlagName -> Value)
-> (FlagName -> Encoding)
-> ([FlagName] -> Value)
-> ([FlagName] -> Encoding)
-> ToJSON FlagName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [FlagName] -> Encoding
$ctoEncodingList :: [FlagName] -> Encoding
toJSONList :: [FlagName] -> Value
$ctoJSONList :: [FlagName] -> Value
toEncoding :: FlagName -> Encoding
$ctoEncoding :: FlagName -> Encoding
toJSON :: FlagName -> Value
$ctoJSON :: FlagName -> Value
ToJSON,FromJSONKeyFunction [FlagName]
FromJSONKeyFunction FlagName
FromJSONKeyFunction FlagName
-> FromJSONKeyFunction [FlagName] -> FromJSONKey FlagName
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [FlagName]
$cfromJSONKeyList :: FromJSONKeyFunction [FlagName]
fromJSONKey :: FromJSONKeyFunction FlagName
$cfromJSONKey :: FromJSONKeyFunction FlagName
FromJSONKey,ToJSONKeyFunction [FlagName]
ToJSONKeyFunction FlagName
ToJSONKeyFunction FlagName
-> ToJSONKeyFunction [FlagName] -> ToJSONKey FlagName
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [FlagName]
$ctoJSONKeyList :: ToJSONKeyFunction [FlagName]
toJSONKey :: ToJSONKeyFunction FlagName
$ctoJSONKey :: ToJSONKeyFunction FlagName
ToJSONKey)
newtype Sha256 = Sha256 B.ByteString
deriving (Sha256 -> Sha256 -> Bool
(Sha256 -> Sha256 -> Bool)
-> (Sha256 -> Sha256 -> Bool) -> Eq Sha256
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sha256 -> Sha256 -> Bool
$c/= :: Sha256 -> Sha256 -> Bool
== :: Sha256 -> Sha256 -> Bool
$c== :: 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
min :: Sha256 -> Sha256 -> Sha256
$cmin :: Sha256 -> Sha256 -> Sha256
max :: Sha256 -> Sha256 -> Sha256
$cmax :: Sha256 -> Sha256 -> Sha256
>= :: Sha256 -> Sha256 -> Bool
$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
compare :: Sha256 -> Sha256 -> Ordering
$ccompare :: Sha256 -> Sha256 -> Ordering
$cp1Ord :: Eq Sha256
Ord)
data PkgLoc
= LocalUnpackedPackage !FilePath
| LocalTarballPackage !FilePath
| RemoteTarballPackage !URI
| RepoTarballPackage !Repo
| RemoteSourceRepoPackage !SourceRepo
deriving (Int -> PkgLoc -> ShowS
[PkgLoc] -> ShowS
PkgLoc -> String
(Int -> PkgLoc -> ShowS)
-> (PkgLoc -> String) -> ([PkgLoc] -> ShowS) -> Show PkgLoc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PkgLoc] -> ShowS
$cshowList :: [PkgLoc] -> ShowS
show :: PkgLoc -> String
$cshow :: PkgLoc -> String
showsPrec :: Int -> PkgLoc -> ShowS
$cshowsPrec :: Int -> PkgLoc -> ShowS
Show,PkgLoc -> PkgLoc -> Bool
(PkgLoc -> PkgLoc -> Bool)
-> (PkgLoc -> PkgLoc -> Bool) -> Eq PkgLoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PkgLoc -> PkgLoc -> Bool
$c/= :: PkgLoc -> PkgLoc -> Bool
== :: PkgLoc -> PkgLoc -> Bool
$c== :: 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
min :: PkgLoc -> PkgLoc -> PkgLoc
$cmin :: PkgLoc -> PkgLoc -> PkgLoc
max :: PkgLoc -> PkgLoc -> PkgLoc
$cmax :: PkgLoc -> PkgLoc -> PkgLoc
>= :: PkgLoc -> PkgLoc -> Bool
$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
compare :: PkgLoc -> PkgLoc -> Ordering
$ccompare :: PkgLoc -> PkgLoc -> Ordering
$cp1Ord :: Eq PkgLoc
Ord)
data Repo
= RepoLocal !FilePath
| RepoRemote !URI
| RepoSecure !URI
| RepoLocalNoIndex !FilePath
deriving (Int -> Repo -> ShowS
[Repo] -> ShowS
Repo -> String
(Int -> Repo -> ShowS)
-> (Repo -> String) -> ([Repo] -> ShowS) -> Show Repo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Repo] -> ShowS
$cshowList :: [Repo] -> ShowS
show :: Repo -> String
$cshow :: Repo -> String
showsPrec :: Int -> Repo -> ShowS
$cshowsPrec :: Int -> Repo -> ShowS
Show,Repo -> Repo -> Bool
(Repo -> Repo -> Bool) -> (Repo -> Repo -> Bool) -> Eq Repo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Repo -> Repo -> Bool
$c/= :: Repo -> Repo -> Bool
== :: Repo -> Repo -> Bool
$c== :: 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
min :: Repo -> Repo -> Repo
$cmin :: Repo -> Repo -> Repo
max :: Repo -> Repo -> Repo
$cmax :: Repo -> Repo -> Repo
>= :: Repo -> Repo -> Bool
$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
compare :: Repo -> Repo -> Ordering
$ccompare :: Repo -> Repo -> Ordering
$cp1Ord :: Eq Repo
Ord)
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 String
srSubdir :: !(Maybe FilePath)
} deriving (Int -> SourceRepo -> ShowS
[SourceRepo] -> ShowS
SourceRepo -> String
(Int -> SourceRepo -> ShowS)
-> (SourceRepo -> String)
-> ([SourceRepo] -> ShowS)
-> Show SourceRepo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SourceRepo] -> ShowS
$cshowList :: [SourceRepo] -> ShowS
show :: SourceRepo -> String
$cshow :: SourceRepo -> String
showsPrec :: Int -> SourceRepo -> ShowS
$cshowsPrec :: Int -> SourceRepo -> ShowS
Show,SourceRepo -> SourceRepo -> Bool
(SourceRepo -> SourceRepo -> Bool)
-> (SourceRepo -> SourceRepo -> Bool) -> Eq SourceRepo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourceRepo -> SourceRepo -> Bool
$c/= :: SourceRepo -> SourceRepo -> Bool
== :: SourceRepo -> SourceRepo -> Bool
$c== :: 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
min :: SourceRepo -> SourceRepo -> SourceRepo
$cmin :: SourceRepo -> SourceRepo -> SourceRepo
max :: SourceRepo -> SourceRepo -> SourceRepo
$cmax :: SourceRepo -> SourceRepo -> SourceRepo
>= :: SourceRepo -> SourceRepo -> Bool
$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
compare :: SourceRepo -> SourceRepo -> Ordering
$ccompare :: SourceRepo -> SourceRepo -> Ordering
$cp1Ord :: Eq SourceRepo
Ord)
newtype URI = URI Text
deriving (Int -> URI -> ShowS
[URI] -> ShowS
URI -> String
(Int -> URI -> ShowS)
-> (URI -> String) -> ([URI] -> ShowS) -> Show URI
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [URI] -> ShowS
$cshowList :: [URI] -> ShowS
show :: URI -> String
$cshow :: URI -> String
showsPrec :: Int -> URI -> ShowS
$cshowsPrec :: Int -> URI -> ShowS
Show,URI -> URI -> Bool
(URI -> URI -> Bool) -> (URI -> URI -> Bool) -> Eq URI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: URI -> URI -> Bool
$c/= :: URI -> URI -> Bool
== :: URI -> URI -> Bool
$c== :: 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
min :: URI -> URI -> URI
$cmin :: URI -> URI -> URI
max :: URI -> URI -> URI
$cmax :: URI -> URI -> URI
>= :: URI -> URI -> Bool
$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
compare :: URI -> URI -> Ordering
$ccompare :: URI -> URI -> Ordering
$cp1Ord :: Eq URI
Ord,Value -> Parser [URI]
Value -> Parser URI
(Value -> Parser URI) -> (Value -> Parser [URI]) -> FromJSON URI
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [URI]
$cparseJSONList :: Value -> Parser [URI]
parseJSON :: Value -> Parser URI
$cparseJSON :: Value -> Parser URI
FromJSON,[URI] -> Encoding
[URI] -> Value
URI -> Encoding
URI -> Value
(URI -> Value)
-> (URI -> Encoding)
-> ([URI] -> Value)
-> ([URI] -> Encoding)
-> ToJSON URI
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [URI] -> Encoding
$ctoEncodingList :: [URI] -> Encoding
toJSONList :: [URI] -> Value
$ctoJSONList :: [URI] -> Value
toEncoding :: URI -> Encoding
$ctoEncoding :: URI -> Encoding
toJSON :: URI -> Value
$ctoJSON :: URI -> Value
ToJSON,FromJSONKeyFunction [URI]
FromJSONKeyFunction URI
FromJSONKeyFunction URI
-> FromJSONKeyFunction [URI] -> FromJSONKey URI
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [URI]
$cfromJSONKeyList :: FromJSONKeyFunction [URI]
fromJSONKey :: FromJSONKeyFunction URI
$cfromJSONKey :: FromJSONKeyFunction URI
FromJSONKey,ToJSONKeyFunction [URI]
ToJSONKeyFunction URI
ToJSONKeyFunction URI -> ToJSONKeyFunction [URI] -> ToJSONKey URI
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [URI]
$ctoJSONKeyList :: ToJSONKeyFunction [URI]
toJSONKey :: ToJSONKeyFunction URI
$ctoJSONKey :: ToJSONKeyFunction URI
ToJSONKey)
data RepoType
= Darcs
| Git
| SVN
| CVS
| Mercurial
| GnuArch
| Bazaar
| Monotone
| OtherRepoType Text
deriving (Int -> RepoType -> ShowS
[RepoType] -> ShowS
RepoType -> String
(Int -> RepoType -> ShowS)
-> (RepoType -> String) -> ([RepoType] -> ShowS) -> Show RepoType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RepoType] -> ShowS
$cshowList :: [RepoType] -> ShowS
show :: RepoType -> String
$cshow :: RepoType -> String
showsPrec :: Int -> RepoType -> ShowS
$cshowsPrec :: Int -> RepoType -> ShowS
Show,RepoType -> RepoType -> Bool
(RepoType -> RepoType -> Bool)
-> (RepoType -> RepoType -> Bool) -> Eq RepoType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RepoType -> RepoType -> Bool
$c/= :: RepoType -> RepoType -> Bool
== :: RepoType -> RepoType -> Bool
$c== :: 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
min :: RepoType -> RepoType -> RepoType
$cmin :: RepoType -> RepoType -> RepoType
max :: RepoType -> RepoType -> RepoType
$cmax :: RepoType -> RepoType -> RepoType
>= :: RepoType -> RepoType -> Bool
$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
compare :: RepoType -> RepoType -> Ordering
$ccompare :: RepoType -> RepoType -> Ordering
$cp1Ord :: Eq RepoType
Ord)
data PlanJson = PlanJson
{ PlanJson -> Ver
pjCabalVersion :: !Ver
, PlanJson -> Ver
pjCabalLibVersion :: !Ver
, PlanJson -> PkgId
pjCompilerId :: !PkgId
, PlanJson -> Text
pjArch :: !Text
, PlanJson -> Text
pjOs :: !Text
, PlanJson -> Map UnitId Unit
pjUnits :: !(M.Map UnitId Unit)
} deriving Int -> PlanJson -> ShowS
[PlanJson] -> ShowS
PlanJson -> String
(Int -> PlanJson -> ShowS)
-> (PlanJson -> String) -> ([PlanJson] -> ShowS) -> Show PlanJson
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlanJson] -> ShowS
$cshowList :: [PlanJson] -> ShowS
show :: PlanJson -> String
$cshow :: PlanJson -> String
showsPrec :: Int -> PlanJson -> ShowS
$cshowsPrec :: Int -> PlanJson -> ShowS
Show
data UnitType = UnitTypeBuiltin
| UnitTypeGlobal
| UnitTypeLocal
| UnitTypeInplace
deriving (Int -> UnitType -> ShowS
[UnitType] -> ShowS
UnitType -> String
(Int -> UnitType -> ShowS)
-> (UnitType -> String) -> ([UnitType] -> ShowS) -> Show UnitType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnitType] -> ShowS
$cshowList :: [UnitType] -> ShowS
show :: UnitType -> String
$cshow :: UnitType -> String
showsPrec :: Int -> UnitType -> ShowS
$cshowsPrec :: Int -> UnitType -> ShowS
Show,UnitType -> UnitType -> Bool
(UnitType -> UnitType -> Bool)
-> (UnitType -> UnitType -> Bool) -> Eq UnitType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnitType -> UnitType -> Bool
$c/= :: UnitType -> UnitType -> Bool
== :: UnitType -> UnitType -> Bool
$c== :: UnitType -> UnitType -> Bool
Eq)
data Unit = Unit
{ Unit -> UnitId
uId :: !UnitId
, Unit -> PkgId
uPId :: !PkgId
, Unit -> UnitType
uType :: !UnitType
, Unit -> Maybe Sha256
uSha256 :: !(Maybe Sha256)
, Unit -> Maybe Sha256
uCabalSha256 :: !(Maybe Sha256)
, Unit -> Map CompName CompInfo
uComps :: !(Map CompName CompInfo)
, Unit -> Map FlagName Bool
uFlags :: !(Map FlagName Bool)
, Unit -> Maybe String
uDistDir :: !(Maybe FilePath)
, Unit -> Maybe PkgLoc
uPkgSrc :: !(Maybe PkgLoc)
} deriving Int -> Unit -> ShowS
[Unit] -> ShowS
Unit -> String
(Int -> Unit -> ShowS)
-> (Unit -> String) -> ([Unit] -> ShowS) -> Show Unit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Unit] -> ShowS
$cshowList :: [Unit] -> ShowS
show :: Unit -> String
$cshow :: Unit -> String
showsPrec :: Int -> Unit -> ShowS
$cshowsPrec :: Int -> Unit -> ShowS
Show
data CompName =
CompNameLib
| CompNameSubLib !Text
| CompNameFLib !Text
| CompNameExe !Text
| CompNameTest !Text
| CompNameBench !Text
| CompNameSetup
deriving (Int -> CompName -> ShowS
[CompName] -> ShowS
CompName -> String
(Int -> CompName -> ShowS)
-> (CompName -> String) -> ([CompName] -> ShowS) -> Show CompName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompName] -> ShowS
$cshowList :: [CompName] -> ShowS
show :: CompName -> String
$cshow :: CompName -> String
showsPrec :: Int -> CompName -> ShowS
$cshowsPrec :: Int -> CompName -> ShowS
Show, CompName -> CompName -> Bool
(CompName -> CompName -> Bool)
-> (CompName -> CompName -> Bool) -> Eq CompName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompName -> CompName -> Bool
$c/= :: CompName -> CompName -> Bool
== :: CompName -> CompName -> Bool
$c== :: 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
min :: CompName -> CompName -> CompName
$cmin :: CompName -> CompName -> CompName
max :: CompName -> CompName -> CompName
$cmax :: CompName -> CompName -> CompName
>= :: CompName -> CompName -> Bool
$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
compare :: CompName -> CompName -> Ordering
$ccompare :: CompName -> CompName -> Ordering
$cp1Ord :: Eq CompName
Ord)
data CompInfo = CompInfo
{ CompInfo -> Set UnitId
ciLibDeps :: Set UnitId
, CompInfo -> Set UnitId
ciExeDeps :: Set UnitId
, CompInfo -> Maybe String
ciBinFile :: Maybe FilePath
} deriving Int -> CompInfo -> ShowS
[CompInfo] -> ShowS
CompInfo -> String
(Int -> CompInfo -> ShowS)
-> (CompInfo -> String) -> ([CompInfo] -> ShowS) -> Show CompInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompInfo] -> ShowS
$cshowList :: [CompInfo] -> ShowS
show :: CompInfo -> String
$cshow :: CompInfo -> String
showsPrec :: Int -> CompInfo -> ShowS
$cshowsPrec :: Int -> CompInfo -> ShowS
Show
instance FromJSON CompName where
parseJSON :: Value -> Parser CompName
parseJSON = String -> (Text -> Parser CompName) -> Value -> Parser CompName
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "CompName" (Parser CompName
-> (CompName -> Parser CompName)
-> Maybe CompName
-> Parser CompName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser CompName
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "invalid CompName") CompName -> Parser CompName
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 (String -> Parser CompName
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "CompName") CompName -> Parser CompName
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 = String -> (Object -> Parser CompInfo) -> Value -> Parser CompInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "CompInfo" ((Object -> Parser CompInfo) -> Value -> Parser CompInfo)
-> (Object -> Parser CompInfo) -> Value -> Parser CompInfo
forall a b. (a -> b) -> a -> b
$ \o :: Object
o ->
Set UnitId -> Set UnitId -> Maybe String -> CompInfo
CompInfo (Set UnitId -> Set UnitId -> Maybe String -> CompInfo)
-> Parser (Set UnitId)
-> Parser (Set UnitId -> Maybe String -> 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
.:?! "depends"
Parser (Set UnitId -> Maybe String -> CompInfo)
-> Parser (Set UnitId) -> Parser (Maybe String -> CompInfo)
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
.:?! "exe-depends"
Parser (Maybe String -> CompInfo)
-> Parser (Maybe String) -> Parser CompInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "bin-file"
instance FromJSON PkgId where
parseJSON :: Value -> Parser PkgId
parseJSON = String -> (Text -> Parser PkgId) -> Value -> Parser PkgId
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "PkgId" (Parser PkgId
-> (PkgId -> Parser PkgId) -> Maybe PkgId -> Parser PkgId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser PkgId
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "invalid PkgId") PkgId -> Parser PkgId
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 (String -> Parser PkgId
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "PkgId") PkgId -> Parser PkgId
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 = String -> (Object -> Parser PkgLoc) -> Value -> Parser PkgLoc
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "PkgSrc" ((Object -> Parser PkgLoc) -> Value -> Parser PkgLoc)
-> (Object -> Parser PkgLoc) -> Value -> Parser PkgLoc
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
Text
ty <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "type"
case Text
ty :: Text of
"local" -> String -> PkgLoc
LocalUnpackedPackage (String -> PkgLoc) -> Parser String -> Parser PkgLoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: "path"
"local-tar" -> String -> PkgLoc
LocalTarballPackage (String -> PkgLoc) -> Parser String -> Parser PkgLoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: "path"
"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 -> Text -> Parser URI
forall a. FromJSON a => Object -> Text -> Parser a
.: "uri"
"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 -> Text -> Parser Repo
forall a. FromJSON a => Object -> Text -> Parser a
.: "repo"
"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 -> Text -> Parser SourceRepo
forall a. FromJSON a => Object -> Text -> Parser a
.: "source-repo"
_ -> String -> Parser PkgLoc
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "invalid PkgSrc \"type\""
instance FromJSON Repo where
parseJSON :: Value -> Parser Repo
parseJSON = String -> (Object -> Parser Repo) -> Value -> Parser Repo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "Repo" ((Object -> Parser Repo) -> Value -> Parser Repo)
-> (Object -> Parser Repo) -> Value -> Parser Repo
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
Text
ty <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "type"
case Text
ty :: Text of
"local-repo" -> String -> Repo
RepoLocal (String -> Repo) -> Parser String -> Parser Repo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: "path"
"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 -> Text -> Parser URI
forall a. FromJSON a => Object -> Text -> Parser a
.: "uri"
"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 -> Text -> Parser URI
forall a. FromJSON a => Object -> Text -> Parser a
.: "uri"
"local-repo-no-index" -> String -> Repo
RepoLocalNoIndex (String -> Repo) -> Parser String -> Parser Repo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: "path"
_ -> String -> Parser Repo
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "invalid Repo \"type\""
instance FromJSON SourceRepo where
parseJSON :: Value -> Parser SourceRepo
parseJSON = String
-> (Object -> Parser SourceRepo) -> Value -> Parser SourceRepo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "SourceRepo" ((Object -> Parser SourceRepo) -> Value -> Parser SourceRepo)
-> (Object -> Parser SourceRepo) -> Value -> Parser SourceRepo
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
Maybe RepoType
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe String
-> SourceRepo
SourceRepo (Maybe RepoType
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe String
-> SourceRepo)
-> Parser (Maybe RepoType)
-> Parser
(Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe String
-> SourceRepo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe RepoType)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "type"
Parser
(Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe String
-> SourceRepo)
-> Parser (Maybe Text)
-> Parser
(Maybe Text
-> Maybe Text -> Maybe Text -> Maybe String -> SourceRepo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "location"
Parser
(Maybe Text
-> Maybe Text -> Maybe Text -> Maybe String -> SourceRepo)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> Maybe String -> SourceRepo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "module"
Parser (Maybe Text -> Maybe Text -> Maybe String -> SourceRepo)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe String -> SourceRepo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "branch"
Parser (Maybe Text -> Maybe String -> SourceRepo)
-> Parser (Maybe Text) -> Parser (Maybe String -> SourceRepo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "tag"
Parser (Maybe String -> SourceRepo)
-> Parser (Maybe String) -> Parser SourceRepo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "subdir"
instance FromJSON RepoType where
parseJSON :: Value -> Parser RepoType
parseJSON = String -> (Text -> Parser RepoType) -> Value -> Parser RepoType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "RepoType" ((Text -> Parser RepoType) -> Value -> Parser RepoType)
-> (Text -> Parser RepoType) -> Value -> Parser RepoType
forall a b. (a -> b) -> a -> b
$ \ty :: Text
ty -> RepoType -> Parser RepoType
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
"darcs" -> RepoType
Darcs
"git" -> RepoType
Git
"svn" -> RepoType
SVN
"cvs" -> RepoType
CVS
"mercurial" -> RepoType
Mercurial
"gnuarch" -> RepoType
GnuArch
"bazaar" -> RepoType
Bazaar
"monotone" -> RepoType
Monotone
_ -> Text -> RepoType
OtherRepoType Text
ty
parseCompName :: Text -> Maybe CompName
parseCompName :: Text -> Maybe CompName
parseCompName t0 :: Text
t0 = case Text -> Text -> [Text]
T.splitOn ":" Text
t0 of
["lib"] -> CompName -> Maybe CompName
forall a. a -> Maybe a
Just CompName
CompNameLib
["lib",n :: 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
["flib",n :: 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
["exe",n :: 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
["bench",n :: 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
["test",n :: 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
["setup"] -> CompName -> Maybe CompName
forall a. a -> Maybe a
Just CompName
CompNameSetup
_ -> Maybe CompName
forall a. Maybe a
Nothing
dispCompNameTarget :: PkgName -> CompName -> Text
dispCompNameTarget :: PkgName -> CompName -> Text
dispCompNameTarget (PkgName pkg :: Text
pkg) cn :: CompName
cn = case CompName
cn of
CompNameLib -> "lib:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pkg
_ -> CompName -> Text
dispCompName CompName
cn
dispCompName :: CompName -> Text
dispCompName :: CompName -> Text
dispCompName cn :: CompName
cn = case CompName
cn of
CompNameLib -> "lib"
CompNameSubLib n :: Text
n -> "lib:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n
CompNameFLib n :: Text
n -> "flib:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n
CompNameExe n :: Text
n -> "exe:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n
CompNameBench n :: Text
n -> "bench:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n
CompNameTest n :: Text
n -> "test:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n
CompNameSetup -> "setup"
instance FromJSON PlanJson where
parseJSON :: Value -> Parser PlanJson
parseJSON = String -> (Object -> Parser PlanJson) -> Value -> Parser PlanJson
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "PlanJson" ((Object -> Parser PlanJson) -> Value -> Parser PlanJson)
-> (Object -> Parser PlanJson) -> Value -> Parser PlanJson
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
Ver
pjCabalVersion <- Object
o Object -> Text -> Parser Ver
forall a. FromJSON a => Object -> Text -> Parser a
.: "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 [2]) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("plan.json version " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack (Ver -> Text
dispVer Ver
pjCabalVersion) String -> ShowS
forall a. [a] -> [a] -> [a]
++ " not supported")
Ver
pjCabalLibVersion <- Object
o Object -> Text -> Parser Ver
forall a. FromJSON a => Object -> Text -> Parser a
.: "cabal-lib-version"
PkgId
pjCompilerId <- Object
o Object -> Text -> Parser PkgId
forall a. FromJSON a => Object -> Text -> Parser a
.: "compiler-id"
Text
pjArch <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "arch"
Text
pjOs <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "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 -> Text -> Parser [Unit]
forall a. FromJSON a => Object -> Text -> Parser a
.: "install-plan"
PlanJson -> Parser PlanJson
forall (f :: * -> *) a. Applicative f => a -> f a
App.pure $WPlanJson :: Ver -> Ver -> PkgId -> Text -> Text -> Map UnitId Unit -> PlanJson
PlanJson{..}
where
toMap :: [Unit] -> m (Map UnitId Unit)
toMap pil :: [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 (t :: * -> *) a. Foldable t => t a -> Int
length [Unit]
pil) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "install-plan[] has duplicate ids"
Map UnitId Unit -> m (Map UnitId Unit)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map UnitId Unit
pim
(.:?!) :: (FromJSON a, Monoid a) => Object -> Text -> Parser a
o :: Object
o .:?! :: Object -> Text -> Parser a
.:?! fld :: Text
fld = Object
o Object -> Text -> Parser (Maybe a)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? 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
planItemAllDeps :: Unit -> Set UnitId
planItemAllDeps :: Unit -> Set UnitId
planItemAllDeps Unit{..} = [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{..} <- 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 = String -> (Object -> Parser Unit) -> Value -> Parser Unit
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "Unit" ((Object -> Parser Unit) -> Value -> Parser Unit)
-> (Object -> Parser Unit) -> Value -> Parser Unit
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
Maybe (Map CompName CompInfo)
mcomponents <- Object
o Object -> Text -> Parser (Maybe (Map CompName CompInfo))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "components"
Maybe CompName
mcomponentname <- Object
o Object -> Text -> Parser (Maybe CompName)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "component-name"
Text
ty <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "type"
Maybe Text
mstyle <- Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "style"
UnitId
uId <- Object
o Object -> Text -> Parser UnitId
forall a. FromJSON a => Object -> Text -> Parser a
.: "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 -> Text -> Parser PkgName
forall a. FromJSON a => Object -> Text -> Parser a
.: "pkg-name" Parser (Ver -> PkgId) -> Parser Ver -> Parser PkgId
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Ver
forall a. FromJSON a => Object -> Text -> Parser a
.: "pkg-version"
UnitType
uType <- case (Text
ty :: Text, Maybe Text
mstyle :: Maybe Text) of
("pre-existing",Nothing) -> UnitType -> Parser UnitType
forall (f :: * -> *) a. Applicative f => a -> f a
pure UnitType
UnitTypeBuiltin
("configured",Just "global") -> UnitType -> Parser UnitType
forall (f :: * -> *) a. Applicative f => a -> f a
pure UnitType
UnitTypeGlobal
("configured",Just "local") -> UnitType -> Parser UnitType
forall (f :: * -> *) a. Applicative f => a -> f a
pure UnitType
UnitTypeLocal
("configured",Just "inplace") -> UnitType -> Parser UnitType
forall (f :: * -> *) a. Applicative f => a -> f a
pure UnitType
UnitTypeInplace
_ -> String -> Parser UnitType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ((Text, Maybe Text) -> String
forall a. Show a => a -> String
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
.:?! "flags"
Maybe Sha256
uSha256 <- Object
o Object -> Text -> Parser (Maybe Sha256)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "pkg-src-sha256"
Maybe Sha256
uCabalSha256 <- Object
o Object -> Text -> Parser (Maybe Sha256)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "pkg-cabal-sha256"
Map CompName CompInfo
uComps <- case (Maybe (Map CompName CompInfo)
mcomponents, Maybe CompName
mcomponentname) of
(Just comps0 :: Map CompName CompInfo
comps0, Nothing) ->
Map CompName CompInfo -> Parser (Map CompName CompInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map CompName CompInfo
comps0
(Nothing, Just cname :: 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)
(Nothing, 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)
_ -> String -> Parser (Map CompName CompInfo)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Object -> String
forall a. Show a => a -> String
show Object
o)
Maybe String
uDistDir <- Object
o Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "dist-dir"
Maybe PkgLoc
uPkgSrc <- Object
o Object -> Text -> Parser (Maybe PkgLoc)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "pkg-src"
Unit -> Parser Unit
forall (f :: * -> *) a. Applicative f => a -> f a
pure $WUnit :: UnitId
-> PkgId
-> UnitType
-> Maybe Sha256
-> Maybe Sha256
-> Map CompName CompInfo
-> Map FlagName Bool
-> Maybe String
-> Maybe PkgLoc
-> Unit
Unit{..}
data SearchPlanJson
= ProjectRelativeToDir FilePath
| InBuildDir FilePath
| ExactPath FilePath
deriving (SearchPlanJson -> SearchPlanJson -> Bool
(SearchPlanJson -> SearchPlanJson -> Bool)
-> (SearchPlanJson -> SearchPlanJson -> Bool) -> Eq SearchPlanJson
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SearchPlanJson -> SearchPlanJson -> Bool
$c/= :: SearchPlanJson -> SearchPlanJson -> Bool
== :: SearchPlanJson -> SearchPlanJson -> Bool
$c== :: SearchPlanJson -> SearchPlanJson -> Bool
Eq, Int -> SearchPlanJson -> ShowS
[SearchPlanJson] -> ShowS
SearchPlanJson -> String
(Int -> SearchPlanJson -> ShowS)
-> (SearchPlanJson -> String)
-> ([SearchPlanJson] -> ShowS)
-> Show SearchPlanJson
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SearchPlanJson] -> ShowS
$cshowList :: [SearchPlanJson] -> ShowS
show :: SearchPlanJson -> String
$cshow :: SearchPlanJson -> String
showsPrec :: Int -> SearchPlanJson -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [SearchPlanJson]
$creadListPrec :: ReadPrec [SearchPlanJson]
readPrec :: ReadPrec SearchPlanJson
$creadPrec :: ReadPrec SearchPlanJson
readList :: ReadS [SearchPlanJson]
$creadList :: ReadS [SearchPlanJson]
readsPrec :: Int -> ReadS SearchPlanJson
$creadsPrec :: Int -> ReadS SearchPlanJson
Read)
findAndDecodePlanJson
:: SearchPlanJson
-> IO PlanJson
findAndDecodePlanJson :: SearchPlanJson -> IO PlanJson
findAndDecodePlanJson searchLoc :: SearchPlanJson
searchLoc = SearchPlanJson -> IO String
findPlanJson SearchPlanJson
searchLoc IO String -> (String -> IO PlanJson) -> IO PlanJson
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO PlanJson
decodePlanJson
findPlanJson
:: SearchPlanJson
-> IO FilePath
findPlanJson :: SearchPlanJson -> IO String
findPlanJson searchLoc :: SearchPlanJson
searchLoc = do
String
planJsonFn <- case SearchPlanJson
searchLoc of
ExactPath fp :: String
fp -> String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
fp
InBuildDir builddir :: String
builddir -> String -> IO String
fromBuilddir String
builddir
ProjectRelativeToDir fp :: String
fp -> do
Maybe String
mRoot <- String -> IO (Maybe String)
findProjectRoot String
fp
case Maybe String
mRoot of
Nothing -> String -> IO String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("missing project root relative to: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fp)
Just dir :: String
dir -> String -> IO String
fromBuilddir (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
</> "dist-newstyle"
Bool
havePlanJson <- String -> IO Bool
Dir.doesFileExist String
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
$
String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "missing 'plan.json' file; do you need to run 'cabal new-build'?"
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
planJsonFn
where
fromBuilddir :: String -> IO String
fromBuilddir distFolder :: String
distFolder = do
Bool
haveDistFolder <- String -> IO Bool
Dir.doesDirectoryExist String
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
$
String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("missing " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
distFolder String -> ShowS
forall a. [a] -> [a] -> [a]
++ " folder; do you need to run 'cabal new-build'?")
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
distFolder String -> ShowS
</> "cache" String -> ShowS
</> "plan.json"
decodePlanJson :: FilePath -> IO PlanJson
decodePlanJson :: String -> IO PlanJson
decodePlanJson planJsonFn :: String
planJsonFn = do
ByteString
jsraw <- String -> IO ByteString
B.readFile String
planJsonFn
(String -> IO PlanJson)
-> (PlanJson -> IO PlanJson)
-> Either String PlanJson
-> IO PlanJson
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO PlanJson
forall (m :: * -> *) a. MonadFail m => String -> m a
fail PlanJson -> IO PlanJson
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String PlanJson -> IO PlanJson)
-> Either String PlanJson -> IO PlanJson
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String PlanJson
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict' ByteString
jsraw
findProjectRoot :: FilePath -> IO (Maybe FilePath)
findProjectRoot :: String -> IO (Maybe String)
findProjectRoot dir :: String
dir = do
String
normalisedPath <- String -> IO String
Dir.canonicalizePath String
dir
let checkCabalProject :: String -> IO (Maybe String)
checkCabalProject d :: String
d = do
Bool
ex <- String -> IO Bool
Dir.doesFileExist String
fn
Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ if Bool
ex then String -> Maybe String
forall a. a -> Maybe a
Just String
d else Maybe String
forall a. Maybe a
Nothing
where
fn :: String
fn = String
d String -> ShowS
</> "cabal.project"
checkCabal :: String -> IO (Maybe String)
checkCabal d :: String
d = do
[String]
files <- String -> IO [String]
listDirectory String
d
Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ if (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
isExtensionOf ".cabal") [String]
files
then String -> Maybe String
forall a. a -> Maybe a
Just String
d
else Maybe String
forall a. Maybe a
Nothing
Maybe String
result <- (String -> IO (Maybe String)) -> String -> IO (Maybe String)
forall a. (String -> IO (Maybe a)) -> String -> IO (Maybe a)
walkUpFolders String -> IO (Maybe String)
checkCabalProject String
normalisedPath
case Maybe String
result of
Just rootDir :: String
rootDir -> Maybe String -> IO (Maybe String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
rootDir
Nothing -> (String -> IO (Maybe String)) -> String -> IO (Maybe String)
forall a. (String -> IO (Maybe a)) -> String -> IO (Maybe a)
walkUpFolders String -> IO (Maybe String)
checkCabal String
normalisedPath
where
isExtensionOf :: String -> FilePath -> Bool
isExtensionOf :: String -> String -> Bool
isExtensionOf ext :: String
ext fp :: String
fp = String
ext String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== ShowS
takeExtension String
fp
listDirectory :: FilePath -> IO [FilePath]
listDirectory :: String -> IO [String]
listDirectory fp :: String
fp = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
forall a. (Eq a, IsString a) => a -> Bool
isSpecialDir ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
Dir.getDirectoryContents String
fp
where
isSpecialDir :: a -> Bool
isSpecialDir f :: a
f = a
f a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= "." Bool -> Bool -> Bool
&& a
f a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= ".."
walkUpFolders
:: (FilePath -> IO (Maybe a)) -> FilePath -> IO (Maybe a)
walkUpFolders :: (String -> IO (Maybe a)) -> String -> IO (Maybe a)
walkUpFolders dtest :: String -> IO (Maybe a)
dtest d0 :: String
d0 = do
String
home <- IO String
Dir.getHomeDirectory
let go :: String -> IO (Maybe a)
go d :: String
d | String
d String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
home = Maybe a -> IO (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
| String -> Bool
isDrive String
d = Maybe a -> IO (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
| Bool
otherwise = do
Maybe a
t <- String -> IO (Maybe a)
dtest String
d
case Maybe a
t of
Nothing -> String -> IO (Maybe a)
go (String -> IO (Maybe a)) -> String -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ ShowS
takeDirectory String
d
x :: Maybe a
x@Just{} -> Maybe a -> IO (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
x
String -> IO (Maybe a)
go String
d0
parseVer :: Text -> Maybe Ver
parseVer :: Text -> Maybe Ver
parseVer str :: Text
str = case [(Version, String)] -> [(Version, String)]
forall a. [a] -> [a]
reverse ([(Version, String)] -> [(Version, String)])
-> [(Version, String)] -> [(Version, String)]
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 -> String
T.unpack Text
str) of
(ver :: Version
ver, "") : _ | Bool -> Bool
not ([Int] -> 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
>= 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)
_ -> Maybe Ver
forall a. Maybe a
Nothing
dispVer :: Ver -> Text
dispVer :: Ver -> Text
dispVer (Ver ns :: [Int]
ns) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "." ((Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
forall a. Show a => a -> String
show [Int]
ns)
instance FromJSON Ver where
parseJSON :: Value -> Parser Ver
parseJSON = String -> (Text -> Parser Ver) -> Value -> Parser Ver
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "Ver" (Parser Ver -> (Ver -> Parser Ver) -> Maybe Ver -> Parser Ver
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser Ver
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Ver") Ver -> Parser Ver
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 t :: Text
t = do
let (pns_ :: Text
pns_, pvs :: Text
pvs) = Text -> Text -> (Text, Text)
T.breakOnEnd "-" Text
t
Ver
pv <- Text -> Maybe Ver
parseVer Text
pvs
Text
pn <- Text -> Text -> Maybe Text
T.stripSuffix "-" Text
pns_
PkgId -> Maybe PkgId
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PkgName -> Ver -> PkgId
PkgId (Text -> PkgName
PkgName Text
pn) Ver
pv)
dispPkgId :: PkgId -> Text
dispPkgId :: PkgId -> Text
dispPkgId (PkgId (PkgName pn :: Text
pn) pv :: Ver
pv) = Text
pn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ver -> Text
dispVer Ver
pv
dispSha256 :: Sha256 -> Text
dispSha256 :: Sha256 -> Text
dispSha256 (Sha256 s :: ByteString
s) = ByteString -> Text
T.decodeLatin1 (ByteString -> ByteString
B16.encode ByteString
s)
parseSha256 :: Text -> Maybe Sha256
parseSha256 :: Text -> Maybe Sha256
parseSha256 t :: Text
t
| ByteString -> Int
B.length ByteString
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 32, ByteString -> Bool
B.null ByteString
rest = Sha256 -> Maybe Sha256
forall a. a -> Maybe a
Just (ByteString -> Sha256
Sha256 ByteString
s)
| Bool
otherwise = Maybe Sha256
forall a. Maybe a
Nothing
where
(s :: ByteString
s, rest :: ByteString
rest) = ByteString -> (ByteString, ByteString)
B16.decode (ByteString -> (ByteString, ByteString))
-> ByteString -> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
t
sha256ToByteString :: Sha256 -> B.ByteString
sha256ToByteString :: Sha256 -> ByteString
sha256ToByteString (Sha256 bs :: ByteString
bs) = ByteString
bs
sha256FromByteString :: B.ByteString -> Maybe Sha256
sha256FromByteString :: ByteString -> Maybe Sha256
sha256FromByteString bs :: ByteString
bs
| ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 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 = String -> (Text -> Parser Sha256) -> Value -> Parser Sha256
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "Sha256" (Parser Sha256
-> (Sha256 -> Parser Sha256) -> Maybe Sha256 -> Parser Sha256
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser Sha256
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Sha256") Sha256 -> Parser Sha256
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 -> String
show = Text -> String
forall a. Show a => a -> String
show (Text -> String) -> (Sha256 -> Text) -> Sha256 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sha256 -> Text
dispSha256
planJsonIdGraph :: PlanJson -> Map UnitId (Set UnitId)
planJsonIdGraph :: PlanJson -> Map UnitId (Set UnitId)
planJsonIdGraph PlanJson{..} = [(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
]
planJsonIdRoots :: PlanJson -> Set UnitId
planJsonIdRoots :: PlanJson -> Set UnitId
planJsonIdRoots PlanJson{..} = 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 $WPlanJson :: Ver -> Ver -> PkgId -> Text -> Text -> Map UnitId Unit -> PlanJson
PlanJson{..}