module Hhp.List (listModules, modules) where

import GHC (Ghc)
import qualified GHC as G

import GHC.Unit.State (listVisibleModuleNames, lookupModuleInAllUnits)
import GHC.Unit.Types (moduleName)

import Control.Monad.Catch (SomeException (..), catch)
import Data.List (nub, sort)

import Hhp.GHCApi
import Hhp.Gap
import Hhp.Types

----------------------------------------------------------------

-- | Listing installed modules.
listModules :: Options -> Cradle -> IO String
listModules :: Options -> Cradle -> IO String
listModules Options
opt Cradle
cradle = Ghc String -> IO String
forall a. Ghc a -> IO a
withGHC' (Ghc String -> IO String) -> Ghc String -> IO String
forall a b. (a -> b) -> a -> b
$ do
    Options -> Cradle -> Ghc ()
initializeFlagsWithCradle Options
opt Cradle
cradle
    Options -> Ghc String
modules Options
opt

-- | Listing installed modules.
modules :: Options -> Ghc String
modules :: Options -> Ghc String
modules Options
opt = Options -> [String] -> String
forall a. ToString a => Options -> a -> String
convert Options
opt ([String] -> String)
-> ([GenModule Unit] -> [String]) -> [GenModule Unit] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GenModule Unit] -> [String]
forall {unit}. [GenModule unit] -> [String]
arrange ([GenModule Unit] -> String) -> Ghc [GenModule Unit] -> Ghc String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ghc [GenModule Unit]
getModules Ghc [GenModule Unit]
-> (SomeException -> Ghc [GenModule Unit]) -> Ghc [GenModule Unit]
forall e a.
(HasCallStack, Exception e) =>
Ghc a -> (e -> Ghc a) -> Ghc a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
`catch` SomeException -> Ghc [GenModule Unit]
forall {m :: * -> *} {a}. Monad m => SomeException -> m [a]
handler)
  where
    arrange :: [GenModule unit] -> [String]
arrange = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String])
-> ([GenModule unit] -> [String]) -> [GenModule unit] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. Ord a => [a] -> [a]
sort ([String] -> [String])
-> ([GenModule unit] -> [String]) -> [GenModule unit] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenModule unit -> String) -> [GenModule unit] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName -> String
G.moduleNameString (ModuleName -> String)
-> (GenModule unit -> ModuleName) -> GenModule unit -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenModule unit -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName)
    handler :: SomeException -> m [a]
handler (SomeException e
_) = [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []

----------------------------------------------------------------

getModules :: Ghc [G.Module]
getModules :: Ghc [GenModule Unit]
getModules = do
    UnitState
us <- Ghc UnitState
getUnitState
    let modNames :: [ModuleName]
modNames = UnitState -> [ModuleName]
listVisibleModuleNames UnitState
us
    [GenModule Unit] -> Ghc [GenModule Unit]
forall a. a -> Ghc a
forall (m :: * -> *) a. Monad m => a -> m a
return [GenModule Unit
m | ModuleName
mn <- [ModuleName]
modNames, (GenModule Unit
m, UnitInfo
_) <- UnitState -> ModuleName -> [(GenModule Unit, UnitInfo)]
lookupModuleInAllUnits UnitState
us ModuleName
mn]