{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE DerivingVia                #-}
{-# LANGUAGE ExistentialQuantification  #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FunctionalDependencies     #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE MultiWayIf                 #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE PackageImports             #-}
{-# LANGUAGE QuasiQuotes                #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TupleSections              #-}

module HS.Cmd.List where

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


-- | command driver to list all the installations
cmdList :: Cfg -> Maybe Compiler -> IO ()
cmdList :: Cfg -> Maybe Compiler -> IO ()
cmdList 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_installations :: Map Compiler Installation
_cfg_compiler :: CompilerVersion
_cfg_mode :: InstallMode
_cfg_managers :: Managers
..} Maybe Compiler
mb = [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
    [ Builder -> IO ()
forall b. FromBuilder b => Builder -> b
fmtLn (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ Installation -> Builder
forall p. Buildable p => p -> Builder
build Installation
iln
      | Installation
iln <- Map Compiler Installation -> [Installation]
forall k a. Map k a -> [a]
Map.elems Map Compiler Installation
_cfg_installations
      , Maybe Compiler -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Compiler
mb Bool -> Bool -> Bool
|| Maybe Compiler
mb Maybe Compiler -> Maybe Compiler -> Bool
forall a. Eq a => a -> a -> Bool
== Compiler -> Maybe Compiler
forall a. a -> Maybe a
Just (Maybe CompilerVersion -> Compiler
Compiler (Maybe CompilerVersion -> Compiler)
-> Maybe CompilerVersion -> Compiler
forall a b. (a -> b) -> a -> b
$ CompilerVersion -> Maybe CompilerVersion
forall a. a -> Maybe a
Just (CompilerVersion -> Maybe CompilerVersion)
-> CompilerVersion -> Maybe CompilerVersion
forall a b. (a -> b) -> a -> b
$ Installation -> CompilerVersion
_iln_compiler Installation
iln)
      ]