-- |Description: Types for pruning.
module Data.Prune.Types where

import Prelude

import Data.Aeson ((.:), FromJSON, parseJSON, withObject)
import Data.Set (Set)
import Data.Text (Text, pack, unpack)
import Distribution.Types.Dependency (Dependency)
import Distribution.Types.GenericPackageDescription (GenericPackageDescription)
import Distribution.Types.UnqualComponentName (UnqualComponentName)
import qualified Distribution.Types.Dependency as Dependency
import qualified Distribution.Types.PackageName as PackageName
import qualified Distribution.Types.UnqualComponentName as UnqualComponentName

data BuildSystem = Stack | CabalProject | Cabal
  deriving (BuildSystem -> BuildSystem -> Bool
(BuildSystem -> BuildSystem -> Bool)
-> (BuildSystem -> BuildSystem -> Bool) -> Eq BuildSystem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BuildSystem -> BuildSystem -> Bool
$c/= :: BuildSystem -> BuildSystem -> Bool
== :: BuildSystem -> BuildSystem -> Bool
$c== :: BuildSystem -> BuildSystem -> Bool
Eq, Eq BuildSystem
Eq BuildSystem
-> (BuildSystem -> BuildSystem -> Ordering)
-> (BuildSystem -> BuildSystem -> Bool)
-> (BuildSystem -> BuildSystem -> Bool)
-> (BuildSystem -> BuildSystem -> Bool)
-> (BuildSystem -> BuildSystem -> Bool)
-> (BuildSystem -> BuildSystem -> BuildSystem)
-> (BuildSystem -> BuildSystem -> BuildSystem)
-> Ord BuildSystem
BuildSystem -> BuildSystem -> Bool
BuildSystem -> BuildSystem -> Ordering
BuildSystem -> BuildSystem -> BuildSystem
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 :: BuildSystem -> BuildSystem -> BuildSystem
$cmin :: BuildSystem -> BuildSystem -> BuildSystem
max :: BuildSystem -> BuildSystem -> BuildSystem
$cmax :: BuildSystem -> BuildSystem -> BuildSystem
>= :: BuildSystem -> BuildSystem -> Bool
$c>= :: BuildSystem -> BuildSystem -> Bool
> :: BuildSystem -> BuildSystem -> Bool
$c> :: BuildSystem -> BuildSystem -> Bool
<= :: BuildSystem -> BuildSystem -> Bool
$c<= :: BuildSystem -> BuildSystem -> Bool
< :: BuildSystem -> BuildSystem -> Bool
$c< :: BuildSystem -> BuildSystem -> Bool
compare :: BuildSystem -> BuildSystem -> Ordering
$ccompare :: BuildSystem -> BuildSystem -> Ordering
$cp1Ord :: Eq BuildSystem
Ord, BuildSystem
BuildSystem -> BuildSystem -> Bounded BuildSystem
forall a. a -> a -> Bounded a
maxBound :: BuildSystem
$cmaxBound :: BuildSystem
minBound :: BuildSystem
$cminBound :: BuildSystem
Bounded, Int -> BuildSystem
BuildSystem -> Int
BuildSystem -> [BuildSystem]
BuildSystem -> BuildSystem
BuildSystem -> BuildSystem -> [BuildSystem]
BuildSystem -> BuildSystem -> BuildSystem -> [BuildSystem]
(BuildSystem -> BuildSystem)
-> (BuildSystem -> BuildSystem)
-> (Int -> BuildSystem)
-> (BuildSystem -> Int)
-> (BuildSystem -> [BuildSystem])
-> (BuildSystem -> BuildSystem -> [BuildSystem])
-> (BuildSystem -> BuildSystem -> [BuildSystem])
-> (BuildSystem -> BuildSystem -> BuildSystem -> [BuildSystem])
-> Enum BuildSystem
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BuildSystem -> BuildSystem -> BuildSystem -> [BuildSystem]
$cenumFromThenTo :: BuildSystem -> BuildSystem -> BuildSystem -> [BuildSystem]
enumFromTo :: BuildSystem -> BuildSystem -> [BuildSystem]
$cenumFromTo :: BuildSystem -> BuildSystem -> [BuildSystem]
enumFromThen :: BuildSystem -> BuildSystem -> [BuildSystem]
$cenumFromThen :: BuildSystem -> BuildSystem -> [BuildSystem]
enumFrom :: BuildSystem -> [BuildSystem]
$cenumFrom :: BuildSystem -> [BuildSystem]
fromEnum :: BuildSystem -> Int
$cfromEnum :: BuildSystem -> Int
toEnum :: Int -> BuildSystem
$ctoEnum :: Int -> BuildSystem
pred :: BuildSystem -> BuildSystem
$cpred :: BuildSystem -> BuildSystem
succ :: BuildSystem -> BuildSystem
$csucc :: BuildSystem -> BuildSystem
Enum)

instance Show BuildSystem where
  show :: BuildSystem -> String
show = \case
    BuildSystem
Stack -> String
"stack"
    BuildSystem
CabalProject -> String
"cabal-project"
    BuildSystem
Cabal -> String
"cabal"

parseBuildSystem :: String -> Maybe BuildSystem
parseBuildSystem :: String -> Maybe BuildSystem
parseBuildSystem = \case
  String
"stack" -> BuildSystem -> Maybe BuildSystem
forall a. a -> Maybe a
Just BuildSystem
Stack
  String
"cabal-project" -> BuildSystem -> Maybe BuildSystem
forall a. a -> Maybe a
Just BuildSystem
CabalProject
  String
"cabal" -> BuildSystem -> Maybe BuildSystem
forall a. a -> Maybe a
Just BuildSystem
Cabal
  String
_ -> Maybe BuildSystem
forall a. Maybe a
Nothing

allBuildSystems :: [BuildSystem]
allBuildSystems :: [BuildSystem]
allBuildSystems = [BuildSystem
forall a. Bounded a => a
minBound..BuildSystem
forall a. Bounded a => a
maxBound]

data Verbosity = Silent | Error | Info | Debug
  deriving (Verbosity -> Verbosity -> Bool
(Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool) -> Eq Verbosity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Verbosity -> Verbosity -> Bool
$c/= :: Verbosity -> Verbosity -> Bool
== :: Verbosity -> Verbosity -> Bool
$c== :: Verbosity -> Verbosity -> Bool
Eq, Eq Verbosity
Eq Verbosity
-> (Verbosity -> Verbosity -> Ordering)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Verbosity)
-> (Verbosity -> Verbosity -> Verbosity)
-> Ord Verbosity
Verbosity -> Verbosity -> Bool
Verbosity -> Verbosity -> Ordering
Verbosity -> Verbosity -> Verbosity
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 :: Verbosity -> Verbosity -> Verbosity
$cmin :: Verbosity -> Verbosity -> Verbosity
max :: Verbosity -> Verbosity -> Verbosity
$cmax :: Verbosity -> Verbosity -> Verbosity
>= :: Verbosity -> Verbosity -> Bool
$c>= :: Verbosity -> Verbosity -> Bool
> :: Verbosity -> Verbosity -> Bool
$c> :: Verbosity -> Verbosity -> Bool
<= :: Verbosity -> Verbosity -> Bool
$c<= :: Verbosity -> Verbosity -> Bool
< :: Verbosity -> Verbosity -> Bool
$c< :: Verbosity -> Verbosity -> Bool
compare :: Verbosity -> Verbosity -> Ordering
$ccompare :: Verbosity -> Verbosity -> Ordering
$cp1Ord :: Eq Verbosity
Ord, Verbosity
Verbosity -> Verbosity -> Bounded Verbosity
forall a. a -> a -> Bounded a
maxBound :: Verbosity
$cmaxBound :: Verbosity
minBound :: Verbosity
$cminBound :: Verbosity
Bounded, Int -> Verbosity
Verbosity -> Int
Verbosity -> [Verbosity]
Verbosity -> Verbosity
Verbosity -> Verbosity -> [Verbosity]
Verbosity -> Verbosity -> Verbosity -> [Verbosity]
(Verbosity -> Verbosity)
-> (Verbosity -> Verbosity)
-> (Int -> Verbosity)
-> (Verbosity -> Int)
-> (Verbosity -> [Verbosity])
-> (Verbosity -> Verbosity -> [Verbosity])
-> (Verbosity -> Verbosity -> [Verbosity])
-> (Verbosity -> Verbosity -> Verbosity -> [Verbosity])
-> Enum Verbosity
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Verbosity -> Verbosity -> Verbosity -> [Verbosity]
$cenumFromThenTo :: Verbosity -> Verbosity -> Verbosity -> [Verbosity]
enumFromTo :: Verbosity -> Verbosity -> [Verbosity]
$cenumFromTo :: Verbosity -> Verbosity -> [Verbosity]
enumFromThen :: Verbosity -> Verbosity -> [Verbosity]
$cenumFromThen :: Verbosity -> Verbosity -> [Verbosity]
enumFrom :: Verbosity -> [Verbosity]
$cenumFrom :: Verbosity -> [Verbosity]
fromEnum :: Verbosity -> Int
$cfromEnum :: Verbosity -> Int
toEnum :: Int -> Verbosity
$ctoEnum :: Int -> Verbosity
pred :: Verbosity -> Verbosity
$cpred :: Verbosity -> Verbosity
succ :: Verbosity -> Verbosity
$csucc :: Verbosity -> Verbosity
Enum)

instance Show Verbosity where
  show :: Verbosity -> String
show = \case
    Verbosity
Silent -> String
"silent"
    Verbosity
Error -> String
"error"
    Verbosity
Info -> String
"info"
    Verbosity
Debug -> String
"debug"

parseVerbosity :: String -> Maybe Verbosity
parseVerbosity :: String -> Maybe Verbosity
parseVerbosity = \case
  String
"silent" -> Verbosity -> Maybe Verbosity
forall a. a -> Maybe a
Just Verbosity
Silent
  String
"error" -> Verbosity -> Maybe Verbosity
forall a. a -> Maybe a
Just Verbosity
Error
  String
"info" -> Verbosity -> Maybe Verbosity
forall a. a -> Maybe a
Just Verbosity
Info
  String
"debug" -> Verbosity -> Maybe Verbosity
forall a. a -> Maybe a
Just Verbosity
Debug
  String
_ -> Maybe Verbosity
forall a. Maybe a
Nothing

allVerbosities :: [Verbosity]
allVerbosities :: [Verbosity]
allVerbosities = [Verbosity
forall a. Bounded a => a
minBound..Verbosity
forall a. Bounded a => a
maxBound]

-- |The type of the thing to compile.
data CompilableType
  = CompilableTypeLibrary
  | CompilableTypeExecutable
  | CompilableTypeTest
  | CompilableTypeBenchmark
  deriving (CompilableType -> CompilableType -> Bool
(CompilableType -> CompilableType -> Bool)
-> (CompilableType -> CompilableType -> Bool) -> Eq CompilableType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompilableType -> CompilableType -> Bool
$c/= :: CompilableType -> CompilableType -> Bool
== :: CompilableType -> CompilableType -> Bool
$c== :: CompilableType -> CompilableType -> Bool
Eq, Eq CompilableType
Eq CompilableType
-> (CompilableType -> CompilableType -> Ordering)
-> (CompilableType -> CompilableType -> Bool)
-> (CompilableType -> CompilableType -> Bool)
-> (CompilableType -> CompilableType -> Bool)
-> (CompilableType -> CompilableType -> Bool)
-> (CompilableType -> CompilableType -> CompilableType)
-> (CompilableType -> CompilableType -> CompilableType)
-> Ord CompilableType
CompilableType -> CompilableType -> Bool
CompilableType -> CompilableType -> Ordering
CompilableType -> CompilableType -> CompilableType
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 :: CompilableType -> CompilableType -> CompilableType
$cmin :: CompilableType -> CompilableType -> CompilableType
max :: CompilableType -> CompilableType -> CompilableType
$cmax :: CompilableType -> CompilableType -> CompilableType
>= :: CompilableType -> CompilableType -> Bool
$c>= :: CompilableType -> CompilableType -> Bool
> :: CompilableType -> CompilableType -> Bool
$c> :: CompilableType -> CompilableType -> Bool
<= :: CompilableType -> CompilableType -> Bool
$c<= :: CompilableType -> CompilableType -> Bool
< :: CompilableType -> CompilableType -> Bool
$c< :: CompilableType -> CompilableType -> Bool
compare :: CompilableType -> CompilableType -> Ordering
$ccompare :: CompilableType -> CompilableType -> Ordering
$cp1Ord :: Eq CompilableType
Ord)

instance Show CompilableType where
  show :: CompilableType -> String
show = \case
    CompilableType
CompilableTypeLibrary -> String
"library"
    CompilableType
CompilableTypeExecutable -> String
"executable"
    CompilableType
CompilableTypeTest -> String
"test"
    CompilableType
CompilableTypeBenchmark -> String
"benchmark"

-- |The name of the thing to compile.
newtype CompilableName = CompilableName { CompilableName -> Text
unCompilableName :: Text }
  deriving (CompilableName -> CompilableName -> Bool
(CompilableName -> CompilableName -> Bool)
-> (CompilableName -> CompilableName -> Bool) -> Eq CompilableName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompilableName -> CompilableName -> Bool
$c/= :: CompilableName -> CompilableName -> Bool
== :: CompilableName -> CompilableName -> Bool
$c== :: CompilableName -> CompilableName -> Bool
Eq, Eq CompilableName
Eq CompilableName
-> (CompilableName -> CompilableName -> Ordering)
-> (CompilableName -> CompilableName -> Bool)
-> (CompilableName -> CompilableName -> Bool)
-> (CompilableName -> CompilableName -> Bool)
-> (CompilableName -> CompilableName -> Bool)
-> (CompilableName -> CompilableName -> CompilableName)
-> (CompilableName -> CompilableName -> CompilableName)
-> Ord CompilableName
CompilableName -> CompilableName -> Bool
CompilableName -> CompilableName -> Ordering
CompilableName -> CompilableName -> CompilableName
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 :: CompilableName -> CompilableName -> CompilableName
$cmin :: CompilableName -> CompilableName -> CompilableName
max :: CompilableName -> CompilableName -> CompilableName
$cmax :: CompilableName -> CompilableName -> CompilableName
>= :: CompilableName -> CompilableName -> Bool
$c>= :: CompilableName -> CompilableName -> Bool
> :: CompilableName -> CompilableName -> Bool
$c> :: CompilableName -> CompilableName -> Bool
<= :: CompilableName -> CompilableName -> Bool
$c<= :: CompilableName -> CompilableName -> Bool
< :: CompilableName -> CompilableName -> Bool
$c< :: CompilableName -> CompilableName -> Bool
compare :: CompilableName -> CompilableName -> Ordering
$ccompare :: CompilableName -> CompilableName -> Ordering
$cp1Ord :: Eq CompilableName
Ord)

instance Show CompilableName where
  show :: CompilableName -> String
show = Text -> String
unpack (Text -> String)
-> (CompilableName -> Text) -> CompilableName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompilableName -> Text
unCompilableName

-- |The name of the dependency as listed in package.yaml
data DependencyName = DependencyName { DependencyName -> Text
unDependencyName :: Text }
  deriving (DependencyName -> DependencyName -> Bool
(DependencyName -> DependencyName -> Bool)
-> (DependencyName -> DependencyName -> Bool) -> Eq DependencyName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DependencyName -> DependencyName -> Bool
$c/= :: DependencyName -> DependencyName -> Bool
== :: DependencyName -> DependencyName -> Bool
$c== :: DependencyName -> DependencyName -> Bool
Eq, Eq DependencyName
Eq DependencyName
-> (DependencyName -> DependencyName -> Ordering)
-> (DependencyName -> DependencyName -> Bool)
-> (DependencyName -> DependencyName -> Bool)
-> (DependencyName -> DependencyName -> Bool)
-> (DependencyName -> DependencyName -> Bool)
-> (DependencyName -> DependencyName -> DependencyName)
-> (DependencyName -> DependencyName -> DependencyName)
-> Ord DependencyName
DependencyName -> DependencyName -> Bool
DependencyName -> DependencyName -> Ordering
DependencyName -> DependencyName -> DependencyName
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 :: DependencyName -> DependencyName -> DependencyName
$cmin :: DependencyName -> DependencyName -> DependencyName
max :: DependencyName -> DependencyName -> DependencyName
$cmax :: DependencyName -> DependencyName -> DependencyName
>= :: DependencyName -> DependencyName -> Bool
$c>= :: DependencyName -> DependencyName -> Bool
> :: DependencyName -> DependencyName -> Bool
$c> :: DependencyName -> DependencyName -> Bool
<= :: DependencyName -> DependencyName -> Bool
$c<= :: DependencyName -> DependencyName -> Bool
< :: DependencyName -> DependencyName -> Bool
$c< :: DependencyName -> DependencyName -> Bool
compare :: DependencyName -> DependencyName -> Ordering
$ccompare :: DependencyName -> DependencyName -> Ordering
$cp1Ord :: Eq DependencyName
Ord)

instance Show DependencyName where
  show :: DependencyName -> String
show = Text -> String
unpack (Text -> String)
-> (DependencyName -> Text) -> DependencyName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DependencyName -> Text
unDependencyName

-- |A qualified module name, like @Foo.Bar@
data ModuleName = ModuleName { ModuleName -> Text
unModuleName :: Text }
  deriving (ModuleName -> ModuleName -> Bool
(ModuleName -> ModuleName -> Bool)
-> (ModuleName -> ModuleName -> Bool) -> Eq ModuleName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModuleName -> ModuleName -> Bool
$c/= :: ModuleName -> ModuleName -> Bool
== :: ModuleName -> ModuleName -> Bool
$c== :: ModuleName -> ModuleName -> Bool
Eq, Eq ModuleName
Eq ModuleName
-> (ModuleName -> ModuleName -> Ordering)
-> (ModuleName -> ModuleName -> Bool)
-> (ModuleName -> ModuleName -> Bool)
-> (ModuleName -> ModuleName -> Bool)
-> (ModuleName -> ModuleName -> Bool)
-> (ModuleName -> ModuleName -> ModuleName)
-> (ModuleName -> ModuleName -> ModuleName)
-> Ord ModuleName
ModuleName -> ModuleName -> Bool
ModuleName -> ModuleName -> Ordering
ModuleName -> ModuleName -> ModuleName
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 :: ModuleName -> ModuleName -> ModuleName
$cmin :: ModuleName -> ModuleName -> ModuleName
max :: ModuleName -> ModuleName -> ModuleName
$cmax :: ModuleName -> ModuleName -> ModuleName
>= :: ModuleName -> ModuleName -> Bool
$c>= :: ModuleName -> ModuleName -> Bool
> :: ModuleName -> ModuleName -> Bool
$c> :: ModuleName -> ModuleName -> Bool
<= :: ModuleName -> ModuleName -> Bool
$c<= :: ModuleName -> ModuleName -> Bool
< :: ModuleName -> ModuleName -> Bool
$c< :: ModuleName -> ModuleName -> Bool
compare :: ModuleName -> ModuleName -> Ordering
$ccompare :: ModuleName -> ModuleName -> Ordering
$cp1Ord :: Eq ModuleName
Ord)

instance Show ModuleName where
  show :: ModuleName -> String
show = Text -> String
unpack (Text -> String) -> (ModuleName -> Text) -> ModuleName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> Text
unModuleName

-- |A thing to compile.
data Compilable = Compilable
  { Compilable -> CompilableName
compilableName :: CompilableName
  , Compilable -> CompilableType
compilableType :: CompilableType
  , Compilable -> Set DependencyName
compilableDependencies :: Set DependencyName
  -- ^ The list of dependencies less the common dependencies.
  , Compilable -> Set String
compilableFiles :: Set FilePath
  -- ^ The files under `source-dirs`.
  }
  deriving (Compilable -> Compilable -> Bool
(Compilable -> Compilable -> Bool)
-> (Compilable -> Compilable -> Bool) -> Eq Compilable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Compilable -> Compilable -> Bool
$c/= :: Compilable -> Compilable -> Bool
== :: Compilable -> Compilable -> Bool
$c== :: Compilable -> Compilable -> Bool
Eq, Eq Compilable
Eq Compilable
-> (Compilable -> Compilable -> Ordering)
-> (Compilable -> Compilable -> Bool)
-> (Compilable -> Compilable -> Bool)
-> (Compilable -> Compilable -> Bool)
-> (Compilable -> Compilable -> Bool)
-> (Compilable -> Compilable -> Compilable)
-> (Compilable -> Compilable -> Compilable)
-> Ord Compilable
Compilable -> Compilable -> Bool
Compilable -> Compilable -> Ordering
Compilable -> Compilable -> Compilable
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 :: Compilable -> Compilable -> Compilable
$cmin :: Compilable -> Compilable -> Compilable
max :: Compilable -> Compilable -> Compilable
$cmax :: Compilable -> Compilable -> Compilable
>= :: Compilable -> Compilable -> Bool
$c>= :: Compilable -> Compilable -> Bool
> :: Compilable -> Compilable -> Bool
$c> :: Compilable -> Compilable -> Bool
<= :: Compilable -> Compilable -> Bool
$c<= :: Compilable -> Compilable -> Bool
< :: Compilable -> Compilable -> Bool
$c< :: Compilable -> Compilable -> Bool
compare :: Compilable -> Compilable -> Ordering
$ccompare :: Compilable -> Compilable -> Ordering
$cp1Ord :: Eq Compilable
Ord, Int -> Compilable -> ShowS
[Compilable] -> ShowS
Compilable -> String
(Int -> Compilable -> ShowS)
-> (Compilable -> String)
-> ([Compilable] -> ShowS)
-> Show Compilable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Compilable] -> ShowS
$cshowList :: [Compilable] -> ShowS
show :: Compilable -> String
$cshow :: Compilable -> String
showsPrec :: Int -> Compilable -> ShowS
$cshowsPrec :: Int -> Compilable -> ShowS
Show)

data Package = Package
  { Package -> Text
packageName :: Text
  -- ^ The name of the package.
  , Package -> String
packageFile :: FilePath
  -- ^ The location of the cabal file.
  , Package -> GenericPackageDescription
packageDescription :: GenericPackageDescription
  -- ^ The path to the config file.
  , Package -> Set DependencyName
packageBaseDependencies :: Set DependencyName
  -- ^ The list of common dependencies.
  , Package -> [Compilable]
packageCompilables :: [Compilable]
  -- ^ The things to compile in the package.
  }
  deriving (Package -> Package -> Bool
(Package -> Package -> Bool)
-> (Package -> Package -> Bool) -> Eq Package
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Package -> Package -> Bool
$c/= :: Package -> Package -> Bool
== :: Package -> Package -> Bool
$c== :: Package -> Package -> Bool
Eq, Int -> Package -> ShowS
[Package] -> ShowS
Package -> String
(Int -> Package -> ShowS)
-> (Package -> String) -> ([Package] -> ShowS) -> Show Package
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Package] -> ShowS
$cshowList :: [Package] -> ShowS
show :: Package -> String
$cshow :: Package -> String
showsPrec :: Int -> Package -> ShowS
$cshowsPrec :: Int -> Package -> ShowS
Show)

data StackYaml = StackYaml
  { StackYaml -> [String]
stackYamlPackages :: [FilePath]
  -- ^ The list of packages in stack.yaml. FIXME not every package is this way.
  }
  deriving (StackYaml -> StackYaml -> Bool
(StackYaml -> StackYaml -> Bool)
-> (StackYaml -> StackYaml -> Bool) -> Eq StackYaml
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StackYaml -> StackYaml -> Bool
$c/= :: StackYaml -> StackYaml -> Bool
== :: StackYaml -> StackYaml -> Bool
$c== :: StackYaml -> StackYaml -> Bool
Eq, Eq StackYaml
Eq StackYaml
-> (StackYaml -> StackYaml -> Ordering)
-> (StackYaml -> StackYaml -> Bool)
-> (StackYaml -> StackYaml -> Bool)
-> (StackYaml -> StackYaml -> Bool)
-> (StackYaml -> StackYaml -> Bool)
-> (StackYaml -> StackYaml -> StackYaml)
-> (StackYaml -> StackYaml -> StackYaml)
-> Ord StackYaml
StackYaml -> StackYaml -> Bool
StackYaml -> StackYaml -> Ordering
StackYaml -> StackYaml -> StackYaml
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 :: StackYaml -> StackYaml -> StackYaml
$cmin :: StackYaml -> StackYaml -> StackYaml
max :: StackYaml -> StackYaml -> StackYaml
$cmax :: StackYaml -> StackYaml -> StackYaml
>= :: StackYaml -> StackYaml -> Bool
$c>= :: StackYaml -> StackYaml -> Bool
> :: StackYaml -> StackYaml -> Bool
$c> :: StackYaml -> StackYaml -> Bool
<= :: StackYaml -> StackYaml -> Bool
$c<= :: StackYaml -> StackYaml -> Bool
< :: StackYaml -> StackYaml -> Bool
$c< :: StackYaml -> StackYaml -> Bool
compare :: StackYaml -> StackYaml -> Ordering
$ccompare :: StackYaml -> StackYaml -> Ordering
$cp1Ord :: Eq StackYaml
Ord, Int -> StackYaml -> ShowS
[StackYaml] -> ShowS
StackYaml -> String
(Int -> StackYaml -> ShowS)
-> (StackYaml -> String)
-> ([StackYaml] -> ShowS)
-> Show StackYaml
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StackYaml] -> ShowS
$cshowList :: [StackYaml] -> ShowS
show :: StackYaml -> String
$cshow :: StackYaml -> String
showsPrec :: Int -> StackYaml -> ShowS
$cshowsPrec :: Int -> StackYaml -> ShowS
Show)

instance FromJSON StackYaml where
  parseJSON :: Value -> Parser StackYaml
parseJSON = String -> (Object -> Parser StackYaml) -> Value -> Parser StackYaml
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"StackYaml" ((Object -> Parser StackYaml) -> Value -> Parser StackYaml)
-> (Object -> Parser StackYaml) -> Value -> Parser StackYaml
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
    [String] -> StackYaml
StackYaml
      ([String] -> StackYaml) -> Parser [String] -> Parser StackYaml
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser [String]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"packages"

data ShouldApply = ShouldNotApply | ShouldApply | ShouldApplyNoVerify
  deriving (ShouldApply -> ShouldApply -> Bool
(ShouldApply -> ShouldApply -> Bool)
-> (ShouldApply -> ShouldApply -> Bool) -> Eq ShouldApply
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShouldApply -> ShouldApply -> Bool
$c/= :: ShouldApply -> ShouldApply -> Bool
== :: ShouldApply -> ShouldApply -> Bool
$c== :: ShouldApply -> ShouldApply -> Bool
Eq, Eq ShouldApply
Eq ShouldApply
-> (ShouldApply -> ShouldApply -> Ordering)
-> (ShouldApply -> ShouldApply -> Bool)
-> (ShouldApply -> ShouldApply -> Bool)
-> (ShouldApply -> ShouldApply -> Bool)
-> (ShouldApply -> ShouldApply -> Bool)
-> (ShouldApply -> ShouldApply -> ShouldApply)
-> (ShouldApply -> ShouldApply -> ShouldApply)
-> Ord ShouldApply
ShouldApply -> ShouldApply -> Bool
ShouldApply -> ShouldApply -> Ordering
ShouldApply -> ShouldApply -> ShouldApply
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 :: ShouldApply -> ShouldApply -> ShouldApply
$cmin :: ShouldApply -> ShouldApply -> ShouldApply
max :: ShouldApply -> ShouldApply -> ShouldApply
$cmax :: ShouldApply -> ShouldApply -> ShouldApply
>= :: ShouldApply -> ShouldApply -> Bool
$c>= :: ShouldApply -> ShouldApply -> Bool
> :: ShouldApply -> ShouldApply -> Bool
$c> :: ShouldApply -> ShouldApply -> Bool
<= :: ShouldApply -> ShouldApply -> Bool
$c<= :: ShouldApply -> ShouldApply -> Bool
< :: ShouldApply -> ShouldApply -> Bool
$c< :: ShouldApply -> ShouldApply -> Bool
compare :: ShouldApply -> ShouldApply -> Ordering
$ccompare :: ShouldApply -> ShouldApply -> Ordering
$cp1Ord :: Eq ShouldApply
Ord, ShouldApply
ShouldApply -> ShouldApply -> Bounded ShouldApply
forall a. a -> a -> Bounded a
maxBound :: ShouldApply
$cmaxBound :: ShouldApply
minBound :: ShouldApply
$cminBound :: ShouldApply
Bounded, Int -> ShouldApply
ShouldApply -> Int
ShouldApply -> [ShouldApply]
ShouldApply -> ShouldApply
ShouldApply -> ShouldApply -> [ShouldApply]
ShouldApply -> ShouldApply -> ShouldApply -> [ShouldApply]
(ShouldApply -> ShouldApply)
-> (ShouldApply -> ShouldApply)
-> (Int -> ShouldApply)
-> (ShouldApply -> Int)
-> (ShouldApply -> [ShouldApply])
-> (ShouldApply -> ShouldApply -> [ShouldApply])
-> (ShouldApply -> ShouldApply -> [ShouldApply])
-> (ShouldApply -> ShouldApply -> ShouldApply -> [ShouldApply])
-> Enum ShouldApply
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ShouldApply -> ShouldApply -> ShouldApply -> [ShouldApply]
$cenumFromThenTo :: ShouldApply -> ShouldApply -> ShouldApply -> [ShouldApply]
enumFromTo :: ShouldApply -> ShouldApply -> [ShouldApply]
$cenumFromTo :: ShouldApply -> ShouldApply -> [ShouldApply]
enumFromThen :: ShouldApply -> ShouldApply -> [ShouldApply]
$cenumFromThen :: ShouldApply -> ShouldApply -> [ShouldApply]
enumFrom :: ShouldApply -> [ShouldApply]
$cenumFrom :: ShouldApply -> [ShouldApply]
fromEnum :: ShouldApply -> Int
$cfromEnum :: ShouldApply -> Int
toEnum :: Int -> ShouldApply
$ctoEnum :: Int -> ShouldApply
pred :: ShouldApply -> ShouldApply
$cpred :: ShouldApply -> ShouldApply
succ :: ShouldApply -> ShouldApply
$csucc :: ShouldApply -> ShouldApply
Enum)

instance Show ShouldApply where
  show :: ShouldApply -> String
show = \case
    ShouldApply
ShouldNotApply -> String
"no-apply"
    ShouldApply
ShouldApply -> String
"apply"
    ShouldApply
ShouldApplyNoVerify -> String
"apply-no-verify"

validateShouldApply :: (Bool, Bool) -> ShouldApply
validateShouldApply :: (Bool, Bool) -> ShouldApply
validateShouldApply = \case
  (Bool
_, Bool
True) -> ShouldApply
ShouldApplyNoVerify
  (Bool
True, Bool
False) -> ShouldApply
ShouldApply
  (Bool
False, Bool
False) -> ShouldApply
ShouldNotApply

allApply :: [ShouldApply]
allApply :: [ShouldApply]
allApply = [ShouldApply
forall a. Bounded a => a
minBound..ShouldApply
forall a. Bounded a => a
maxBound]

data ApplyStrategy = ApplyStrategySafe | ApplyStrategySmart
  deriving (ApplyStrategy -> ApplyStrategy -> Bool
(ApplyStrategy -> ApplyStrategy -> Bool)
-> (ApplyStrategy -> ApplyStrategy -> Bool) -> Eq ApplyStrategy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplyStrategy -> ApplyStrategy -> Bool
$c/= :: ApplyStrategy -> ApplyStrategy -> Bool
== :: ApplyStrategy -> ApplyStrategy -> Bool
$c== :: ApplyStrategy -> ApplyStrategy -> Bool
Eq, Eq ApplyStrategy
Eq ApplyStrategy
-> (ApplyStrategy -> ApplyStrategy -> Ordering)
-> (ApplyStrategy -> ApplyStrategy -> Bool)
-> (ApplyStrategy -> ApplyStrategy -> Bool)
-> (ApplyStrategy -> ApplyStrategy -> Bool)
-> (ApplyStrategy -> ApplyStrategy -> Bool)
-> (ApplyStrategy -> ApplyStrategy -> ApplyStrategy)
-> (ApplyStrategy -> ApplyStrategy -> ApplyStrategy)
-> Ord ApplyStrategy
ApplyStrategy -> ApplyStrategy -> Bool
ApplyStrategy -> ApplyStrategy -> Ordering
ApplyStrategy -> ApplyStrategy -> ApplyStrategy
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 :: ApplyStrategy -> ApplyStrategy -> ApplyStrategy
$cmin :: ApplyStrategy -> ApplyStrategy -> ApplyStrategy
max :: ApplyStrategy -> ApplyStrategy -> ApplyStrategy
$cmax :: ApplyStrategy -> ApplyStrategy -> ApplyStrategy
>= :: ApplyStrategy -> ApplyStrategy -> Bool
$c>= :: ApplyStrategy -> ApplyStrategy -> Bool
> :: ApplyStrategy -> ApplyStrategy -> Bool
$c> :: ApplyStrategy -> ApplyStrategy -> Bool
<= :: ApplyStrategy -> ApplyStrategy -> Bool
$c<= :: ApplyStrategy -> ApplyStrategy -> Bool
< :: ApplyStrategy -> ApplyStrategy -> Bool
$c< :: ApplyStrategy -> ApplyStrategy -> Bool
compare :: ApplyStrategy -> ApplyStrategy -> Ordering
$ccompare :: ApplyStrategy -> ApplyStrategy -> Ordering
$cp1Ord :: Eq ApplyStrategy
Ord, ApplyStrategy
ApplyStrategy -> ApplyStrategy -> Bounded ApplyStrategy
forall a. a -> a -> Bounded a
maxBound :: ApplyStrategy
$cmaxBound :: ApplyStrategy
minBound :: ApplyStrategy
$cminBound :: ApplyStrategy
Bounded, Int -> ApplyStrategy
ApplyStrategy -> Int
ApplyStrategy -> [ApplyStrategy]
ApplyStrategy -> ApplyStrategy
ApplyStrategy -> ApplyStrategy -> [ApplyStrategy]
ApplyStrategy -> ApplyStrategy -> ApplyStrategy -> [ApplyStrategy]
(ApplyStrategy -> ApplyStrategy)
-> (ApplyStrategy -> ApplyStrategy)
-> (Int -> ApplyStrategy)
-> (ApplyStrategy -> Int)
-> (ApplyStrategy -> [ApplyStrategy])
-> (ApplyStrategy -> ApplyStrategy -> [ApplyStrategy])
-> (ApplyStrategy -> ApplyStrategy -> [ApplyStrategy])
-> (ApplyStrategy
    -> ApplyStrategy -> ApplyStrategy -> [ApplyStrategy])
-> Enum ApplyStrategy
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ApplyStrategy -> ApplyStrategy -> ApplyStrategy -> [ApplyStrategy]
$cenumFromThenTo :: ApplyStrategy -> ApplyStrategy -> ApplyStrategy -> [ApplyStrategy]
enumFromTo :: ApplyStrategy -> ApplyStrategy -> [ApplyStrategy]
$cenumFromTo :: ApplyStrategy -> ApplyStrategy -> [ApplyStrategy]
enumFromThen :: ApplyStrategy -> ApplyStrategy -> [ApplyStrategy]
$cenumFromThen :: ApplyStrategy -> ApplyStrategy -> [ApplyStrategy]
enumFrom :: ApplyStrategy -> [ApplyStrategy]
$cenumFrom :: ApplyStrategy -> [ApplyStrategy]
fromEnum :: ApplyStrategy -> Int
$cfromEnum :: ApplyStrategy -> Int
toEnum :: Int -> ApplyStrategy
$ctoEnum :: Int -> ApplyStrategy
pred :: ApplyStrategy -> ApplyStrategy
$cpred :: ApplyStrategy -> ApplyStrategy
succ :: ApplyStrategy -> ApplyStrategy
$csucc :: ApplyStrategy -> ApplyStrategy
Enum)

instance Show ApplyStrategy where
  show :: ApplyStrategy -> String
show = \case
    ApplyStrategy
ApplyStrategySafe -> String
"safe"
    ApplyStrategy
ApplyStrategySmart -> String
"smart"

parseApplyStrategy :: String -> Maybe ApplyStrategy
parseApplyStrategy :: String -> Maybe ApplyStrategy
parseApplyStrategy = \case
  String
"safe" -> ApplyStrategy -> Maybe ApplyStrategy
forall a. a -> Maybe a
Just ApplyStrategy
ApplyStrategySafe
  String
"smart" -> ApplyStrategy -> Maybe ApplyStrategy
forall a. a -> Maybe a
Just ApplyStrategy
ApplyStrategySmart
  String
_ -> Maybe ApplyStrategy
forall a. Maybe a
Nothing

allApplyStrategies :: [ApplyStrategy]
allApplyStrategies :: [ApplyStrategy]
allApplyStrategies = [ApplyStrategy
forall a. Bounded a => a
minBound..ApplyStrategy
forall a. Bounded a => a
maxBound]

mkDependencyName :: Dependency -> DependencyName
mkDependencyName :: Dependency -> DependencyName
mkDependencyName = Text -> DependencyName
DependencyName (Text -> DependencyName)
-> (Dependency -> Text) -> Dependency -> DependencyName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text) -> (Dependency -> String) -> Dependency -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> String
PackageName.unPackageName (PackageName -> String)
-> (Dependency -> PackageName) -> Dependency -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependency -> PackageName
Dependency.depPkgName

mkCompilableName :: UnqualComponentName -> CompilableName
mkCompilableName :: UnqualComponentName -> CompilableName
mkCompilableName = Text -> CompilableName
CompilableName (Text -> CompilableName)
-> (UnqualComponentName -> Text)
-> UnqualComponentName
-> CompilableName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text)
-> (UnqualComponentName -> String) -> UnqualComponentName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> String
UnqualComponentName.unUnqualComponentName

headMay :: [a] -> Maybe a
headMay :: [a] -> Maybe a
headMay = \case
  [] -> Maybe a
forall a. Maybe a
Nothing
  a
x:[a]
_ -> a -> Maybe a
forall a. a -> Maybe a
Just a
x

lastMay :: [a] -> Maybe a
lastMay :: [a] -> Maybe a
lastMay = [a] -> Maybe a
forall a. [a] -> Maybe a
headMay ([a] -> Maybe a) -> ([a] -> [a]) -> [a] -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse

ifM :: Monad m => m Bool -> m a -> m a -> m a
ifM :: m Bool -> m a -> m a -> m a
ifM m Bool
b m a
t m a
f = do Bool
x <- m Bool
b; if Bool
x then m a
t else m a
f

whenM :: Monad m => m Bool -> m () -> m ()
whenM :: m Bool -> m () -> m ()
whenM m Bool
b m ()
t = m Bool -> m () -> m () -> m ()
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM m Bool
b m ()
t (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

unlessM :: Monad m => m Bool -> m () -> m ()
unlessM :: m Bool -> m () -> m ()
unlessM m Bool
b = m Bool -> m () -> m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Bool -> Bool
not (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Bool
b)