-- |
-- Module: Staversion.Internal.BuildPlan
-- Description:  Handle build plan YAML files.
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- __This is an internal module. End-users should not use it.__
{-# LANGUAGE GeneralizedNewtypeDeriving, TupleSections #-}
module Staversion.Internal.BuildPlan
       ( -- * Entry APIs
         HasVersions(..),
         BuildPlan,
         buildPlanSource,
         BuildPlanManager,
         newBuildPlanManager,
         manStackConfig,
         loadBuildPlan,
         -- * Low-level APIs
         BuildPlanMap,
         -- * For tests
         _setLTSDisambiguator
       ) where

import Control.Applicative (empty, (<$>), (<*>))
import Control.Exception (throwIO, catchJust, IOException, catch)
import Control.Monad.IO.Class (liftIO)
import Control.Monad (mapM)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as BSL
import qualified Data.HashMap.Strict as HM
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Data.Monoid (Monoid, (<>), mconcat)
import Data.Semigroup (Semigroup)
import Data.Text (Text, unpack)
import Data.Traversable (Traversable(traverse))
import Data.Word (Word)
import System.FilePath ((</>), (<.>))
import qualified System.IO.Error as IOE
import Text.Read (readMaybe)

import Staversion.Internal.EIO
  ( EIO, maybeToEIO, runEIO, toEIO, loggedElse, eitherToEIO
  )
import Staversion.Internal.Log
  ( Logger, logDebug, logWarn
  )
import Staversion.Internal.HTTP (niceHTTPManager, Manager, OurHttpException)
import Staversion.Internal.Query
 ( PackageName, PackageSource(..),
   ErrorMsg, Resolver
 )
import Staversion.Internal.BuildPlan.BuildPlanMap
  ( BuildPlanMap, HasVersions(..)
  )
import qualified Staversion.Internal.BuildPlan.BuildPlanMap as BPMap
import Staversion.Internal.BuildPlan.Core (CompilerCores)
import qualified Staversion.Internal.BuildPlan.Core as Core
import Staversion.Internal.BuildPlan.Hackage
  ( RegisteredVersions, latestVersion,
    fetchPreferredVersions
  )
import qualified Staversion.Internal.BuildPlan.Pantry as Pantry
import Staversion.Internal.BuildPlan.Stackage
  ( Disambiguator,
    fetchDisambiguator,
    parseResolverString,
    formatExactResolverString,
    PartialResolver(..), ExactResolver(..)
  )
import Staversion.Internal.BuildPlan.V1 as V1
import Staversion.Internal.StackConfig (StackConfig)
import qualified Staversion.Internal.StackConfig as StackConfig
import Staversion.Internal.Version (Version)


-- | A 'BuildPlanMap' associated with its 'PackageSource'.
data BuildPlan = BuildPlan { BuildPlan -> BuildPlanMap
buildPlanMap :: BuildPlanMap,
                             BuildPlan -> PackageSource
buildPlanSource :: PackageSource
                           }

instance HasVersions BuildPlan where
  packageVersion :: BuildPlan -> PackageName -> Maybe Version
packageVersion BuildPlan
bp = forall t. HasVersions t => t -> PackageName -> Maybe Version
packageVersion (BuildPlan -> BuildPlanMap
buildPlanMap BuildPlan
bp)


-- | Stateful manager for 'BuildPlan's.
data BuildPlanManager =
  BuildPlanManager { BuildPlanManager -> [Char]
manBuildPlanDir :: FilePath,
                     -- ^ (accessor function) path to the directory
                     -- where build plans are hold.
                     BuildPlanManager -> Maybe Manager
manHttpManager :: Maybe Manager,
                     -- ^ (accessor function) low-level HTTP
                     -- connection manager. If 'Nothing', it won't
                     -- fetch build plans over the network.
                     BuildPlanManager -> IORef (Maybe Disambiguator)
manDisambiguator :: IORef (Maybe Disambiguator),
                     -- ^ (accessor function) cache of resolver
                     -- disambigutor
                     BuildPlanManager -> IORef (Maybe CompilerCores)
manCores :: IORef (Maybe CompilerCores),
                     -- ^ cache of compiler core packages.
                     BuildPlanManager -> Logger
manLogger :: Logger,
                     BuildPlanManager -> StackConfig
manStackConfig :: StackConfig
                     -- ^ (accessor function)
                   }

newBuildPlanManager :: FilePath -- ^ path to the directory where build plans are hold.
                    -> Logger
                    -> Bool -- ^ If 'True', it queries the Internet for build plans. Otherwise, it won't.
                    -> IO BuildPlanManager
newBuildPlanManager :: [Char] -> Logger -> Bool -> IO BuildPlanManager
newBuildPlanManager [Char]
plan_dir Logger
logger Bool
enable_network = do
  Maybe Manager
mman <- if Bool
enable_network
          then forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Manager
niceHTTPManager
          else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
  IORef (Maybe Disambiguator)
disam <- forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
  IORef (Maybe CompilerCores)
cores <- forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ BuildPlanManager { manBuildPlanDir :: [Char]
manBuildPlanDir = [Char]
plan_dir,
                              manHttpManager :: Maybe Manager
manHttpManager = Maybe Manager
mman,
                              manDisambiguator :: IORef (Maybe Disambiguator)
manDisambiguator = IORef (Maybe Disambiguator)
disam,
                              manCores :: IORef (Maybe CompilerCores)
manCores = IORef (Maybe CompilerCores)
cores,
                              manLogger :: Logger
manLogger = Logger
logger,
                              manStackConfig :: StackConfig
manStackConfig = Logger -> StackConfig
StackConfig.newStackConfig Logger
logger
                            }

httpManagerM :: BuildPlanManager -> EIO Manager
httpManagerM :: BuildPlanManager -> EIO Manager
httpManagerM = forall a. [Char] -> Maybe a -> EIO a
maybeToEIO [Char]
"It is not allowed to access network." forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildPlanManager -> Maybe Manager
manHttpManager

httpExceptionToEIO :: String -> EIO a -> EIO a
httpExceptionToEIO :: forall a. [Char] -> EIO a -> EIO a
httpExceptionToEIO [Char]
context EIO a
action = forall a. IO (Either [Char] a) -> EIO a
toEIO forall a b. (a -> b) -> a -> b
$ (forall a. EIO a -> IO (Either [Char] a)
runEIO EIO a
action) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` forall a. OurHttpException -> IO (Either [Char] a)
handler where
  handler :: OurHttpException -> IO (Either ErrorMsg a)
  handler :: forall a. OurHttpException -> IO (Either [Char] a)
handler OurHttpException
e = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left ([Char]
context forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show OurHttpException
e)

getCores :: BuildPlanManager -> EIO CompilerCores
getCores :: BuildPlanManager -> EIO CompilerCores
getCores BuildPlanManager
man = do
  Maybe CompilerCores
mcores <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef forall a b. (a -> b) -> a -> b
$ BuildPlanManager -> IORef (Maybe CompilerCores)
manCores BuildPlanManager
man
  case Maybe CompilerCores
mcores of
    Just CompilerCores
c -> forall (m :: * -> *) a. Monad m => a -> m a
return CompilerCores
c
    Maybe CompilerCores
Nothing -> do
      Manager
http <- BuildPlanManager -> EIO Manager
httpManagerM BuildPlanManager
man
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Logger -> [Char] -> IO ()
logDebug (BuildPlanManager -> Logger
manLogger BuildPlanManager
man) [Char]
"fetching GHC pkg_versions"
      CompilerCores
cores <- forall a. [Char] -> EIO a -> EIO a
httpExceptionToEIO [Char]
"Failed to fetch GHC pkg_versions"
               forall a b. (a -> b) -> a -> b
$ forall a. IO (Either [Char] a) -> EIO a
toEIO forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Either [Char] CompilerCores
Core.parseGHCPkgVersions forall a b. (a -> b) -> a -> b
$ Manager -> IO ByteString
Core.fetchGHCPkgVersions Manager
http
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef (BuildPlanManager -> IORef (Maybe CompilerCores)
manCores BuildPlanManager
man) forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just CompilerCores
cores
      forall (m :: * -> *) a. Monad m => a -> m a
return CompilerCores
cores

loadBuildPlan :: BuildPlanManager
              -> [PackageName]
              -- ^ package names whose versions the user is interested in.
              -> PackageSource
              -> IO (Either ErrorMsg BuildPlan)
              -- ^ the second result is the real (disambiguated) PackageSource.
loadBuildPlan :: BuildPlanManager
-> [PackageName] -> PackageSource -> IO (Either [Char] BuildPlan)
loadBuildPlan BuildPlanManager
man [PackageName]
names PackageSource
s = forall a. EIO a -> IO (Either [Char] a)
runEIO forall a b. (a -> b) -> a -> b
$ BuildPlanManager -> [PackageName] -> PackageSource -> EIO BuildPlan
loadBuildPlanM BuildPlanManager
man [PackageName]
names PackageSource
s

loadBuildPlanM :: BuildPlanManager -> [PackageName] -> PackageSource -> EIO BuildPlan
loadBuildPlanM :: BuildPlanManager -> [PackageName] -> PackageSource -> EIO BuildPlan
loadBuildPlanM BuildPlanManager
man [PackageName]
_ (SourceStackage [Char]
resolver) = EIO BuildPlan
impl where
  impl :: EIO BuildPlan
impl = BuildPlanManager -> [Char] -> EIO BuildPlan
loadBuildPlan_stackageLocalFile BuildPlanManager
man [Char]
resolver forall {a}. EIO a -> EIO a -> EIO a
`loggedElse'` do
    ExactResolver
e_resolver <- BuildPlanManager
-> PartialResolver -> ExceptT [Char] IO ExactResolver
tryDisambiguate BuildPlanManager
man forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< EIO PartialResolver
getPresolver
    BuildPlanManager -> [Char] -> EIO BuildPlan
loadBuildPlan_stackageLocalFile BuildPlanManager
man (ExactResolver -> [Char]
formatExactResolverString ExactResolver
e_resolver) forall {a}. EIO a -> EIO a -> EIO a
`loggedElse'` BuildPlanManager -> ExactResolver -> EIO BuildPlan
loadBuildPlan_stackageNetwork BuildPlanManager
man ExactResolver
e_resolver
  getPresolver :: EIO PartialResolver
getPresolver = forall a. [Char] -> Maybe a -> EIO a
maybeToEIO ([Char]
"Invalid resolver format for stackage.org: " forall a. [a] -> [a] -> [a]
++ [Char]
resolver) forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe PartialResolver
parseResolverString [Char]
resolver
  loggedElse' :: EIO a -> EIO a -> EIO a
loggedElse' = forall a. Logger -> EIO a -> EIO a -> EIO a
loggedElse forall a b. (a -> b) -> a -> b
$ BuildPlanManager -> Logger
manLogger BuildPlanManager
man
loadBuildPlanM BuildPlanManager
man [PackageName]
names PackageSource
SourceHackage = EIO BuildPlan
impl where
  impl :: EIO BuildPlan
impl = do
    Manager
http_man <- BuildPlanManager -> EIO Manager
httpManagerM BuildPlanManager
man
    BuildPlanMap
build_plan_map <- (forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith PackageName -> RegisteredVersions -> BuildPlanMap
registeredVersionToBuildPlanMap [PackageName]
names) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Manager -> PackageName -> ExceptT [Char] IO RegisteredVersions
doFetch Manager
http_man) [PackageName]
names
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ BuildPlan { buildPlanMap :: BuildPlanMap
buildPlanMap = BuildPlanMap
build_plan_map, buildPlanSource :: PackageSource
buildPlanSource = PackageSource
SourceHackage }
  logDebug' :: [Char] -> m ()
logDebug' [Char]
msg = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Logger -> [Char] -> IO ()
logDebug (BuildPlanManager -> Logger
manLogger BuildPlanManager
man) [Char]
msg
  logWarn' :: [Char] -> m ()
logWarn' [Char]
msg = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Logger -> [Char] -> IO ()
logWarn (BuildPlanManager -> Logger
manLogger BuildPlanManager
man) [Char]
msg
  doFetch :: Manager -> PackageName -> ExceptT [Char] IO RegisteredVersions
doFetch Manager
http_man PackageName
name = do
    forall {m :: * -> *}. MonadIO m => [Char] -> m ()
logDebug' ([Char]
"Ask hackage for the latest version of " forall a. [a] -> [a] -> [a]
++ PackageName -> [Char]
unpack PackageName
name)
    RegisteredVersions
reg_ver <- forall a. IO (Either [Char] a) -> EIO a
toEIO forall a b. (a -> b) -> a -> b
$ Manager -> PackageName -> IO (Either [Char] RegisteredVersions)
fetchPreferredVersions Manager
http_man PackageName
name
    case RegisteredVersions -> Maybe Version
latestVersion RegisteredVersions
reg_ver of
     Maybe Version
Nothing -> forall {m :: * -> *}. MonadIO m => [Char] -> m ()
logWarn' ([Char]
"Cannot find package version of " forall a. [a] -> [a] -> [a]
++ PackageName -> [Char]
unpack PackageName
name forall a. [a] -> [a] -> [a]
++ [Char]
". Maybe it's not on hackage.")
     Just Version
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    forall (m :: * -> *) a. Monad m => a -> m a
return RegisteredVersions
reg_ver
loadBuildPlanM BuildPlanManager
man [PackageName]
names (SourceStackYaml [Char]
file) = BuildPlanManager -> [PackageName] -> Maybe [Char] -> EIO BuildPlan
loadBuildPlan_sourceStack BuildPlanManager
man [PackageName]
names forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just [Char]
file
loadBuildPlanM BuildPlanManager
man [PackageName]
names PackageSource
SourceStackDefault = BuildPlanManager -> [PackageName] -> Maybe [Char] -> EIO BuildPlan
loadBuildPlan_sourceStack BuildPlanManager
man [PackageName]
names forall a b. (a -> b) -> a -> b
$ forall a. Maybe a
Nothing

loadBuildPlan_sourceStack :: BuildPlanManager -> [PackageName] -> Maybe FilePath -> EIO BuildPlan
loadBuildPlan_sourceStack :: BuildPlanManager -> [PackageName] -> Maybe [Char] -> EIO BuildPlan
loadBuildPlan_sourceStack BuildPlanManager
man [PackageName]
names Maybe [Char]
mfile = do
  [Char]
resolver <- forall a. IO (Either [Char] a) -> EIO a
toEIO forall a b. (a -> b) -> a -> b
$ StackConfig -> Maybe [Char] -> IO (Either [Char] [Char])
StackConfig.readResolver StackConfig
sconf Maybe [Char]
mfile
  BuildPlanManager -> [PackageName] -> PackageSource -> EIO BuildPlan
loadBuildPlanM BuildPlanManager
man [PackageName]
names forall a b. (a -> b) -> a -> b
$ [Char] -> PackageSource
SourceStackage [Char]
resolver
  where
    sconf :: StackConfig
sconf = BuildPlanManager -> StackConfig
manStackConfig BuildPlanManager
man

loadBuildPlan_stackageLocalFile :: BuildPlanManager -> Resolver -> EIO BuildPlan
loadBuildPlan_stackageLocalFile :: BuildPlanManager -> [Char] -> EIO BuildPlan
loadBuildPlan_stackageLocalFile BuildPlanManager
man [Char]
resolver = forall a. IO (Either [Char] a) -> EIO a
toEIO forall a b. (a -> b) -> a -> b
$ forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> (b -> IO a) -> IO a
catchJust IOException -> Maybe [Char]
handleIOError IO (Either [Char] BuildPlan)
doLoad (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) where
  yaml_file :: [Char]
yaml_file = BuildPlanManager -> [Char]
manBuildPlanDir BuildPlanManager
man [Char] -> [Char] -> [Char]
</> [Char]
resolver [Char] -> [Char] -> [Char]
<.> [Char]
"yaml"
  doLoad :: IO (Either [Char] BuildPlan)
doLoad = do
    Logger -> [Char] -> IO ()
logDebug (BuildPlanManager -> Logger
manLogger BuildPlanManager
man) ([Char]
"Read " forall a. [a] -> [a] -> [a]
++ [Char]
yaml_file forall a. [a] -> [a] -> [a]
++ [Char]
" for build plan.")
    Either [Char] BuildPlanMap
e_build_plan_map <- [Char] -> IO (Either [Char] BuildPlanMap)
V1.loadBuildPlanMapYAML [Char]
yaml_file
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ BuildPlanMap -> BuildPlan
makeBuildPlan forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either [Char] BuildPlanMap
e_build_plan_map
  makeBuildPlan :: BuildPlanMap -> BuildPlan
makeBuildPlan BuildPlanMap
bp_map = BuildPlan { buildPlanMap :: BuildPlanMap
buildPlanMap = BuildPlanMap
bp_map, buildPlanSource :: PackageSource
buildPlanSource = [Char] -> PackageSource
SourceStackage [Char]
resolver }
  handleIOError :: IOException -> Maybe ErrorMsg
  handleIOError :: IOException -> Maybe [Char]
handleIOError IOException
e | IOException -> Bool
IOE.isDoesNotExistError IOException
e = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}. Show a => a -> [Char] -> [Char]
makeErrorMsg IOException
e ([Char]
yaml_file forall a. [a] -> [a] -> [a]
++ [Char]
" not found.")
                  | IOException -> Bool
IOE.isPermissionError IOException
e = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}. Show a => a -> [Char] -> [Char]
makeErrorMsg IOException
e ([Char]
"you cannot open " forall a. [a] -> [a] -> [a]
++ [Char]
yaml_file forall a. [a] -> [a] -> [a]
++ [Char]
".")
                  | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a}. Show a => a -> [Char] -> [Char]
makeErrorMsg IOException
e ([Char]
"some error.")
  makeErrorMsg :: a -> [Char] -> [Char]
makeErrorMsg a
exception [Char]
body = [Char]
"Loading build plan for package resolver '" forall a. [a] -> [a] -> [a]
++ [Char]
resolver forall a. [a] -> [a] -> [a]
++ [Char]
"' failed: " forall a. [a] -> [a] -> [a]
++ [Char]
body forall a. [a] -> [a] -> [a]
++ [Char]
"\n" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
exception

tryDisambiguate :: BuildPlanManager -> PartialResolver -> EIO ExactResolver
tryDisambiguate :: BuildPlanManager
-> PartialResolver -> ExceptT [Char] IO ExactResolver
tryDisambiguate BuildPlanManager
_ (PartialExact ExactResolver
e) = forall (m :: * -> *) a. Monad m => a -> m a
return ExactResolver
e
tryDisambiguate BuildPlanManager
bp_man PartialResolver
presolver = ExceptT [Char] IO ExactResolver
impl where
  impl :: ExceptT [Char] IO ExactResolver
impl = do
    Disambiguator
disam <- forall a. [Char] -> EIO a -> EIO a
httpExceptionToEIO [Char]
"Failed to download disambiguator" forall a b. (a -> b) -> a -> b
$ EIO Disambiguator
getDisambiguator
    forall a. [Char] -> Maybe a -> EIO a
maybeToEIO ([Char]
"Cannot disambiguate the resolver: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show PartialResolver
presolver) forall a b. (a -> b) -> a -> b
$ Disambiguator
disam PartialResolver
presolver
  getDisambiguator :: EIO Disambiguator
getDisambiguator = do
    Maybe Disambiguator
m_disam <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef forall a b. (a -> b) -> a -> b
$ BuildPlanManager -> IORef (Maybe Disambiguator)
manDisambiguator BuildPlanManager
bp_man
    case Maybe Disambiguator
m_disam of
     Just Disambiguator
d -> forall (m :: * -> *) a. Monad m => a -> m a
return Disambiguator
d
     Maybe Disambiguator
Nothing -> do
       Manager
http_man <- BuildPlanManager -> EIO Manager
httpManagerM BuildPlanManager
bp_man
       [Char] -> ExceptT [Char] IO ()
logDebug' [Char]
"Fetch resolver disambiguator from network..."
       Disambiguator
got_d <- forall a. IO (Either [Char] a) -> EIO a
toEIO forall a b. (a -> b) -> a -> b
$ Manager -> IO (Either [Char] Disambiguator)
fetchDisambiguator Manager
http_man
       [Char] -> ExceptT [Char] IO ()
logDebug' [Char]
"Successfully fetched resolver disambiguator."
       forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef (BuildPlanManager -> IORef (Maybe Disambiguator)
manDisambiguator BuildPlanManager
bp_man) forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Disambiguator
got_d
       forall (m :: * -> *) a. Monad m => a -> m a
return Disambiguator
got_d
  logDebug' :: [Char] -> ExceptT [Char] IO ()
logDebug' = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Logger -> [Char] -> IO ()
logDebug (BuildPlanManager -> Logger
manLogger BuildPlanManager
bp_man)
  
loadBuildPlan_stackageNetwork :: BuildPlanManager -> ExactResolver -> EIO BuildPlan
loadBuildPlan_stackageNetwork :: BuildPlanManager -> ExactResolver -> EIO BuildPlan
loadBuildPlan_stackageNetwork BuildPlanManager
man ExactResolver
e_resolver = do
  CompilerCores
cores <- BuildPlanManager -> EIO CompilerCores
getCores BuildPlanManager
man
  Manager
http_man <- BuildPlanManager -> EIO Manager
httpManagerM BuildPlanManager
man
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Logger -> [Char] -> IO ()
logDebug (BuildPlanManager -> Logger
manLogger BuildPlanManager
man) ([Char]
"Fetch build plan from network: resolver = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ExactResolver
e_resolver)
  ByteString
yaml_data <- forall a. [Char] -> EIO a -> EIO a
httpExceptionToEIO ([Char]
"Downloading build plan failed: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ExactResolver
e_resolver)
               forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Manager -> ExactResolver -> IO ByteString
Pantry.fetchBuildPlanMapYAML Manager
http_man ExactResolver
e_resolver
  BuildPlanMap
bp_map <- forall a. Either [Char] a -> EIO a
eitherToEIO forall a b. (a -> b) -> a -> b
$ (CompilerCores -> PantryBuildPlanMap -> Either [Char] BuildPlanMap
Pantry.coresToBuildPlanMap CompilerCores
cores) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (ByteString -> Either [Char] PantryBuildPlanMap
Pantry.parseBuildPlanMapYAML forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.toStrict ByteString
yaml_data)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ BuildPlan { buildPlanMap :: BuildPlanMap
buildPlanMap = BuildPlanMap
bp_map,
                       buildPlanSource :: PackageSource
buildPlanSource = [Char] -> PackageSource
SourceStackage forall a b. (a -> b) -> a -> b
$ ExactResolver -> [Char]
formatExactResolverString ExactResolver
e_resolver
                     }
registeredVersionToBuildPlanMap :: PackageName -> RegisteredVersions -> BuildPlanMap
registeredVersionToBuildPlanMap :: PackageName -> RegisteredVersions -> BuildPlanMap
registeredVersionToBuildPlanMap PackageName
name RegisteredVersions
rvers = [(PackageName, Version)] -> BuildPlanMap
BPMap.fromList forall a b. (a -> b) -> a -> b
$ [(PackageName, Version)]
pairs where
  pairs :: [(PackageName, Version)]
pairs = case RegisteredVersions -> Maybe Version
latestVersion RegisteredVersions
rvers of
    Maybe Version
Nothing -> []
    Just Version
v -> [(PackageName
name, Version
v)]

_setDisambiguator :: BuildPlanManager -> Maybe Disambiguator -> IO ()
_setDisambiguator :: BuildPlanManager -> Maybe Disambiguator -> IO ()
_setDisambiguator BuildPlanManager
bp_man = forall a. IORef a -> a -> IO ()
writeIORef (BuildPlanManager -> IORef (Maybe Disambiguator)
manDisambiguator BuildPlanManager
bp_man)

_setLTSDisambiguator :: BuildPlanManager
                     -> Word -- ^ disambiguated LTS major version
                     -> Word -- ^ disambiguated LTS minor version
                     -> IO ()
_setLTSDisambiguator :: BuildPlanManager -> Word -> Word -> IO ()
_setLTSDisambiguator BuildPlanManager
bp_man Word
lts_major Word
lts_minor = BuildPlanManager -> Maybe Disambiguator -> IO ()
_setDisambiguator BuildPlanManager
bp_man forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Disambiguator
disam where
  disam :: Disambiguator
disam PartialResolver
PartialLTSLatest = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Word -> Word -> ExactResolver
ExactLTS Word
lts_major Word
lts_minor
  disam PartialResolver
_ = forall a. Maybe a
Nothing