{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}

module HWM.Domain.Matrix
  ( BuildEnv (..),
    Matrix (..),
    BuildEnvironment (..),
    getBuildEnvroments,
    getBuildEnvironment,
    hkgRefs,
    printEnvironments,
  )
where

import Control.Monad.Except (MonadError (..))
import Data.Aeson
  ( FromJSON (..),
    ToJSON (toJSON),
    genericParseJSON,
    genericToJSON,
  )
import Data.List ((\\))
import qualified Data.Map as M
import Data.Traversable (for)
import HWM.Core.Common
  ( Check (..),
    Name,
  )
import HWM.Core.Formatting (Color (..), Format (..), availableOptions, chalk)
import HWM.Core.Has (Has, HasAll, askEnv)
import HWM.Core.Pkg (Pkg (..), PkgName, pkgId)
import HWM.Core.Result (Issue)
import HWM.Core.Version (Version)
import HWM.Domain.Workspace (WorkspaceGroup, memberPkgs)
import HWM.Runtime.Cache (Cache, Registry (currentEnv), VersionMap, getRegistry, getVersions)
import HWM.Runtime.Files (aesonYAMLOptions)
import HWM.Runtime.UI (MonadUI, forTable, sectionEnvironments)
import Relude

type Extras = VersionMap

data Matrix = Matrix
  { Matrix -> Name
defaultEnvironment :: Name,
    Matrix -> [BuildEnv]
environments :: [BuildEnv]
  }
  deriving
    ( (forall x. Matrix -> Rep Matrix x)
-> (forall x. Rep Matrix x -> Matrix) -> Generic Matrix
forall x. Rep Matrix x -> Matrix
forall x. Matrix -> Rep Matrix x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Matrix -> Rep Matrix x
from :: forall x. Matrix -> Rep Matrix x
$cto :: forall x. Rep Matrix x -> Matrix
to :: forall x. Rep Matrix x -> Matrix
Generic,
      Int -> Matrix -> ShowS
[Matrix] -> ShowS
Matrix -> String
(Int -> Matrix -> ShowS)
-> (Matrix -> String) -> ([Matrix] -> ShowS) -> Show Matrix
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Matrix -> ShowS
showsPrec :: Int -> Matrix -> ShowS
$cshow :: Matrix -> String
show :: Matrix -> String
$cshowList :: [Matrix] -> ShowS
showList :: [Matrix] -> ShowS
Show
    )

instance FromJSON Matrix where
  parseJSON :: Value -> Parser Matrix
parseJSON = Options -> Value -> Parser Matrix
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonYAMLOptions

instance ToJSON Matrix where
  toJSON :: Matrix -> Value
toJSON = Options -> Matrix -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonYAMLOptions

instance
  ( MonadError Issue m,
    MonadReader env m,
    Has env Matrix,
    Has env [WorkspaceGroup],
    Has env Cache,
    MonadIO m
  ) =>
  Check m Matrix
  where
  check :: Matrix -> m ()
check Matrix {[BuildEnv]
Name
defaultEnvironment :: Matrix -> Name
environments :: Matrix -> [BuildEnv]
defaultEnvironment :: Name
environments :: [BuildEnv]
..} = (BuildEnv -> m ()) -> [BuildEnv] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ BuildEnv -> m ()
forall (m :: * -> *) a. Check m a => a -> m ()
check [BuildEnv]
environments

data BuildEnv = BuildEnv
  { BuildEnv -> Name
name :: Name,
    BuildEnv -> Version
ghc :: Version,
    BuildEnv -> Name
resolver :: Name,
    BuildEnv -> Maybe Extras
extraDeps :: Maybe Extras,
    BuildEnv -> Maybe [Name]
exclude :: Maybe [Text],
    BuildEnv -> Maybe Bool
allowNewer :: Maybe Bool
  }
  deriving
    ( (forall x. BuildEnv -> Rep BuildEnv x)
-> (forall x. Rep BuildEnv x -> BuildEnv) -> Generic BuildEnv
forall x. Rep BuildEnv x -> BuildEnv
forall x. BuildEnv -> Rep BuildEnv x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BuildEnv -> Rep BuildEnv x
from :: forall x. BuildEnv -> Rep BuildEnv x
$cto :: forall x. Rep BuildEnv x -> BuildEnv
to :: forall x. Rep BuildEnv x -> BuildEnv
Generic,
      Int -> BuildEnv -> ShowS
[BuildEnv] -> ShowS
BuildEnv -> String
(Int -> BuildEnv -> ShowS)
-> (BuildEnv -> String) -> ([BuildEnv] -> ShowS) -> Show BuildEnv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BuildEnv -> ShowS
showsPrec :: Int -> BuildEnv -> ShowS
$cshow :: BuildEnv -> String
show :: BuildEnv -> String
$cshowList :: [BuildEnv] -> ShowS
showList :: [BuildEnv] -> ShowS
Show,
      Eq BuildEnv
Eq BuildEnv =>
(BuildEnv -> BuildEnv -> Ordering)
-> (BuildEnv -> BuildEnv -> Bool)
-> (BuildEnv -> BuildEnv -> Bool)
-> (BuildEnv -> BuildEnv -> Bool)
-> (BuildEnv -> BuildEnv -> Bool)
-> (BuildEnv -> BuildEnv -> BuildEnv)
-> (BuildEnv -> BuildEnv -> BuildEnv)
-> Ord BuildEnv
BuildEnv -> BuildEnv -> Bool
BuildEnv -> BuildEnv -> Ordering
BuildEnv -> BuildEnv -> BuildEnv
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 :: BuildEnv -> BuildEnv -> Ordering
compare :: BuildEnv -> BuildEnv -> Ordering
$c< :: BuildEnv -> BuildEnv -> Bool
< :: BuildEnv -> BuildEnv -> Bool
$c<= :: BuildEnv -> BuildEnv -> Bool
<= :: BuildEnv -> BuildEnv -> Bool
$c> :: BuildEnv -> BuildEnv -> Bool
> :: BuildEnv -> BuildEnv -> Bool
$c>= :: BuildEnv -> BuildEnv -> Bool
>= :: BuildEnv -> BuildEnv -> Bool
$cmax :: BuildEnv -> BuildEnv -> BuildEnv
max :: BuildEnv -> BuildEnv -> BuildEnv
$cmin :: BuildEnv -> BuildEnv -> BuildEnv
min :: BuildEnv -> BuildEnv -> BuildEnv
Ord,
      BuildEnv -> BuildEnv -> Bool
(BuildEnv -> BuildEnv -> Bool)
-> (BuildEnv -> BuildEnv -> Bool) -> Eq BuildEnv
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BuildEnv -> BuildEnv -> Bool
== :: BuildEnv -> BuildEnv -> Bool
$c/= :: BuildEnv -> BuildEnv -> Bool
/= :: BuildEnv -> BuildEnv -> Bool
Eq
    )

instance FromJSON BuildEnv where
  parseJSON :: Value -> Parser BuildEnv
parseJSON = Options -> Value -> Parser BuildEnv
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonYAMLOptions

instance ToJSON BuildEnv where
  toJSON :: BuildEnv -> Value
toJSON = Options -> BuildEnv -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonYAMLOptions

instance
  ( MonadError Issue m,
    MonadReader env m,
    Has env [WorkspaceGroup],
    Has env Cache,
    MonadIO m
  ) =>
  Check m BuildEnv
  where
  check :: BuildEnv -> m ()
check BuildEnv {Maybe Bool
Maybe [Name]
Maybe Extras
Name
Version
name :: BuildEnv -> Name
ghc :: BuildEnv -> Version
resolver :: BuildEnv -> Name
extraDeps :: BuildEnv -> Maybe Extras
exclude :: BuildEnv -> Maybe [Name]
allowNewer :: BuildEnv -> Maybe Bool
name :: Name
ghc :: Version
resolver :: Name
extraDeps :: Maybe Extras
exclude :: Maybe [Name]
allowNewer :: Maybe Bool
..} =
    [m ()] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
      [ (HkgRef -> m ()) -> [HkgRef] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ HkgRef -> m ()
forall (m :: * -> *) a. Check m a => a -> m ()
check ([HkgRef] -> (Extras -> [HkgRef]) -> Maybe Extras -> [HkgRef]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Extras -> [HkgRef]
hkgRefs Maybe Extras
extraDeps),
        Maybe [Name] -> m ()
forall (m :: * -> *) env.
(MonadError Issue m, MonadReader env m, Has env [WorkspaceGroup],
 MonadIO m) =>
Maybe [Name] -> m ()
checkPkgNames Maybe [Name]
exclude
      ]

checkPkgNames ::
  ( MonadError Issue m,
    MonadReader env m,
    Has env [WorkspaceGroup],
    MonadIO m
  ) =>
  Maybe [Text] ->
  m ()
checkPkgNames :: forall (m :: * -> *) env.
(MonadError Issue m, MonadReader env m, Has env [WorkspaceGroup],
 MonadIO m) =>
Maybe [Name] -> m ()
checkPkgNames Maybe [Name]
ls = do
  [Name]
known <- (Pkg -> Name) -> [Pkg] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Pkg -> Name
pkgId ([Pkg] -> [Name]) -> m [Pkg] -> m [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Pkg]
forall env (m :: * -> *).
(MonadReader env m, Has env [WorkspaceGroup], MonadIO m,
 MonadError Issue m) =>
m [Pkg]
askAllPackages
  let unknown :: [Name]
unknown = [Name] -> Maybe [Name] -> [Name]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Name]
ls [Name] -> [Name] -> [Name]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Name]
known
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
unknown) (Issue -> m ()
forall a. Issue -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Issue -> m ()) -> Issue -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Issue
forall a. IsString a => String -> a
fromString (String
"unknown packages: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Name] -> String
forall b a. (Show a, IsString b) => a -> b
show [Name]
unknown))

data BuildEnvironment = BuildEnvironment
  { BuildEnvironment -> BuildEnv
buildEnv :: BuildEnv,
    BuildEnvironment -> [Pkg]
buildPkgs :: [Pkg],
    BuildEnvironment -> Name
buildName :: Name,
    BuildEnvironment -> Maybe Extras
buildExtraDeps :: Maybe Extras,
    BuildEnvironment -> Name
buildResolver :: Name
  }
  deriving
    ( (forall x. BuildEnvironment -> Rep BuildEnvironment x)
-> (forall x. Rep BuildEnvironment x -> BuildEnvironment)
-> Generic BuildEnvironment
forall x. Rep BuildEnvironment x -> BuildEnvironment
forall x. BuildEnvironment -> Rep BuildEnvironment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BuildEnvironment -> Rep BuildEnvironment x
from :: forall x. BuildEnvironment -> Rep BuildEnvironment x
$cto :: forall x. Rep BuildEnvironment x -> BuildEnvironment
to :: forall x. Rep BuildEnvironment x -> BuildEnvironment
Generic,
      Int -> BuildEnvironment -> ShowS
[BuildEnvironment] -> ShowS
BuildEnvironment -> String
(Int -> BuildEnvironment -> ShowS)
-> (BuildEnvironment -> String)
-> ([BuildEnvironment] -> ShowS)
-> Show BuildEnvironment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BuildEnvironment -> ShowS
showsPrec :: Int -> BuildEnvironment -> ShowS
$cshow :: BuildEnvironment -> String
show :: BuildEnvironment -> String
$cshowList :: [BuildEnvironment] -> ShowS
showList :: [BuildEnvironment] -> ShowS
Show,
      Eq BuildEnvironment
Eq BuildEnvironment =>
(BuildEnvironment -> BuildEnvironment -> Ordering)
-> (BuildEnvironment -> BuildEnvironment -> Bool)
-> (BuildEnvironment -> BuildEnvironment -> Bool)
-> (BuildEnvironment -> BuildEnvironment -> Bool)
-> (BuildEnvironment -> BuildEnvironment -> Bool)
-> (BuildEnvironment -> BuildEnvironment -> BuildEnvironment)
-> (BuildEnvironment -> BuildEnvironment -> BuildEnvironment)
-> Ord BuildEnvironment
BuildEnvironment -> BuildEnvironment -> Bool
BuildEnvironment -> BuildEnvironment -> Ordering
BuildEnvironment -> BuildEnvironment -> BuildEnvironment
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 :: BuildEnvironment -> BuildEnvironment -> Ordering
compare :: BuildEnvironment -> BuildEnvironment -> Ordering
$c< :: BuildEnvironment -> BuildEnvironment -> Bool
< :: BuildEnvironment -> BuildEnvironment -> Bool
$c<= :: BuildEnvironment -> BuildEnvironment -> Bool
<= :: BuildEnvironment -> BuildEnvironment -> Bool
$c> :: BuildEnvironment -> BuildEnvironment -> Bool
> :: BuildEnvironment -> BuildEnvironment -> Bool
$c>= :: BuildEnvironment -> BuildEnvironment -> Bool
>= :: BuildEnvironment -> BuildEnvironment -> Bool
$cmax :: BuildEnvironment -> BuildEnvironment -> BuildEnvironment
max :: BuildEnvironment -> BuildEnvironment -> BuildEnvironment
$cmin :: BuildEnvironment -> BuildEnvironment -> BuildEnvironment
min :: BuildEnvironment -> BuildEnvironment -> BuildEnvironment
Ord,
      BuildEnvironment -> BuildEnvironment -> Bool
(BuildEnvironment -> BuildEnvironment -> Bool)
-> (BuildEnvironment -> BuildEnvironment -> Bool)
-> Eq BuildEnvironment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BuildEnvironment -> BuildEnvironment -> Bool
== :: BuildEnvironment -> BuildEnvironment -> Bool
$c/= :: BuildEnvironment -> BuildEnvironment -> Bool
/= :: BuildEnvironment -> BuildEnvironment -> Bool
Eq
    )

instance Format BuildEnvironment where
  format :: BuildEnvironment -> Name
format BuildEnvironment {[Pkg]
Maybe Extras
Name
BuildEnv
buildEnv :: BuildEnvironment -> BuildEnv
buildPkgs :: BuildEnvironment -> [Pkg]
buildName :: BuildEnvironment -> Name
buildExtraDeps :: BuildEnvironment -> Maybe Extras
buildResolver :: BuildEnvironment -> Name
buildEnv :: BuildEnv
buildPkgs :: [Pkg]
buildName :: Name
buildExtraDeps :: Maybe Extras
buildResolver :: Name
..} = Name
buildName Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
" (" Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Version -> Name
forall a. Format a => a -> Name
format (BuildEnv -> Version
ghc BuildEnv
buildEnv) Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
")"

getBuildEnvroments ::
  ( MonadReader env m,
    Has env Matrix,
    Has env [WorkspaceGroup],
    MonadIO m,
    MonadError Issue m
  ) =>
  m [BuildEnvironment]
getBuildEnvroments :: forall env (m :: * -> *).
(MonadReader env m, Has env Matrix, Has env [WorkspaceGroup],
 MonadIO m, MonadError Issue m) =>
m [BuildEnvironment]
getBuildEnvroments = do
  [BuildEnv]
envs <- Matrix -> [BuildEnv]
environments (Matrix -> [BuildEnv]) -> m Matrix -> m [BuildEnv]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Matrix
forall env (m :: * -> *) a. (MonadReader env m, Has env a) => m a
askEnv
  [BuildEnv]
-> (BuildEnv -> m BuildEnvironment) -> m [BuildEnvironment]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [BuildEnv]
envs ((BuildEnv -> m BuildEnvironment) -> m [BuildEnvironment])
-> (BuildEnv -> m BuildEnvironment) -> m [BuildEnvironment]
forall a b. (a -> b) -> a -> b
$ \BuildEnv
env -> do
    [Pkg]
pkgs <- m [Pkg]
forall env (m :: * -> *).
(MonadReader env m, Has env [WorkspaceGroup], MonadIO m,
 MonadError Issue m) =>
m [Pkg]
askAllPackages
    BuildEnvironment -> m BuildEnvironment
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      BuildEnvironment
        { buildEnv :: BuildEnv
buildEnv = BuildEnv
env,
          buildPkgs :: [Pkg]
buildPkgs = BuildEnv -> [Pkg] -> [Pkg]
excludePkgs BuildEnv
env [Pkg]
pkgs,
          buildName :: Name
buildName = BuildEnv -> Name
name BuildEnv
env,
          buildExtraDeps :: Maybe Extras
buildExtraDeps = BuildEnv -> Maybe Extras
extraDeps BuildEnv
env,
          buildResolver :: Name
buildResolver = BuildEnv -> Name
resolver BuildEnv
env
        }
  where
    excludePkgs :: BuildEnv -> [Pkg] -> [Pkg]
excludePkgs BuildEnv
build = (Pkg -> Bool) -> [Pkg] -> [Pkg]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Pkg
p -> Pkg -> Name
pkgId Pkg
p Name -> [Name] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`notElem` [Name] -> Maybe [Name] -> [Name]
forall a. a -> Maybe a -> a
fromMaybe [] (BuildEnv -> Maybe [Name]
exclude BuildEnv
build))

getBuildEnvironment ::
  ( MonadReader env m,
    Has env Matrix,
    Has env [WorkspaceGroup],
    Has env Cache,
    MonadIO m,
    MonadError Issue m
  ) =>
  Maybe Name ->
  m BuildEnvironment
getBuildEnvironment :: forall env (m :: * -> *).
(MonadReader env m, Has env Matrix, Has env [WorkspaceGroup],
 Has env Cache, MonadIO m, MonadError Issue m) =>
Maybe Name -> m BuildEnvironment
getBuildEnvironment Maybe Name
targetNameInput = do
  Name
targetName <- m Name -> (Name -> m Name) -> Maybe Name -> m Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Registry -> Name
currentEnv (Registry -> Name) -> m Registry -> m Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Registry
forall env (m :: * -> *).
(MonadReader env m, Has env Cache, MonadIO m) =>
m Registry
getRegistry) Name -> m Name
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Name
targetNameInput
  [BuildEnvironment]
envs <- m [BuildEnvironment]
forall env (m :: * -> *).
(MonadReader env m, Has env Matrix, Has env [WorkspaceGroup],
 MonadIO m, MonadError Issue m) =>
m [BuildEnvironment]
getBuildEnvroments
  m BuildEnvironment
-> (BuildEnvironment -> m BuildEnvironment)
-> Maybe BuildEnvironment
-> m BuildEnvironment
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (Issue -> m BuildEnvironment
forall a. Issue -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Issue -> m BuildEnvironment) -> Issue -> m BuildEnvironment
forall a b. (a -> b) -> a -> b
$ String -> Issue
forall a. IsString a => String -> a
fromString (String -> Issue) -> String -> Issue
forall a b. (a -> b) -> a -> b
$ Name -> String
forall a. ToString a => a -> String
toString (Name
"No matching Environment for input '" Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
targetName Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
"'! " Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> [Name] -> Name
forall a. Format a => [a] -> Name
availableOptions ((BuildEnvironment -> Name) -> [BuildEnvironment] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map BuildEnvironment -> Name
buildName [BuildEnvironment]
envs)))
    BuildEnvironment -> m BuildEnvironment
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Maybe BuildEnvironment -> m BuildEnvironment)
-> Maybe BuildEnvironment -> m BuildEnvironment
forall a b. (a -> b) -> a -> b
$ (BuildEnvironment -> Bool)
-> [BuildEnvironment] -> Maybe BuildEnvironment
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Name
targetName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
==) (Name -> Bool)
-> (BuildEnvironment -> Name) -> BuildEnvironment -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildEnvironment -> Name
buildName) [BuildEnvironment]
envs

data HkgRef = HkgRef
  { HkgRef -> PkgName
pkgName :: PkgName,
    HkgRef -> Version
pkgVersion :: Version
  }
  deriving (HkgRef -> HkgRef -> Bool
(HkgRef -> HkgRef -> Bool)
-> (HkgRef -> HkgRef -> Bool) -> Eq HkgRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HkgRef -> HkgRef -> Bool
== :: HkgRef -> HkgRef -> Bool
$c/= :: HkgRef -> HkgRef -> Bool
/= :: HkgRef -> HkgRef -> Bool
Eq, Eq HkgRef
Eq HkgRef =>
(HkgRef -> HkgRef -> Ordering)
-> (HkgRef -> HkgRef -> Bool)
-> (HkgRef -> HkgRef -> Bool)
-> (HkgRef -> HkgRef -> Bool)
-> (HkgRef -> HkgRef -> Bool)
-> (HkgRef -> HkgRef -> HkgRef)
-> (HkgRef -> HkgRef -> HkgRef)
-> Ord HkgRef
HkgRef -> HkgRef -> Bool
HkgRef -> HkgRef -> Ordering
HkgRef -> HkgRef -> HkgRef
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 :: HkgRef -> HkgRef -> Ordering
compare :: HkgRef -> HkgRef -> Ordering
$c< :: HkgRef -> HkgRef -> Bool
< :: HkgRef -> HkgRef -> Bool
$c<= :: HkgRef -> HkgRef -> Bool
<= :: HkgRef -> HkgRef -> Bool
$c> :: HkgRef -> HkgRef -> Bool
> :: HkgRef -> HkgRef -> Bool
$c>= :: HkgRef -> HkgRef -> Bool
>= :: HkgRef -> HkgRef -> Bool
$cmax :: HkgRef -> HkgRef -> HkgRef
max :: HkgRef -> HkgRef -> HkgRef
$cmin :: HkgRef -> HkgRef -> HkgRef
min :: HkgRef -> HkgRef -> HkgRef
Ord)

instance
  ( MonadError Issue m,
    MonadReader env m,
    HasAll env [[WorkspaceGroup], Cache],
    MonadIO m
  ) =>
  Check m HkgRef
  where
  check :: HkgRef -> m ()
check HkgRef {Version
PkgName
pkgName :: HkgRef -> PkgName
pkgVersion :: HkgRef -> Version
pkgName :: PkgName
pkgVersion :: Version
..} = PkgName -> m Versions
forall (m :: * -> *) env.
(MonadIO m, MonadError Issue m, MonadReader env m,
 Has env Cache) =>
PkgName -> m Versions
getVersions PkgName
pkgName m Versions -> (Versions -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Version -> Bool) -> [Version] -> m ()
forall {f :: * -> *} {e} {a}.
(MonadError e f, IsString e, Format a) =>
(a -> Bool) -> [a] -> f ()
checkElem (Version
pkgVersion Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
==) ([Version] -> m ()) -> (Versions -> [Version]) -> Versions -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Versions -> [Version]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
    where
      checkElem :: (a -> Bool) -> [a] -> f ()
checkElem a -> Bool
f [a]
xs =
        if Maybe a -> Bool
forall a. Maybe a -> Bool
isJust ((a -> Bool) -> [a] -> Maybe a
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find a -> Bool
f [a]
xs)
          then () -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          else
            e -> f ()
forall a. e -> f a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
              (e -> f ()) -> e -> f ()
forall a b. (a -> b) -> a -> b
$ String -> e
forall a. IsString a => String -> a
fromString
              (String -> e) -> String -> e
forall a b. (a -> b) -> a -> b
$ Name -> String
forall a. ToString a => a -> String
toString
                (Name
"No matching version for '" Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Version -> Name
forall a. Format a => a -> Name
format Version
pkgVersion Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
"'! " Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> [a] -> Name
forall a. Format a => [a] -> Name
availableOptions [a]
xs)

hkgRefs :: VersionMap -> [HkgRef]
hkgRefs :: Extras -> [HkgRef]
hkgRefs = ((PkgName, Version) -> HkgRef) -> [(PkgName, Version)] -> [HkgRef]
forall a b. (a -> b) -> [a] -> [b]
map ((PkgName -> Version -> HkgRef) -> (PkgName, Version) -> HkgRef
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PkgName -> Version -> HkgRef
HkgRef) ([(PkgName, Version)] -> [HkgRef])
-> (Extras -> [(PkgName, Version)]) -> Extras -> [HkgRef]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extras -> [(PkgName, Version)]
forall k a. Map k a -> [(k, a)]
M.toList

instance Format HkgRef where
  format :: HkgRef -> Name
format HkgRef {Version
PkgName
pkgName :: HkgRef -> PkgName
pkgVersion :: HkgRef -> Version
pkgName :: PkgName
pkgVersion :: Version
..} = PkgName -> Name
forall a. Format a => a -> Name
format PkgName
pkgName Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
"-" Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Version -> Name
forall a. Format a => a -> Name
format Version
pkgVersion

askGroups :: (MonadReader env m, Has env [WorkspaceGroup]) => m [WorkspaceGroup]
askGroups :: forall env (m :: * -> *).
(MonadReader env m, Has env [WorkspaceGroup]) =>
m [WorkspaceGroup]
askGroups = m [WorkspaceGroup]
forall env (m :: * -> *) a. (MonadReader env m, Has env a) => m a
askEnv

askAllPackages ::
  ( MonadReader env m,
    Has env [WorkspaceGroup],
    MonadIO m,
    MonadError Issue m
  ) =>
  m [Pkg]
askAllPackages :: forall env (m :: * -> *).
(MonadReader env m, Has env [WorkspaceGroup], MonadIO m,
 MonadError Issue m) =>
m [Pkg]
askAllPackages = do
  [WorkspaceGroup]
groups <- m [WorkspaceGroup]
forall env (m :: * -> *).
(MonadReader env m, Has env [WorkspaceGroup]) =>
m [WorkspaceGroup]
askGroups
  [[Pkg]] -> [Pkg]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Pkg]] -> [Pkg]) -> m [[Pkg]] -> m [Pkg]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WorkspaceGroup -> m [Pkg]) -> [WorkspaceGroup] -> m [[Pkg]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse WorkspaceGroup -> m [Pkg]
forall (m :: * -> *).
(MonadIO m, MonadError Issue m) =>
WorkspaceGroup -> m [Pkg]
memberPkgs [WorkspaceGroup]
groups

printEnvironments :: (MonadUI m) => BuildEnvironment -> [BuildEnvironment] -> m ()
printEnvironments :: forall (m :: * -> *).
MonadUI m =>
BuildEnvironment -> [BuildEnvironment] -> m ()
printEnvironments BuildEnvironment
active [BuildEnvironment]
environments =
  m () -> m ()
forall (m :: * -> *) a. MonadUI m => m a -> m ()
sectionEnvironments (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Int
-> [BuildEnvironment] -> (BuildEnvironment -> (Name, Name)) -> m ()
forall (m :: * -> *) a.
MonadUI m =>
Int -> [a] -> (a -> (Name, Name)) -> m ()
forTable Int
0 [BuildEnvironment]
environments ((BuildEnvironment -> (Name, Name)) -> m ())
-> (BuildEnvironment -> (Name, Name)) -> m ()
forall a b. (a -> b) -> a -> b
$ \BuildEnvironment
env ->
    ( BuildEnvironment -> Name
forall a. Format a => a -> Name
format BuildEnvironment
env,
      if BuildEnvironment
env BuildEnvironment -> BuildEnvironment -> Bool
forall a. Eq a => a -> a -> Bool
== BuildEnvironment
active
        then Color -> Name -> Name
chalk Color
Cyan (BuildEnvironment -> Name
buildResolver BuildEnvironment
env Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
" (active)")
        else Color -> Name -> Name
chalk Color
Gray (BuildEnvironment -> Name
buildResolver BuildEnvironment
env)
    )