module Hix.Managed.Cabal.Data.Config where

import Data.Aeson (FromJSON (parseJSON))
import Distribution.Client.IndexUtils.Timestamp (Timestamp)
import Distribution.Verbosity (Verbosity, verbose)
import Path (Abs, Dir, Path)

import Hix.Managed.Cabal.Data.Packages (GhcPackages)

newtype HackageRepoName =
  HackageRepoName Text
  deriving stock (HackageRepoName -> HackageRepoName -> Bool
(HackageRepoName -> HackageRepoName -> Bool)
-> (HackageRepoName -> HackageRepoName -> Bool)
-> Eq HackageRepoName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HackageRepoName -> HackageRepoName -> Bool
== :: HackageRepoName -> HackageRepoName -> Bool
$c/= :: HackageRepoName -> HackageRepoName -> Bool
/= :: HackageRepoName -> HackageRepoName -> Bool
Eq, Int -> HackageRepoName -> ShowS
[HackageRepoName] -> ShowS
HackageRepoName -> String
(Int -> HackageRepoName -> ShowS)
-> (HackageRepoName -> String)
-> ([HackageRepoName] -> ShowS)
-> Show HackageRepoName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HackageRepoName -> ShowS
showsPrec :: Int -> HackageRepoName -> ShowS
$cshow :: HackageRepoName -> String
show :: HackageRepoName -> String
$cshowList :: [HackageRepoName] -> ShowS
showList :: [HackageRepoName] -> ShowS
Show, (forall x. HackageRepoName -> Rep HackageRepoName x)
-> (forall x. Rep HackageRepoName x -> HackageRepoName)
-> Generic HackageRepoName
forall x. Rep HackageRepoName x -> HackageRepoName
forall x. HackageRepoName -> Rep HackageRepoName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HackageRepoName -> Rep HackageRepoName x
from :: forall x. HackageRepoName -> Rep HackageRepoName x
$cto :: forall x. Rep HackageRepoName x -> HackageRepoName
to :: forall x. Rep HackageRepoName x -> HackageRepoName
Generic)
  deriving newtype (String -> HackageRepoName
(String -> HackageRepoName) -> IsString HackageRepoName
forall a. (String -> a) -> IsString a
$cfromString :: String -> HackageRepoName
fromString :: String -> HackageRepoName
IsString, Eq HackageRepoName
Eq HackageRepoName =>
(HackageRepoName -> HackageRepoName -> Ordering)
-> (HackageRepoName -> HackageRepoName -> Bool)
-> (HackageRepoName -> HackageRepoName -> Bool)
-> (HackageRepoName -> HackageRepoName -> Bool)
-> (HackageRepoName -> HackageRepoName -> Bool)
-> (HackageRepoName -> HackageRepoName -> HackageRepoName)
-> (HackageRepoName -> HackageRepoName -> HackageRepoName)
-> Ord HackageRepoName
HackageRepoName -> HackageRepoName -> Bool
HackageRepoName -> HackageRepoName -> Ordering
HackageRepoName -> HackageRepoName -> HackageRepoName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: HackageRepoName -> HackageRepoName -> Ordering
compare :: HackageRepoName -> HackageRepoName -> Ordering
$c< :: HackageRepoName -> HackageRepoName -> Bool
< :: HackageRepoName -> HackageRepoName -> Bool
$c<= :: HackageRepoName -> HackageRepoName -> Bool
<= :: HackageRepoName -> HackageRepoName -> Bool
$c> :: HackageRepoName -> HackageRepoName -> Bool
> :: HackageRepoName -> HackageRepoName -> Bool
$c>= :: HackageRepoName -> HackageRepoName -> Bool
>= :: HackageRepoName -> HackageRepoName -> Bool
$cmax :: HackageRepoName -> HackageRepoName -> HackageRepoName
max :: HackageRepoName -> HackageRepoName -> HackageRepoName
$cmin :: HackageRepoName -> HackageRepoName -> HackageRepoName
min :: HackageRepoName -> HackageRepoName -> HackageRepoName
Ord)

instance Default HackageRepoName where
  def :: HackageRepoName
def = HackageRepoName
"hackage.haskell.org"

newtype GhcPath =
  GhcPath (Path Abs Dir)
  deriving stock (GhcPath -> GhcPath -> Bool
(GhcPath -> GhcPath -> Bool)
-> (GhcPath -> GhcPath -> Bool) -> Eq GhcPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GhcPath -> GhcPath -> Bool
== :: GhcPath -> GhcPath -> Bool
$c/= :: GhcPath -> GhcPath -> Bool
/= :: GhcPath -> GhcPath -> Bool
Eq, Int -> GhcPath -> ShowS
[GhcPath] -> ShowS
GhcPath -> String
(Int -> GhcPath -> ShowS)
-> (GhcPath -> String) -> ([GhcPath] -> ShowS) -> Show GhcPath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GhcPath -> ShowS
showsPrec :: Int -> GhcPath -> ShowS
$cshow :: GhcPath -> String
show :: GhcPath -> String
$cshowList :: [GhcPath] -> ShowS
showList :: [GhcPath] -> ShowS
Show, (forall x. GhcPath -> Rep GhcPath x)
-> (forall x. Rep GhcPath x -> GhcPath) -> Generic GhcPath
forall x. Rep GhcPath x -> GhcPath
forall x. GhcPath -> Rep GhcPath x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GhcPath -> Rep GhcPath x
from :: forall x. GhcPath -> Rep GhcPath x
$cto :: forall x. Rep GhcPath x -> GhcPath
to :: forall x. Rep GhcPath x -> GhcPath
Generic)
  deriving newtype (Maybe GhcPath
Value -> Parser [GhcPath]
Value -> Parser GhcPath
(Value -> Parser GhcPath)
-> (Value -> Parser [GhcPath]) -> Maybe GhcPath -> FromJSON GhcPath
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser GhcPath
parseJSON :: Value -> Parser GhcPath
$cparseJSONList :: Value -> Parser [GhcPath]
parseJSONList :: Value -> Parser [GhcPath]
$comittedField :: Maybe GhcPath
omittedField :: Maybe GhcPath
FromJSON)

data GhcDb =
  GhcDbSystem (Maybe GhcPath)
  |
  GhcDbSynthetic GhcPackages
  deriving stock (GhcDb -> GhcDb -> Bool
(GhcDb -> GhcDb -> Bool) -> (GhcDb -> GhcDb -> Bool) -> Eq GhcDb
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GhcDb -> GhcDb -> Bool
== :: GhcDb -> GhcDb -> Bool
$c/= :: GhcDb -> GhcDb -> Bool
/= :: GhcDb -> GhcDb -> Bool
Eq, Int -> GhcDb -> ShowS
[GhcDb] -> ShowS
GhcDb -> String
(Int -> GhcDb -> ShowS)
-> (GhcDb -> String) -> ([GhcDb] -> ShowS) -> Show GhcDb
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GhcDb -> ShowS
showsPrec :: Int -> GhcDb -> ShowS
$cshow :: GhcDb -> String
show :: GhcDb -> String
$cshowList :: [GhcDb] -> ShowS
showList :: [GhcDb] -> ShowS
Show, (forall x. GhcDb -> Rep GhcDb x)
-> (forall x. Rep GhcDb x -> GhcDb) -> Generic GhcDb
forall x. Rep GhcDb x -> GhcDb
forall x. GhcDb -> Rep GhcDb x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GhcDb -> Rep GhcDb x
from :: forall x. GhcDb -> Rep GhcDb x
$cto :: forall x. Rep GhcDb x -> GhcDb
to :: forall x. Rep GhcDb x -> GhcDb
Generic)

instance FromJSON GhcDb where
  parseJSON :: Value -> Parser GhcDb
parseJSON = (Maybe GhcPath -> GhcDb) -> Parser (Maybe GhcPath) -> Parser GhcDb
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe GhcPath -> GhcDb
GhcDbSystem (Parser (Maybe GhcPath) -> Parser GhcDb)
-> (Value -> Parser (Maybe GhcPath)) -> Value -> Parser GhcDb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser (Maybe GhcPath)
forall a. FromJSON a => Value -> Parser a
parseJSON

newtype HackageIndexState =
  HackageIndexState Timestamp
  deriving stock (HackageIndexState -> HackageIndexState -> Bool
(HackageIndexState -> HackageIndexState -> Bool)
-> (HackageIndexState -> HackageIndexState -> Bool)
-> Eq HackageIndexState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HackageIndexState -> HackageIndexState -> Bool
== :: HackageIndexState -> HackageIndexState -> Bool
$c/= :: HackageIndexState -> HackageIndexState -> Bool
/= :: HackageIndexState -> HackageIndexState -> Bool
Eq, Int -> HackageIndexState -> ShowS
[HackageIndexState] -> ShowS
HackageIndexState -> String
(Int -> HackageIndexState -> ShowS)
-> (HackageIndexState -> String)
-> ([HackageIndexState] -> ShowS)
-> Show HackageIndexState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HackageIndexState -> ShowS
showsPrec :: Int -> HackageIndexState -> ShowS
$cshow :: HackageIndexState -> String
show :: HackageIndexState -> String
$cshowList :: [HackageIndexState] -> ShowS
showList :: [HackageIndexState] -> ShowS
Show, (forall x. HackageIndexState -> Rep HackageIndexState x)
-> (forall x. Rep HackageIndexState x -> HackageIndexState)
-> Generic HackageIndexState
forall x. Rep HackageIndexState x -> HackageIndexState
forall x. HackageIndexState -> Rep HackageIndexState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HackageIndexState -> Rep HackageIndexState x
from :: forall x. HackageIndexState -> Rep HackageIndexState x
$cto :: forall x. Rep HackageIndexState x -> HackageIndexState
to :: forall x. Rep HackageIndexState x -> HackageIndexState
Generic)

data CabalConfig =
  CabalConfig {
    CabalConfig -> Maybe HackageIndexState
indexState :: Maybe HackageIndexState
  }
  deriving stock (CabalConfig -> CabalConfig -> Bool
(CabalConfig -> CabalConfig -> Bool)
-> (CabalConfig -> CabalConfig -> Bool) -> Eq CabalConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CabalConfig -> CabalConfig -> Bool
== :: CabalConfig -> CabalConfig -> Bool
$c/= :: CabalConfig -> CabalConfig -> Bool
/= :: CabalConfig -> CabalConfig -> Bool
Eq, Int -> CabalConfig -> ShowS
[CabalConfig] -> ShowS
CabalConfig -> String
(Int -> CabalConfig -> ShowS)
-> (CabalConfig -> String)
-> ([CabalConfig] -> ShowS)
-> Show CabalConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CabalConfig -> ShowS
showsPrec :: Int -> CabalConfig -> ShowS
$cshow :: CabalConfig -> String
show :: CabalConfig -> String
$cshowList :: [CabalConfig] -> ShowS
showList :: [CabalConfig] -> ShowS
Show, (forall x. CabalConfig -> Rep CabalConfig x)
-> (forall x. Rep CabalConfig x -> CabalConfig)
-> Generic CabalConfig
forall x. Rep CabalConfig x -> CabalConfig
forall x. CabalConfig -> Rep CabalConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CabalConfig -> Rep CabalConfig x
from :: forall x. CabalConfig -> Rep CabalConfig x
$cto :: forall x. Rep CabalConfig x -> CabalConfig
to :: forall x. Rep CabalConfig x -> CabalConfig
Generic)

instance Default CabalConfig where
  def :: CabalConfig
def =
    CabalConfig {indexState :: Maybe HackageIndexState
indexState = Maybe HackageIndexState
forall a. Maybe a
Nothing}

data SolveConfig =
  SolveConfig {
    SolveConfig -> HackageRepoName
hackageRepoName :: HackageRepoName,
    SolveConfig -> Verbosity
verbosity :: Verbosity,
    SolveConfig -> Maybe GhcPath
ghc :: Maybe GhcPath,
    SolveConfig -> Bool
allowBoot :: Bool,
    SolveConfig -> CabalConfig
cabal :: CabalConfig
  }
  deriving stock (SolveConfig -> SolveConfig -> Bool
(SolveConfig -> SolveConfig -> Bool)
-> (SolveConfig -> SolveConfig -> Bool) -> Eq SolveConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SolveConfig -> SolveConfig -> Bool
== :: SolveConfig -> SolveConfig -> Bool
$c/= :: SolveConfig -> SolveConfig -> Bool
/= :: SolveConfig -> SolveConfig -> Bool
Eq, Int -> SolveConfig -> ShowS
[SolveConfig] -> ShowS
SolveConfig -> String
(Int -> SolveConfig -> ShowS)
-> (SolveConfig -> String)
-> ([SolveConfig] -> ShowS)
-> Show SolveConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SolveConfig -> ShowS
showsPrec :: Int -> SolveConfig -> ShowS
$cshow :: SolveConfig -> String
show :: SolveConfig -> String
$cshowList :: [SolveConfig] -> ShowS
showList :: [SolveConfig] -> ShowS
Show, (forall x. SolveConfig -> Rep SolveConfig x)
-> (forall x. Rep SolveConfig x -> SolveConfig)
-> Generic SolveConfig
forall x. Rep SolveConfig x -> SolveConfig
forall x. SolveConfig -> Rep SolveConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SolveConfig -> Rep SolveConfig x
from :: forall x. SolveConfig -> Rep SolveConfig x
$cto :: forall x. Rep SolveConfig x -> SolveConfig
to :: forall x. Rep SolveConfig x -> SolveConfig
Generic)

instance Default SolveConfig where
  def :: SolveConfig
def =
    SolveConfig {
      hackageRepoName :: HackageRepoName
hackageRepoName = HackageRepoName
forall a. Default a => a
def,
      verbosity :: Verbosity
verbosity = Verbosity
verbose,
      ghc :: Maybe GhcPath
ghc = Maybe GhcPath
forall a. Maybe a
Nothing,
      allowBoot :: Bool
allowBoot = Bool
False,
      cabal :: CabalConfig
cabal = CabalConfig
forall a. Default a => a
def
    }