{-# 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 Maybe Requirements -> Maybe Requirements -> Maybe Requirements
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Requirements
without_distro_ver Maybe Requirements -> Maybe Requirements -> Maybe Requirements
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 (Maybe Versioning -> PlatformResult -> Maybe Versioning
forall a b. a -> b -> a
const Maybe Versioning
forall a. Maybe a
Nothing)
  without_distro :: Maybe Requirements
without_distro     = (PlatformResult -> Platform)
-> (PlatformResult -> Maybe Versioning) -> Maybe Requirements
distro_preview (Optic A_Prism NoIx Platform Platform LinuxDistro LinuxDistro
-> LinuxDistro -> Platform -> Platform
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Prism NoIx Platform Platform LinuxDistro LinuxDistro
_Linux LinuxDistro
UnknownLinux (Platform -> Platform)
-> (PlatformResult -> Platform) -> PlatformResult -> Platform
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlatformResult -> Platform
_platform) (Maybe Versioning -> PlatformResult -> Maybe Versioning
forall a b. a -> b -> a
const Maybe Versioning
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 =
          Optic'
  An_AffineTraversal
  NoIx
  ToolRequirements
  (Map (Maybe VersionRange) Requirements)
-> ToolRequirements
-> Maybe (Map (Maybe VersionRange) Requirements)
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Index ToolRequirements
-> Optic'
     (IxKind ToolRequirements)
     NoIx
     ToolRequirements
     (IxValue ToolRequirements)
forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Index ToolRequirements
Tool
GHC Optic
  An_AffineTraversal
  NoIx
  ToolRequirements
  ToolRequirements
  (Map (Maybe Version) PlatformReqSpec)
  (Map (Maybe Version) PlatformReqSpec)
-> Optic
     An_AffineTraversal
     NoIx
     (Map (Maybe Version) PlatformReqSpec)
     (Map (Maybe Version) PlatformReqSpec)
     PlatformReqSpec
     PlatformReqSpec
-> Optic
     An_AffineTraversal
     NoIx
     ToolRequirements
     ToolRequirements
     PlatformReqSpec
     PlatformReqSpec
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
% Index (Map (Maybe Version) PlatformReqSpec)
-> Optic'
     (IxKind (Map (Maybe Version) PlatformReqSpec))
     NoIx
     (Map (Maybe Version) PlatformReqSpec)
     (IxValue (Map (Maybe Version) PlatformReqSpec))
forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Index (Map (Maybe Version) PlatformReqSpec)
forall a. Maybe a
Nothing Optic
  An_AffineTraversal
  NoIx
  ToolRequirements
  ToolRequirements
  PlatformReqSpec
  PlatformReqSpec
-> Optic
     An_AffineTraversal
     NoIx
     PlatformReqSpec
     PlatformReqSpec
     (Map (Maybe VersionRange) Requirements)
     (Map (Maybe VersionRange) Requirements)
-> Optic'
     An_AffineTraversal
     NoIx
     ToolRequirements
     (Map (Maybe VersionRange) Requirements)
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
% Index PlatformReqSpec
-> Optic'
     (IxKind PlatformReqSpec)
     NoIx
     PlatformReqSpec
     (IxValue PlatformReqSpec)
forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix (PlatformResult -> Platform
f PlatformResult
pr)) ToolRequirements
tr
        mv' :: Maybe Versioning
mv' = PlatformResult -> Maybe Versioning
g PlatformResult
pr
    in  ((Maybe VersionRange, Requirements) -> Requirements)
-> Maybe (Maybe VersionRange, Requirements) -> Maybe Requirements
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe VersionRange, Requirements) -> Requirements
forall a b. (a, b) -> b
snd
          (Maybe (Maybe VersionRange, Requirements) -> Maybe Requirements)
-> (Map (Maybe VersionRange) Requirements
    -> Maybe (Maybe VersionRange, Requirements))
-> Map (Maybe VersionRange) Requirements
-> Maybe Requirements
forall b c a. (b -> c) -> (a -> b) -> a -> c
.   ((Maybe VersionRange, Requirements) -> Bool)
-> [(Maybe VersionRange, Requirements)]
-> Maybe (Maybe VersionRange, Requirements)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find
                (\(Maybe VersionRange
mverRange, Requirements
_) -> Bool -> (VersionRange -> Bool) -> Maybe VersionRange -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                  (Maybe Versioning -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Versioning
mv')
                  (\VersionRange
range -> Bool -> (Versioning -> Bool) -> Maybe Versioning -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Versioning -> VersionRange -> Bool
`versionRange` VersionRange
range) Maybe Versioning
mv')
                  Maybe VersionRange
mverRange
                )
          ([(Maybe VersionRange, Requirements)]
 -> Maybe (Maybe VersionRange, Requirements))
-> (Map (Maybe VersionRange) Requirements
    -> [(Maybe VersionRange, Requirements)])
-> Map (Maybe VersionRange) Requirements
-> Maybe (Maybe VersionRange, Requirements)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.   Map (Maybe VersionRange) Requirements
-> [(Maybe VersionRange, Requirements)]
forall k a. Map k a -> [(k, a)]
M.toList
          (Map (Maybe VersionRange) Requirements -> Maybe Requirements)
-> Maybe (Map (Maybe VersionRange) Requirements)
-> Maybe Requirements
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 (Bool -> Bool) -> ([Text] -> Bool) -> [Text] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Text] -> Bool) -> [Text] -> Bool
forall a b. (a -> b) -> a -> b
$ [Text]
_distroPKGs
        then Text
"\n  Please ensure the following distro packages "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"are installed before continuing (you can exit ghcup "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"and return at any time): "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
" " [Text]
_distroPKGs
        else Text
""
      n :: Text
n = if Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ Text
_notes then Text
"\n  Note: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
_notes else Text
""
  in  Text
"System requirements " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
d Text -> Text -> Text
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 (Bool -> Bool) -> ([Text] -> Bool) -> [Text] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Text] -> Bool) -> [Text] -> Bool
forall a b. (a -> b) -> a -> b
$ [Text]
_distroPKGs
  then Text -> [Text] -> Text
T.intercalate Text
" " [Text]
_distroPKGs
  else Text
""