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

import Prelude

import Data.Aeson ((.:), FromJSON, parseJSON, withObject)
import Data.Set (Set)
import Data.Text (Text, unpack)

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, Int -> BuildSystem -> ShowS
[BuildSystem] -> ShowS
BuildSystem -> String
(Int -> BuildSystem -> ShowS)
-> (BuildSystem -> String)
-> ([BuildSystem] -> ShowS)
-> Show BuildSystem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BuildSystem] -> ShowS
$cshowList :: [BuildSystem] -> ShowS
show :: BuildSystem -> String
$cshow :: BuildSystem -> String
showsPrec :: Int -> BuildSystem -> ShowS
$cshowsPrec :: Int -> BuildSystem -> ShowS
Show)

-- |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
  , 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, Eq Package
Eq Package
-> (Package -> Package -> Ordering)
-> (Package -> Package -> Bool)
-> (Package -> Package -> Bool)
-> (Package -> Package -> Bool)
-> (Package -> Package -> Bool)
-> (Package -> Package -> Package)
-> (Package -> Package -> Package)
-> Ord Package
Package -> Package -> Bool
Package -> Package -> Ordering
Package -> Package -> Package
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 :: Package -> Package -> Package
$cmin :: Package -> Package -> Package
max :: Package -> Package -> Package
$cmax :: Package -> Package -> Package
>= :: Package -> Package -> Bool
$c>= :: Package -> Package -> Bool
> :: Package -> Package -> Bool
$c> :: Package -> Package -> Bool
<= :: Package -> Package -> Bool
$c<= :: Package -> Package -> Bool
< :: Package -> Package -> Bool
$c< :: Package -> Package -> Bool
compare :: Package -> Package -> Ordering
$ccompare :: Package -> Package -> Ordering
$cp1Ord :: Eq Package
Ord, 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 -> Text -> Parser [String]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"packages"