{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE MultiWayIf                 #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TupleSections              #-}

module HS.Cfg.Load where

import           Data.Map(Map)
import           Fmt
import           HS.Cfg.CfgFile
import           HS.Managers
import           HS.Types
import           System.IO


loadCfg :: IO Cfg
loadCfg :: IO Cfg
loadCfg = Cfg -> IO Cfg
ld (Cfg -> IO Cfg) -> IO Cfg -> IO Cfg
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Cfg
recover
  where
    ld :: Cfg -> IO Cfg
    ld :: Cfg -> IO Cfg
ld Cfg
cfg0 = ([Map Compiler Installation] -> Cfg)
-> IO [Map Compiler Installation] -> IO Cfg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map Compiler Installation -> Cfg
mk (Map Compiler Installation -> Cfg)
-> ([Map Compiler Installation] -> Map Compiler Installation)
-> [Map Compiler Installation]
-> Cfg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Map Compiler Installation] -> Map Compiler Installation
forall a. Monoid a => [a] -> a
mconcat) (IO [Map Compiler Installation] -> IO Cfg)
-> IO [Map Compiler Installation] -> IO Cfg
forall a b. (a -> b) -> a -> b
$ (Manager -> IO (Map Compiler Installation))
-> [Manager] -> IO [Map Compiler Installation]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Cfg -> Manager -> IO (Map Compiler Installation)
disco Cfg
cfg0) ([Manager] -> IO [Map Compiler Installation])
-> [Manager] -> IO [Map Compiler Installation]
forall a b. (a -> b) -> a -> b
$ Managers -> [Manager]
getManagers Managers
_cfg_managers
      where
        mk :: Map Compiler Installation -> Cfg
        mk :: Map Compiler Installation -> Cfg
mk Map Compiler Installation
mp = Cfg
cfg0
          { _cfg_installations :: Map Compiler Installation
_cfg_installations = Map Compiler Installation
mp
          }

        Cfg{Map Compiler Installation
CompilerVersion
InstallMode
Managers
_cfg_compiler :: Cfg -> CompilerVersion
_cfg_mode :: Cfg -> InstallMode
_cfg_managers :: Cfg -> Managers
_cfg_installations :: Map Compiler Installation
_cfg_compiler :: CompilerVersion
_cfg_mode :: InstallMode
_cfg_installations :: Cfg -> Map Compiler Installation
_cfg_managers :: Managers
..} = Cfg
cfg0

    disco :: Cfg -> Manager -> IO (Map Compiler Installation)
    disco :: Cfg -> Manager -> IO (Map Compiler Installation)
disco Cfg
cfg Manager
mgr
      | Manager
mgr Manager -> Manager -> Bool
forall a. Eq a => a -> a -> Bool
== Manager
stack = Cfg -> IO (Map Compiler Installation)
stackDiscover Cfg
cfg
      | Manager
mgr Manager -> Manager -> Bool
forall a. Eq a => a -> a -> Bool
== Manager
ghcup = Cfg -> IO (Map Compiler Installation)
ghcupDiscover Cfg
cfg
      | Bool
otherwise    = do
          Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Builder
"hs: manager "Builder -> Builder -> String
forall b. FromBuilder b => Builder -> Builder -> b
+|Manager
mgrManager -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
" not recognised: ignoring"
          Map Compiler Installation -> IO (Map Compiler Installation)
forall (m :: * -> *) a. Monad m => a -> m a
return Map Compiler Installation
forall a. Monoid a => a
mempty

recover :: IO Cfg
recover :: IO Cfg
recover = Managers
-> InstallMode
-> CompilerVersion
-> Map Compiler Installation
-> Cfg
Cfg (Managers
 -> InstallMode
 -> CompilerVersion
 -> Map Compiler Installation
 -> Cfg)
-> IO Managers
-> IO
     (InstallMode
      -> CompilerVersion -> Map Compiler Installation -> Cfg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CfgFile -> IO Managers
forall a. (Default a, TextParsable a) => CfgFile -> IO a
load CfgFile
CF_managers IO
  (InstallMode
   -> CompilerVersion -> Map Compiler Installation -> Cfg)
-> IO InstallMode
-> IO (CompilerVersion -> Map Compiler Installation -> Cfg)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CfgFile -> IO InstallMode
forall a. (Default a, TextParsable a) => CfgFile -> IO a
load CfgFile
CF_mode IO (CompilerVersion -> Map Compiler Installation -> Cfg)
-> IO CompilerVersion -> IO (Map Compiler Installation -> Cfg)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CfgFile -> IO CompilerVersion
forall a. (Default a, TextParsable a) => CfgFile -> IO a
load CfgFile
CF_compiler IO (Map Compiler Installation -> Cfg)
-> IO (Map Compiler Installation) -> IO Cfg
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map Compiler Installation -> IO (Map Compiler Installation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Compiler Installation
forall a. Monoid a => a
mempty