{-# LANGUAGE OverloadedStrings #-}

{-|
Module      : GHCup.Requirements
Description : Requirements utilities
Copyright   : (c) Julian Ospald, 2020
License     : LGPL-3.0
Maintainer  : hasufell@hasufell.de
Stability   : experimental
Portability : portable
-}
module GHCup.Requirements where

import           GHCup.Types
import           GHCup.Types.JSON               ( )
import           GHCup.Types.Optics
import           GHCup.Version

import           Control.Applicative
import           Data.List                      ( find )
import           Data.Maybe
import           Optics
import           Prelude                 hiding ( abs
                                                , readFile
                                                , writeFile
                                                )

import qualified Data.Map.Strict               as M
import qualified Data.Text                     as T


-- | Get the requirements. Right now this combines GHC and cabal
-- and doesn't do fine-grained distinction. However, the 'ToolRequirements'
-- type allows it.
getCommonRequirements :: PlatformResult
                      -> ToolRequirements
                      -> Maybe Requirements
getCommonRequirements :: PlatformResult -> ToolRequirements -> Maybe Requirements
getCommonRequirements PlatformResult
pr ToolRequirements
tr =
  Maybe Requirements
with_distro forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Requirements
without_distro_ver forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Requirements
without_distro
 where
  with_distro :: Maybe Requirements
with_distro        = (PlatformResult -> Platform)
-> (PlatformResult -> Maybe Versioning) -> Maybe Requirements
distro_preview PlatformResult -> Platform
_platform PlatformResult -> Maybe Versioning
_distroVersion
  without_distro_ver :: Maybe Requirements
without_distro_ver = (PlatformResult -> Platform)
-> (PlatformResult -> Maybe Versioning) -> Maybe Requirements
distro_preview PlatformResult -> Platform
_platform (forall a b. a -> b -> a
const forall a. Maybe a
Nothing)
  without_distro :: Maybe Requirements
without_distro     = (PlatformResult -> Platform)
-> (PlatformResult -> Maybe Versioning) -> Maybe Requirements
distro_preview (forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Prism' Platform LinuxDistro
_Linux LinuxDistro
UnknownLinux forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlatformResult -> Platform
_platform) (forall a b. a -> b -> a
const forall a. Maybe a
Nothing)

  distro_preview :: (PlatformResult -> Platform)
-> (PlatformResult -> Maybe Versioning) -> Maybe Requirements
distro_preview PlatformResult -> Platform
f PlatformResult -> Maybe Versioning
g =
    let platformVersionSpec :: Maybe (Map (Maybe VersionRange) Requirements)
platformVersionSpec =
          forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Tool
GHC forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix forall a. Maybe a
Nothing forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix (PlatformResult -> Platform
f PlatformResult
pr)) ToolRequirements
tr
        mv' :: Maybe Versioning
mv' = PlatformResult -> Maybe Versioning
g PlatformResult
pr
    in  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd
          forall b c a. (b -> c) -> (a -> b) -> a -> c
.   forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find
                (\(Maybe VersionRange
mverRange, Requirements
_) -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                  (forall a. Maybe a -> Bool
isNothing Maybe Versioning
mv')
                  (\VersionRange
range -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Versioning -> VersionRange -> Bool
`versionRange` VersionRange
range) Maybe Versioning
mv')
                  Maybe VersionRange
mverRange
                )
          forall b c a. (b -> c) -> (a -> b) -> a -> c
.   forall k a. Map k a -> [(k, a)]
M.toList
          forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Map (Maybe VersionRange) Requirements)
platformVersionSpec


prettyRequirements :: Requirements -> T.Text
prettyRequirements :: Requirements -> Text
prettyRequirements Requirements {[Text]
Text
$sel:_notes:Requirements :: Requirements -> Text
$sel:_distroPKGs:Requirements :: Requirements -> [Text]
_notes :: Text
_distroPKGs :: [Text]
..} =
  let d :: Text
d = if Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ [Text]
_distroPKGs
        then Text
"\n  Please ensure the following distro packages "
          forall a. Semigroup a => a -> a -> a
<> Text
"are installed before continuing (you can exit ghcup "
          forall a. Semigroup a => a -> a -> a
<> Text
"and return at any time): "
          forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
" " [Text]
_distroPKGs
        else Text
""
      n :: Text
n = if Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null forall a b. (a -> b) -> a -> b
$ Text
_notes then Text
"\n  Note: " forall a. Semigroup a => a -> a -> a
<> Text
_notes else Text
""
  in  Text
"System requirements " forall a. Semigroup a => a -> a -> a
<> Text
d forall a. Semigroup a => a -> a -> a
<> Text
n

rawRequirements :: Requirements -> T.Text
rawRequirements :: Requirements -> Text
rawRequirements Requirements {[Text]
Text
_notes :: Text
_distroPKGs :: [Text]
$sel:_notes:Requirements :: Requirements -> Text
$sel:_distroPKGs:Requirements :: Requirements -> [Text]
..} =
  if Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ [Text]
_distroPKGs
  then Text -> [Text] -> Text
T.intercalate Text
" " [Text]
_distroPKGs
  else Text
""