{-# 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.Monad.Catch              (MonadCatch(..))
import Control.Monad.Except             (MonadError(..))
import Data.Aeson                       (eitherDecode)
import Data.Generics.Product.Any        (the)
import HaskellWorks.CabalCache.Error    (DecodeError(..))
import HaskellWorks.Prelude
import Lens.Micro
import System.FilePath                  ((<.>), (</>))

import qualified Control.Monad.Oops             as OO
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.Info                    as I
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
$c== :: Presence -> Presence -> Bool
== :: Presence -> Presence -> Bool
$c/= :: Presence -> Presence -> Bool
/= :: Presence -> Presence -> Bool
Eq, Int -> Presence -> ShowS
[Presence] -> ShowS
Presence -> FilePath
(Int -> Presence -> ShowS)
-> (Presence -> FilePath) -> ([Presence] -> ShowS) -> Show Presence
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Presence -> ShowS
showsPrec :: Int -> Presence -> ShowS
$cshow :: Presence -> FilePath
show :: Presence -> FilePath
$cshowList :: [Presence] -> ShowS
showList :: [Presence] -> ShowS
Show, Presence -> ()
(Presence -> ()) -> NFData Presence
forall a. (a -> ()) -> NFData a
$crnf :: Presence -> ()
rnf :: 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
$cfrom :: forall x. Presence -> Rep Presence x
from :: forall x. Presence -> Rep Presence x
$cto :: forall x. Rep Presence x -> Presence
to :: forall x. Rep Presence x -> Presence
Generic)

data Tagged a t = Tagged
  { forall a t. Tagged a t -> a
value :: a
  , forall a t. 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
$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
/= :: Tagged a t -> Tagged a t -> Bool
Eq, Int -> Tagged a t -> ShowS
[Tagged a t] -> ShowS
Tagged a t -> FilePath
(Int -> Tagged a t -> ShowS)
-> (Tagged a t -> FilePath)
-> ([Tagged a t] -> ShowS)
-> Show (Tagged a t)
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([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 -> FilePath
$cshowsPrec :: forall a t. (Show a, Show t) => Int -> Tagged a t -> ShowS
showsPrec :: Int -> Tagged a t -> ShowS
$cshow :: forall a t. (Show a, Show t) => Tagged a t -> FilePath
show :: Tagged a t -> FilePath
$cshowList :: forall a t. (Show a, Show t) => [Tagged a t] -> ShowS
showList :: [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
$cfrom :: forall a t x. Tagged a t -> Rep (Tagged a t) x
from :: forall x. Tagged a t -> Rep (Tagged a t) x
$cto :: forall a t x. Rep (Tagged a t) x -> Tagged a t
to :: forall x. Rep (Tagged a t) x -> Tagged a t
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 -> ()
$crnf :: forall a t. (NFData a, NFData t) => Tagged a t -> ()
rnf :: Tagged a t -> ()
NFData)

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

(<||>) :: Monad m => ExceptT e m a -> ExceptT e m a -> ExceptT e m a
<||> :: forall (m :: * -> *) e a.
Monad m =>
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 a. 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

isPosix :: Bool
isPosix :: Bool
isPosix = FilePath
I.os FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
"mingw32"
{-# NOINLINE isPosix #-}

exeExt :: String
exeExt :: FilePath
exeExt
  | Bool
isPosix = FilePath
""
  | Bool
otherwise = FilePath
".exe"

withExeExt :: FilePath -> FilePath
withExeExt :: ShowS
withExeExt = (FilePath -> ShowS
<.> FilePath
exeExt)

withExeExt' :: Text -> Text
withExeExt' :: Text -> Text
withExeExt' = FilePath -> Text
T.pack (FilePath -> Text) -> (Text -> FilePath) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
withExeExt ShowS -> (Text -> FilePath) -> Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack

findExecutable :: ()
  => MonadIO f
  => MonadError (OO.Variant e) f
  => e `OO.CouldBe` Text
  => Text
  -> f Text
findExecutable :: forall (f :: * -> *) (e :: [*]).
(MonadIO f, MonadError (Variant e) f, CouldBe e Text) =>
Text -> f Text
findExecutable Text
exe = (FilePath -> Text) -> f FilePath -> f Text
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Text
T.pack (f FilePath -> f Text) -> f FilePath -> f Text
forall a b. (a -> b) -> a -> b
$
  IO (Maybe FilePath) -> f (Maybe FilePath)
forall a. IO a -> f a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO (Maybe FilePath)
IO.findExecutable (Text -> FilePath
T.unpack Text
exe)) f (Maybe FilePath) -> (Maybe FilePath -> f FilePath) -> f FilePath
forall a b. f a -> (a -> f b) -> f b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe FilePath -> f FilePath
forall e (es :: [*]) (m :: * -> *) a.
(MonadError (Variant es) m, CouldBe es e) =>
e -> Maybe a -> m a
OO.hoistMaybe (Text
exe Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not in path")

runGhcPkg :: ()
  => MonadCatch m
  => MonadIO m
  => MonadError (OO.Variant e) m
  => e `OO.CouldBe` Text
  => Text
  -> [Text]
  -> m Text
runGhcPkg :: forall (m :: * -> *) (e :: [*]).
(MonadCatch m, MonadIO m, MonadError (Variant e) m,
 CouldBe e Text) =>
Text -> [Text] -> m Text
runGhcPkg Text
cmdExe [Text]
args = m Text -> (IOError -> m Text) -> m Text
forall e a. (HasCallStack, Exception e) => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
catch (IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (FilePath -> Text) -> IO FilePath -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> [FilePath] -> FilePath -> IO FilePath
IO.readProcess (Text -> FilePath
T.unpack Text
cmdExe) ((Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> FilePath
T.unpack [Text]
args) FilePath
"") ((IOError -> m Text) -> m Text) -> (IOError -> m Text) -> m Text
forall a b. (a -> b) -> a -> b
$
  \(IOError
e :: IOError) -> Text -> m Text
forall x (e :: [*]) (m :: * -> *) a.
(MonadError (Variant e) m, CouldBe e x) =>
x -> m a
OO.throw (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text
"Unable to run " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cmdExe Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords [Text]
args Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IOError -> Text
forall a. Show a => a -> Text
tshow IOError
e

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

mkCompilerContext :: ()
  => MonadIO m
  => MonadCatch m
  => e `OO.CouldBe` Text
  => Z.PlanJson
  -> ExceptT (OO.Variant e) m Z.CompilerContext
mkCompilerContext :: forall (m :: * -> *) (e :: [*]).
(MonadIO m, MonadCatch m, CouldBe e Text) =>
PlanJson -> ExceptT (Variant e) m CompilerContext
mkCompilerContext PlanJson
plan = do
  Text
compilerVersion <- Text -> Text -> Maybe Text
T.stripPrefix Text
"ghc-" (PlanJson
plan PlanJson -> Getting Text PlanJson Text -> Text
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 (sel :: Symbol) s t a b. HasAny sel s t a b => Lens s t a b
the @"compilerId")
    Maybe Text
-> (Maybe Text -> ExceptT (Variant e) m Text)
-> ExceptT (Variant e) m Text
forall a b. a -> (a -> b) -> b
& forall e (es :: [*]) (m :: * -> *) a.
(MonadError (Variant es) m, CouldBe es e) =>
e -> Maybe a -> m a
OO.hoistMaybe @Text Text
"No compiler version available in plan"
  let versionedGhcPkgCmd :: Text
versionedGhcPkgCmd = Text
"ghc-pkg-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
compilerVersion
  Text
ghcPkgCmdPath <-
          (Text -> ExceptT (Variant e) m Text
forall (f :: * -> *) (e :: [*]).
(MonadIO f, MonadError (Variant e) f, CouldBe e Text) =>
Text -> f Text
findExecutable (Text -> Text
withExeExt' Text
versionedGhcPkgCmd)  ExceptT (Variant e) m Text
-> (Text -> ExceptT (Variant e) m Text)
-> ExceptT (Variant e) m Text
forall a b.
ExceptT (Variant e) m a
-> (a -> ExceptT (Variant e) m b) -> ExceptT (Variant e) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Text -> ExceptT (Variant e) m Text
forall (e :: [*]) (m :: * -> *).
(MonadError (Variant e) m, MonadIO m, MonadCatch m,
 CouldBe e Text) =>
Text -> Text -> m Text
verifyGhcPkgVersion Text
compilerVersion)
    ExceptT (Variant e) m Text
-> ExceptT (Variant e) m Text -> ExceptT (Variant e) m Text
forall (m :: * -> *) e a.
Monad m =>
ExceptT e m a -> ExceptT e m a -> ExceptT e m a
<||>  (Text -> ExceptT (Variant e) m Text
forall (f :: * -> *) (e :: [*]).
(MonadIO f, MonadError (Variant e) f, CouldBe e Text) =>
Text -> f Text
findExecutable (Text -> Text
withExeExt' Text
"ghc-pkg"         )  ExceptT (Variant e) m Text
-> (Text -> ExceptT (Variant e) m Text)
-> ExceptT (Variant e) m Text
forall a b.
ExceptT (Variant e) m a
-> (a -> ExceptT (Variant e) m b) -> ExceptT (Variant e) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Text -> ExceptT (Variant e) m Text
forall (e :: [*]) (m :: * -> *).
(MonadError (Variant e) m, MonadIO m, MonadCatch m,
 CouldBe e Text) =>
Text -> Text -> m Text
verifyGhcPkgVersion Text
compilerVersion)
  CompilerContext -> ExceptT (Variant e) m CompilerContext
forall a. a -> ExceptT (Variant e) m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> CompilerContext
Z.CompilerContext [Text -> FilePath
T.unpack Text
ghcPkgCmdPath])

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

getPackages :: FilePath -> Z.PlanJson -> IO [PackageInfo]
getPackages :: FilePath -> PlanJson -> IO [PackageInfo]
getPackages FilePath
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 (FilePath -> Text -> Package -> IO PackageInfo
mkPackageInfo FilePath
basePath Text
compilerId')
  where compilerId' :: Text
        compilerId' :: Text
compilerId' = PlanJson
planJson PlanJson -> Getting Text PlanJson Text -> Text
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 (sel :: Symbol) s t a b. HasAny sel 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 (sel :: Symbol) s t a b. HasAny sel s t a b => Lens s t a b
the @"installPlan"

loadPlan :: ()
  => MonadIO m
  => MonadError (OO.Variant e) m
  => e `OO.CouldBe` DecodeError
  => FilePath
  -> m Z.PlanJson
loadPlan :: forall (m :: * -> *) (e :: [*]).
(MonadIO m, MonadError (Variant e) m, CouldBe e DecodeError) =>
FilePath -> m PlanJson
loadPlan FilePath
resolvedBuildPath = do
  ByteString
lbs <- IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO ByteString
LBS.readFile (FilePath
resolvedBuildPath FilePath -> ShowS
</> FilePath
"cache" FilePath -> ShowS
</> FilePath
"plan.json"))
  PlanJson
a <- Either DecodeError PlanJson -> m PlanJson
forall x (e :: [*]) (m :: * -> *) a.
(MonadError (Variant e) m, CouldBe e x, Monad m) =>
Either x a -> m a
OO.hoistEither (Either DecodeError PlanJson -> m PlanJson)
-> Either DecodeError PlanJson -> m PlanJson
forall a b. (a -> b) -> a -> b
$ (FilePath -> DecodeError)
-> Either FilePath PlanJson -> Either DecodeError PlanJson
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> DecodeError
DecodeError (Text -> DecodeError)
-> (FilePath -> Text) -> FilePath -> DecodeError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack) (ByteString -> Either FilePath PlanJson
forall a. FromJSON a => ByteString -> Either FilePath a
eitherDecode ByteString
lbs)
  PlanJson -> m PlanJson
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure do PlanJson
a :: Z.PlanJson

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

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