{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}

module HaskellWorks.CabalCache.Core
  ( PackageInfo(..)
  , Tagged(..)
  , Presence(..)
  , getPackages
  , relativePaths
  , loadPlan
  , mkCompilerContext
  ) where

import Control.DeepSeq                  (NFData)
import Control.Lens                     hiding ((<.>))
import Control.Monad.Catch
import Control.Monad.Except
import Data.Aeson                       (eitherDecode)
import Data.Bifunctor                   (first)
import Data.Bool                        (bool)
import Data.Generics.Product.Any        (the)
import Data.String
import Data.Text                        (Text)
import GHC.Generics                     (Generic)
import HaskellWorks.CabalCache.AppError
import HaskellWorks.CabalCache.Error
import HaskellWorks.CabalCache.Show
import System.FilePath                  ((<.>), (</>))

import qualified Data.ByteString.Lazy           as LBS
import qualified Data.List                      as L
import qualified Data.Text                      as T
import qualified HaskellWorks.CabalCache.IO.Tar as IO
import qualified HaskellWorks.CabalCache.Types  as Z
import qualified System.Directory               as IO
import qualified System.Process                 as IO

{- HLINT ignore "Monoid law, left identity" -}

type PackageDir = FilePath
type ConfPath   = FilePath
type Library    = FilePath

data Presence   = Present | Absent deriving (Presence -> Presence -> Bool
(Presence -> Presence -> Bool)
-> (Presence -> Presence -> Bool) -> Eq Presence
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Presence -> Presence -> Bool
$c/= :: Presence -> Presence -> Bool
== :: Presence -> Presence -> Bool
$c== :: Presence -> Presence -> Bool
Eq, Int -> Presence -> ShowS
[Presence] -> ShowS
Presence -> String
(Int -> Presence -> ShowS)
-> (Presence -> String) -> ([Presence] -> ShowS) -> Show Presence
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Presence] -> ShowS
$cshowList :: [Presence] -> ShowS
show :: Presence -> String
$cshow :: Presence -> String
showsPrec :: Int -> Presence -> ShowS
$cshowsPrec :: Int -> Presence -> ShowS
Show, Presence -> ()
(Presence -> ()) -> NFData Presence
forall a. (a -> ()) -> NFData a
rnf :: Presence -> ()
$crnf :: Presence -> ()
NFData, (forall x. Presence -> Rep Presence x)
-> (forall x. Rep Presence x -> Presence) -> Generic Presence
forall x. Rep Presence x -> Presence
forall x. Presence -> Rep Presence x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Presence x -> Presence
$cfrom :: forall x. Presence -> Rep Presence x
Generic)

data Tagged a t = Tagged
  { Tagged a t -> a
value :: a
  , Tagged a t -> t
tag   :: t
  } deriving (Tagged a t -> Tagged a t -> Bool
(Tagged a t -> Tagged a t -> Bool)
-> (Tagged a t -> Tagged a t -> Bool) -> Eq (Tagged a t)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a t. (Eq a, Eq t) => Tagged a t -> Tagged a t -> Bool
/= :: Tagged a t -> Tagged a t -> Bool
$c/= :: forall a t. (Eq a, Eq t) => Tagged a t -> Tagged a t -> Bool
== :: Tagged a t -> Tagged a t -> Bool
$c== :: forall a t. (Eq a, Eq t) => Tagged a t -> Tagged a t -> Bool
Eq, Int -> Tagged a t -> ShowS
[Tagged a t] -> ShowS
Tagged a t -> String
(Int -> Tagged a t -> ShowS)
-> (Tagged a t -> String)
-> ([Tagged a t] -> ShowS)
-> Show (Tagged a t)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a t. (Show a, Show t) => Int -> Tagged a t -> ShowS
forall a t. (Show a, Show t) => [Tagged a t] -> ShowS
forall a t. (Show a, Show t) => Tagged a t -> String
showList :: [Tagged a t] -> ShowS
$cshowList :: forall a t. (Show a, Show t) => [Tagged a t] -> ShowS
show :: Tagged a t -> String
$cshow :: forall a t. (Show a, Show t) => Tagged a t -> String
showsPrec :: Int -> Tagged a t -> ShowS
$cshowsPrec :: forall a t. (Show a, Show t) => Int -> Tagged a t -> ShowS
Show, (forall x. Tagged a t -> Rep (Tagged a t) x)
-> (forall x. Rep (Tagged a t) x -> Tagged a t)
-> Generic (Tagged a t)
forall x. Rep (Tagged a t) x -> Tagged a t
forall x. Tagged a t -> Rep (Tagged a t) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a t x. Rep (Tagged a t) x -> Tagged a t
forall a t x. Tagged a t -> Rep (Tagged a t) x
$cto :: forall a t x. Rep (Tagged a t) x -> Tagged a t
$cfrom :: forall a t x. Tagged a t -> Rep (Tagged a t) x
Generic, Tagged a t -> ()
(Tagged a t -> ()) -> NFData (Tagged a t)
forall a. (a -> ()) -> NFData a
forall a t. (NFData a, NFData t) => Tagged a t -> ()
rnf :: Tagged a t -> ()
$crnf :: forall a t. (NFData a, NFData t) => Tagged a t -> ()
NFData)

data PackageInfo = PackageInfo
  { PackageInfo -> CompilerId
compilerId :: Z.CompilerId
  , PackageInfo -> CompilerId
packageId  :: Z.PackageId
  , PackageInfo -> String
packageDir :: PackageDir
  , PackageInfo -> Tagged String Presence
confPath   :: Tagged ConfPath Presence
  , PackageInfo -> [String]
libs       :: [Library]
  } deriving (Int -> PackageInfo -> ShowS
[PackageInfo] -> ShowS
PackageInfo -> String
(Int -> PackageInfo -> ShowS)
-> (PackageInfo -> String)
-> ([PackageInfo] -> ShowS)
-> Show PackageInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackageInfo] -> ShowS
$cshowList :: [PackageInfo] -> ShowS
show :: PackageInfo -> String
$cshow :: PackageInfo -> String
showsPrec :: Int -> PackageInfo -> ShowS
$cshowsPrec :: Int -> PackageInfo -> ShowS
Show, PackageInfo -> PackageInfo -> Bool
(PackageInfo -> PackageInfo -> Bool)
-> (PackageInfo -> PackageInfo -> Bool) -> Eq PackageInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageInfo -> PackageInfo -> Bool
$c/= :: PackageInfo -> PackageInfo -> Bool
== :: PackageInfo -> PackageInfo -> Bool
$c== :: PackageInfo -> PackageInfo -> Bool
Eq, (forall x. PackageInfo -> Rep PackageInfo x)
-> (forall x. Rep PackageInfo x -> PackageInfo)
-> Generic PackageInfo
forall x. Rep PackageInfo x -> PackageInfo
forall x. PackageInfo -> Rep PackageInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PackageInfo x -> PackageInfo
$cfrom :: forall x. PackageInfo -> Rep PackageInfo x
Generic, PackageInfo -> ()
(PackageInfo -> ()) -> NFData PackageInfo
forall a. (a -> ()) -> NFData a
rnf :: PackageInfo -> ()
$crnf :: PackageInfo -> ()
NFData)

(<||>) :: Monad m => ExceptT e m a -> ExceptT e m a -> ExceptT e m a
<||> :: ExceptT e m a -> ExceptT e m a -> ExceptT e m a
(<||>) ExceptT e m a
f ExceptT e m a
g = ExceptT e m a
f ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` ExceptT e m a -> e -> ExceptT e m a
forall a b. a -> b -> a
const ExceptT e m a
g

findExecutable :: MonadIO m => Text -> ExceptT Text m Text
findExecutable :: CompilerId -> ExceptT CompilerId m CompilerId
findExecutable CompilerId
exe = (String -> CompilerId)
-> ExceptT CompilerId m String -> ExceptT CompilerId m CompilerId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> CompilerId
T.pack (ExceptT CompilerId m String -> ExceptT CompilerId m CompilerId)
-> ExceptT CompilerId m String -> ExceptT CompilerId m CompilerId
forall a b. (a -> b) -> a -> b
$
  IO (Maybe String) -> ExceptT CompilerId m (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO (Maybe String)
IO.findExecutable (CompilerId -> String
T.unpack CompilerId
exe)) ExceptT CompilerId m (Maybe String)
-> (Maybe String -> ExceptT CompilerId m String)
-> ExceptT CompilerId m String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CompilerId -> Maybe String -> ExceptT CompilerId m String
forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
nothingToError (CompilerId
exe CompilerId -> CompilerId -> CompilerId
forall a. Semigroup a => a -> a -> a
<> CompilerId
" is not in path")

runGhcPkg :: (MonadIO m, MonadCatch m) => Text -> [Text] -> ExceptT Text m Text
runGhcPkg :: CompilerId -> [CompilerId] -> ExceptT CompilerId m CompilerId
runGhcPkg CompilerId
cmdExe [CompilerId]
args = ExceptT CompilerId m CompilerId
-> (IOError -> ExceptT CompilerId m CompilerId)
-> ExceptT CompilerId m CompilerId
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch (IO CompilerId -> ExceptT CompilerId m CompilerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CompilerId -> ExceptT CompilerId m CompilerId)
-> IO CompilerId -> ExceptT CompilerId m CompilerId
forall a b. (a -> b) -> a -> b
$ String -> CompilerId
T.pack (String -> CompilerId) -> IO String -> IO CompilerId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> String -> IO String
IO.readProcess (CompilerId -> String
T.unpack CompilerId
cmdExe) ((CompilerId -> String) -> [CompilerId] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompilerId -> String
T.unpack [CompilerId]
args) String
"") ((IOError -> ExceptT CompilerId m CompilerId)
 -> ExceptT CompilerId m CompilerId)
-> (IOError -> ExceptT CompilerId m CompilerId)
-> ExceptT CompilerId m CompilerId
forall a b. (a -> b) -> a -> b
$
  \(IOError
e :: IOError) -> CompilerId -> ExceptT CompilerId m CompilerId
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CompilerId -> ExceptT CompilerId m CompilerId)
-> CompilerId -> ExceptT CompilerId m CompilerId
forall a b. (a -> b) -> a -> b
$ CompilerId
"Unable to run " CompilerId -> CompilerId -> CompilerId
forall a. Semigroup a => a -> a -> a
<> CompilerId
cmdExe CompilerId -> CompilerId -> CompilerId
forall a. Semigroup a => a -> a -> a
<> CompilerId
" " CompilerId -> CompilerId -> CompilerId
forall a. Semigroup a => a -> a -> a
<> [CompilerId] -> CompilerId
T.unwords [CompilerId]
args CompilerId -> CompilerId -> CompilerId
forall a. Semigroup a => a -> a -> a
<> CompilerId
": " CompilerId -> CompilerId -> CompilerId
forall a. Semigroup a => a -> a -> a
<> IOError -> CompilerId
forall a. Show a => a -> CompilerId
tshow IOError
e

verifyGhcPkgVersion :: (MonadIO m, MonadCatch m) => Text -> Text -> ExceptT Text m Text
verifyGhcPkgVersion :: CompilerId -> CompilerId -> ExceptT CompilerId m CompilerId
verifyGhcPkgVersion CompilerId
version CompilerId
cmdExe = do
  CompilerId
stdout <- CompilerId -> [CompilerId] -> ExceptT CompilerId m CompilerId
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
CompilerId -> [CompilerId] -> ExceptT CompilerId m CompilerId
runGhcPkg CompilerId
cmdExe [CompilerId
"--version"]
  if CompilerId -> CompilerId -> Bool
T.isSuffixOf (CompilerId
" " CompilerId -> CompilerId -> CompilerId
forall a. Semigroup a => a -> a -> a
<> CompilerId
version) ([CompilerId] -> CompilerId
forall a. Monoid a => [a] -> a
mconcat (Int -> [CompilerId] -> [CompilerId]
forall a. Int -> [a] -> [a]
L.take Int
1 (CompilerId -> [CompilerId]
T.lines CompilerId
stdout)))
    then CompilerId -> ExceptT CompilerId m CompilerId
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerId
cmdExe
    else CompilerId -> ExceptT CompilerId m CompilerId
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CompilerId -> ExceptT CompilerId m CompilerId)
-> CompilerId -> ExceptT CompilerId m CompilerId
forall a b. (a -> b) -> a -> b
$ CompilerId
cmdExe CompilerId -> CompilerId -> CompilerId
forall a. Semigroup a => a -> a -> a
<> CompilerId
"has is not of version " CompilerId -> CompilerId -> CompilerId
forall a. Semigroup a => a -> a -> a
<> CompilerId
version

mkCompilerContext :: (MonadIO m, MonadCatch m) => Z.PlanJson -> ExceptT Text m Z.CompilerContext
mkCompilerContext :: PlanJson -> ExceptT CompilerId m CompilerContext
mkCompilerContext PlanJson
plan = do
  CompilerId
compilerVersion <- CompilerId -> CompilerId -> Maybe CompilerId
T.stripPrefix CompilerId
"ghc-" (PlanJson
plan PlanJson -> Getting CompilerId PlanJson CompilerId -> CompilerId
forall s a. s -> Getting a s a -> a
^. forall k (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall s t a b. HasAny "compilerId" s t a b => Lens s t a b
the @"compilerId") Maybe CompilerId
-> (Maybe CompilerId -> ExceptT CompilerId m CompilerId)
-> ExceptT CompilerId m CompilerId
forall a b. a -> (a -> b) -> b
& CompilerId -> Maybe CompilerId -> ExceptT CompilerId m CompilerId
forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
nothingToError CompilerId
"No compiler version available in plan"
  let versionedGhcPkgCmd :: CompilerId
versionedGhcPkgCmd = CompilerId
"ghc-pkg-" CompilerId -> CompilerId -> CompilerId
forall a. Semigroup a => a -> a -> a
<> CompilerId
compilerVersion
  CompilerId
ghcPkgCmdPath <-
          (CompilerId -> ExceptT CompilerId m CompilerId
forall (m :: * -> *).
MonadIO m =>
CompilerId -> ExceptT CompilerId m CompilerId
findExecutable CompilerId
versionedGhcPkgCmd  ExceptT CompilerId m CompilerId
-> (CompilerId -> ExceptT CompilerId m CompilerId)
-> ExceptT CompilerId m CompilerId
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CompilerId -> CompilerId -> ExceptT CompilerId m CompilerId
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
CompilerId -> CompilerId -> ExceptT CompilerId m CompilerId
verifyGhcPkgVersion CompilerId
compilerVersion)
    ExceptT CompilerId m CompilerId
-> ExceptT CompilerId m CompilerId
-> ExceptT CompilerId m CompilerId
forall (m :: * -> *) e a.
Monad m =>
ExceptT e m a -> ExceptT e m a -> ExceptT e m a
<||>  (CompilerId -> ExceptT CompilerId m CompilerId
forall (m :: * -> *).
MonadIO m =>
CompilerId -> ExceptT CompilerId m CompilerId
findExecutable CompilerId
"ghc-pkg"           ExceptT CompilerId m CompilerId
-> (CompilerId -> ExceptT CompilerId m CompilerId)
-> ExceptT CompilerId m CompilerId
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CompilerId -> CompilerId -> ExceptT CompilerId m CompilerId
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
CompilerId -> CompilerId -> ExceptT CompilerId m CompilerId
verifyGhcPkgVersion CompilerId
compilerVersion)
  CompilerContext -> ExceptT CompilerId m CompilerContext
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> CompilerContext
Z.CompilerContext [CompilerId -> String
T.unpack CompilerId
ghcPkgCmdPath])

relativePaths :: FilePath -> PackageInfo -> [IO.TarGroup]
relativePaths :: String -> PackageInfo -> [TarGroup]
relativePaths String
basePath PackageInfo
pInfo =
  [ String -> [String] -> TarGroup
IO.TarGroup String
basePath ([String] -> TarGroup) -> [String] -> TarGroup
forall a b. (a -> b) -> a -> b
$ [String]
forall a. Monoid a => a
mempty
      [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> (PackageInfo
pInfo PackageInfo -> Getting [String] PackageInfo [String] -> [String]
forall s a. s -> Getting a s a -> a
^. forall k (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall s t a b. HasAny "libs" s t a b => Lens s t a b
the @"libs")
      [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [PackageInfo -> String
packageDir PackageInfo
pInfo]
  , String -> [String] -> TarGroup
IO.TarGroup String
basePath ([String] -> TarGroup) -> [String] -> TarGroup
forall a b. (a -> b) -> a -> b
$ [String]
forall a. Monoid a => a
mempty
      [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> ([PackageInfo
pInfo PackageInfo
-> Getting
     (Tagged String Presence) PackageInfo (Tagged String Presence)
-> Tagged String Presence
forall s a. s -> Getting a s a -> a
^. forall k (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall s t a b. HasAny "confPath" s t a b => Lens s t a b
the @"confPath"] [Tagged String Presence]
-> ([Tagged String Presence] -> [Tagged String Presence])
-> [Tagged String Presence]
forall a b. a -> (a -> b) -> b
& (Tagged String Presence -> Bool)
-> [Tagged String Presence] -> [Tagged String Presence]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Presence -> Presence -> Bool
forall a. Eq a => a -> a -> Bool
== Presence
Present) (Presence -> Bool)
-> (Tagged String Presence -> Presence)
-> Tagged String Presence
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tagged String Presence
-> Getting Presence (Tagged String Presence) Presence -> Presence
forall s a. s -> Getting a s a -> a
^. forall k (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall s t a b. HasAny "tag" s t a b => Lens s t a b
the @"tag")) [Tagged String Presence]
-> (Tagged String Presence -> String) -> [String]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Tagged String Presence
-> Getting String (Tagged String Presence) String -> String
forall s a. s -> Getting a s a -> a
^. forall k (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall s t a b. HasAny "value" s t a b => Lens s t a b
the @"value"))
  ]

getPackages :: FilePath -> Z.PlanJson -> IO [PackageInfo]
getPackages :: String -> PlanJson -> IO [PackageInfo]
getPackages String
basePath PlanJson
planJson = [Package] -> (Package -> IO PackageInfo) -> IO [PackageInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Package]
packages (String -> CompilerId -> Package -> IO PackageInfo
mkPackageInfo String
basePath CompilerId
compilerId')
  where compilerId' :: Text
        compilerId' :: CompilerId
compilerId' = PlanJson
planJson PlanJson -> Getting CompilerId PlanJson CompilerId -> CompilerId
forall s a. s -> Getting a s a -> a
^. forall k (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall s t a b. HasAny "compilerId" s t a b => Lens s t a b
the @"compilerId"
        packages :: [Z.Package]
        packages :: [Package]
packages = PlanJson
planJson PlanJson -> Getting [Package] PlanJson [Package] -> [Package]
forall s a. s -> Getting a s a -> a
^. forall k (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall s t a b. HasAny "installPlan" s t a b => Lens s t a b
the @"installPlan"

loadPlan :: FilePath -> IO (Either AppError Z.PlanJson)
loadPlan :: String -> IO (Either AppError PlanJson)
loadPlan String
buildPath = (String -> AppError)
-> Either String PlanJson -> Either AppError PlanJson
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> AppError
forall a. IsString a => String -> a
fromString (Either String PlanJson -> Either AppError PlanJson)
-> (ByteString -> Either String PlanJson)
-> ByteString
-> Either AppError PlanJson
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String PlanJson
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> Either AppError PlanJson)
-> IO ByteString -> IO (Either AppError PlanJson)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
LBS.readFile (String
buildPath String -> ShowS
</> String
"cache" String -> ShowS
</> String
"plan.json")

-------------------------------------------------------------------------------
mkPackageInfo :: FilePath -> Z.CompilerId -> Z.Package -> IO PackageInfo
mkPackageInfo :: String -> CompilerId -> Package -> IO PackageInfo
mkPackageInfo String
basePath CompilerId
cid Package
pkg = do
  let pid :: CompilerId
pid               = Package
pkg Package -> Getting CompilerId Package CompilerId -> CompilerId
forall s a. s -> Getting a s a -> a
^. forall k (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall s t a b. HasAny "id" s t a b => Lens s t a b
the @"id"
  let compilerPath :: String
compilerPath      = String
basePath String -> ShowS
</> CompilerId -> String
T.unpack CompilerId
cid
  let relativeConfPath :: String
relativeConfPath  = CompilerId -> String
T.unpack CompilerId
cid String -> ShowS
</> String
"package.db" String -> ShowS
</> CompilerId -> String
T.unpack CompilerId
pid String -> ShowS
<.> String
".conf"
  let absoluteConfPath :: String
absoluteConfPath  = String
basePath String -> ShowS
</> String
relativeConfPath
  let libPath :: String
libPath           = String
compilerPath String -> ShowS
</> String
"lib"
  let relativeLibPath :: String
relativeLibPath   = CompilerId -> String
T.unpack CompilerId
cid String -> ShowS
</> String
"lib"
  let libPrefix :: CompilerId
libPrefix         = CompilerId
"libHS" CompilerId -> CompilerId -> CompilerId
forall a. Semigroup a => a -> a -> a
<> CompilerId
pid
  Bool
absoluteConfPathExists <- String -> IO Bool
IO.doesFileExist String
absoluteConfPath
  [String]
libFiles <- String -> String -> CompilerId -> IO [String]
getLibFiles String
relativeLibPath String
libPath CompilerId
libPrefix
  PackageInfo -> IO PackageInfo
forall (m :: * -> *) a. Monad m => a -> m a
return PackageInfo :: CompilerId
-> CompilerId
-> String
-> Tagged String Presence
-> [String]
-> PackageInfo
PackageInfo
    { $sel:compilerId:PackageInfo :: CompilerId
compilerId  = CompilerId
cid
    , $sel:packageId:PackageInfo :: CompilerId
packageId   = CompilerId
pid
    , $sel:packageDir:PackageInfo :: String
packageDir  = CompilerId -> String
T.unpack CompilerId
cid String -> ShowS
</> CompilerId -> String
T.unpack CompilerId
pid
    , $sel:confPath:PackageInfo :: Tagged String Presence
confPath    = String -> Presence -> Tagged String Presence
forall a t. a -> t -> Tagged a t
Tagged String
relativeConfPath (Presence -> Presence -> Bool -> Presence
forall a. a -> a -> Bool -> a
bool Presence
Absent Presence
Present Bool
absoluteConfPathExists)
    , $sel:libs:PackageInfo :: [String]
libs        = [String]
libFiles
    }

getLibFiles :: FilePath -> FilePath -> Text -> IO [Library]
getLibFiles :: String -> String -> CompilerId -> IO [String]
getLibFiles String
relativeLibPath String
libPath CompilerId
libPrefix = do
  Bool
libExists <- String -> IO Bool
IO.doesDirectoryExist String
libPath
  if Bool
libExists
     then ShowS -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
relativeLibPath String -> ShowS
</>) ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
L.isPrefixOf (CompilerId -> String
T.unpack CompilerId
libPrefix)) ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
IO.listDirectory String
libPath
     else [String] -> IO [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []