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

module HS.Cmd.Whereis where

import qualified Data.Map       as Map
import           Data.Maybe
import           HS.Install
import           HS.Types


-- | command driver to print out bindist root of desiganted compiler
cmdWhereis :: Cfg -> Maybe InstallMode -> Compiler -> IO ()
cmdWhereis :: Cfg -> Maybe InstallMode -> Compiler -> IO ()
cmdWhereis Cfg
cfg Maybe InstallMode
mb_im Compiler
cp = case Maybe Installation
mb_iln of
    Maybe Installation
Nothing  -> Cfg -> InstallMode -> Compiler -> IO Installation
install Cfg
cfg InstallMode
im Compiler
cp IO Installation -> (Installation -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Installation -> IO ()
go
    Just Installation
iln -> Installation -> IO ()
go Installation
iln
  where
    go :: Installation -> IO ()
    go :: Installation -> IO ()
go Installation
iln = String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Installation -> String
_iln_dir Installation
iln

    im :: InstallMode
im     = InstallMode -> Maybe InstallMode -> InstallMode
forall a. a -> Maybe a -> a
fromMaybe InstallMode
_cfg_mode Maybe InstallMode
mb_im
    mb_iln :: Maybe Installation
mb_iln = Compiler -> Map Compiler Installation -> Maybe Installation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Compiler
cp Map Compiler Installation
_cfg_installations

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