{-# LANGUAGE DeriveGeneric #-}
-- |
-- Module: Staversion.Internal.BuildPlan.Core
-- Description: Build plan of core packages (those bundled with a compiler)
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- __This is an internal module. End-users should not use it.__
--
-- @since 0.2.4.0
module Staversion.Internal.BuildPlan.Core
  ( -- * Types
    CompilerCores,
    CoreBuildPlanMap(..),
    Compiler(..),
    CompilerVersion(..),
    CompilerName,
    -- * Versions
    mkCompilerVersion,
    -- * GHC
    ghcName,
    parseGHCPkgVersions,
    fetchGHCPkgVersions
  ) where

import Control.Applicative ((<|>), (<$>), some)
import Control.Monad (void)
import qualified Data.ByteString.Lazy as BSL
import Data.Char (isSpace)
import Data.Foldable (foldlM)
import Data.Hashable (Hashable(..))
import qualified Data.HashMap.Strict as HM
import Data.Semigroup ((<>))
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import GHC.Generics (Generic)

import Staversion.Internal.HTTP (Manager, fetchURL)
import Staversion.Internal.Query (PackageName)
import Staversion.Internal.Version (Version, versionNumbers, mkVersion)
import Staversion.Internal.BuildPlan.BuildPlanMap (BuildPlanMap,  HasVersions(..))
import Staversion.Internal.BuildPlan.Parser (parserVersion)
import qualified Staversion.Internal.BuildPlan.BuildPlanMap as BuildPlanMap
import qualified Staversion.Internal.Megaparsec as P

-- | Name of a compiler
type CompilerName = Text

-- | Version of a compiler
data CompilerVersion =
  CVHead -- ^ the HEAD version
  | CVNumbered Version -- ^ a numbered version.
  deriving (Int -> CompilerVersion -> ShowS
[CompilerVersion] -> ShowS
CompilerVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompilerVersion] -> ShowS
$cshowList :: [CompilerVersion] -> ShowS
show :: CompilerVersion -> String
$cshow :: CompilerVersion -> String
showsPrec :: Int -> CompilerVersion -> ShowS
$cshowsPrec :: Int -> CompilerVersion -> ShowS
Show,CompilerVersion -> CompilerVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompilerVersion -> CompilerVersion -> Bool
$c/= :: CompilerVersion -> CompilerVersion -> Bool
== :: CompilerVersion -> CompilerVersion -> Bool
$c== :: CompilerVersion -> CompilerVersion -> Bool
Eq,Eq CompilerVersion
CompilerVersion -> CompilerVersion -> Bool
CompilerVersion -> CompilerVersion -> Ordering
CompilerVersion -> CompilerVersion -> CompilerVersion
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CompilerVersion -> CompilerVersion -> CompilerVersion
$cmin :: CompilerVersion -> CompilerVersion -> CompilerVersion
max :: CompilerVersion -> CompilerVersion -> CompilerVersion
$cmax :: CompilerVersion -> CompilerVersion -> CompilerVersion
>= :: CompilerVersion -> CompilerVersion -> Bool
$c>= :: CompilerVersion -> CompilerVersion -> Bool
> :: CompilerVersion -> CompilerVersion -> Bool
$c> :: CompilerVersion -> CompilerVersion -> Bool
<= :: CompilerVersion -> CompilerVersion -> Bool
$c<= :: CompilerVersion -> CompilerVersion -> Bool
< :: CompilerVersion -> CompilerVersion -> Bool
$c< :: CompilerVersion -> CompilerVersion -> Bool
compare :: CompilerVersion -> CompilerVersion -> Ordering
$ccompare :: CompilerVersion -> CompilerVersion -> Ordering
Ord,forall x. Rep CompilerVersion x -> CompilerVersion
forall x. CompilerVersion -> Rep CompilerVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CompilerVersion x -> CompilerVersion
$cfrom :: forall x. CompilerVersion -> Rep CompilerVersion x
Generic)

-- | Make a 'CVNumbered' "CompilerVersion".
mkCompilerVersion :: [Int] -> CompilerVersion
mkCompilerVersion :: [Int] -> CompilerVersion
mkCompilerVersion = Version -> CompilerVersion
CVNumbered forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Version
mkVersion

instance Hashable CompilerVersion where
  hashWithSalt :: Int -> CompilerVersion -> Int
hashWithSalt Int
s CompilerVersion
CVHead = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s ()
  hashWithSalt Int
s (CVNumbered Version
v) = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s forall a b. (a -> b) -> a -> b
$ Version -> [Int]
versionNumbers Version
v

-- | A compiler with an explicit version.
data Compiler =
  Compiler
  { Compiler -> CompilerName
compilerName :: CompilerName,
    Compiler -> CompilerVersion
compilerVersion :: CompilerVersion
  }
  deriving (Int -> Compiler -> ShowS
[Compiler] -> ShowS
Compiler -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Compiler] -> ShowS
$cshowList :: [Compiler] -> ShowS
show :: Compiler -> String
$cshow :: Compiler -> String
showsPrec :: Int -> Compiler -> ShowS
$cshowsPrec :: Int -> Compiler -> ShowS
Show,Compiler -> Compiler -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Compiler -> Compiler -> Bool
$c/= :: Compiler -> Compiler -> Bool
== :: Compiler -> Compiler -> Bool
$c== :: Compiler -> Compiler -> Bool
Eq,Eq Compiler
Compiler -> Compiler -> Bool
Compiler -> Compiler -> Ordering
Compiler -> Compiler -> Compiler
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Compiler -> Compiler -> Compiler
$cmin :: Compiler -> Compiler -> Compiler
max :: Compiler -> Compiler -> Compiler
$cmax :: Compiler -> Compiler -> Compiler
>= :: Compiler -> Compiler -> Bool
$c>= :: Compiler -> Compiler -> Bool
> :: Compiler -> Compiler -> Bool
$c> :: Compiler -> Compiler -> Bool
<= :: Compiler -> Compiler -> Bool
$c<= :: Compiler -> Compiler -> Bool
< :: Compiler -> Compiler -> Bool
$c< :: Compiler -> Compiler -> Bool
compare :: Compiler -> Compiler -> Ordering
$ccompare :: Compiler -> Compiler -> Ordering
Ord,forall x. Rep Compiler x -> Compiler
forall x. Compiler -> Rep Compiler x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Compiler x -> Compiler
$cfrom :: forall x. Compiler -> Rep Compiler x
Generic)

instance Hashable Compiler

-- | Build plan of the core packages for a compiler.
data CoreBuildPlanMap =
  CoreBuildPlanMap
  { CoreBuildPlanMap -> Compiler
coreCompiler :: Compiler,
    CoreBuildPlanMap -> BuildPlanMap
coreMap :: BuildPlanMap
  }
  deriving (Int -> CoreBuildPlanMap -> ShowS
[CoreBuildPlanMap] -> ShowS
CoreBuildPlanMap -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CoreBuildPlanMap] -> ShowS
$cshowList :: [CoreBuildPlanMap] -> ShowS
show :: CoreBuildPlanMap -> String
$cshow :: CoreBuildPlanMap -> String
showsPrec :: Int -> CoreBuildPlanMap -> ShowS
$cshowsPrec :: Int -> CoreBuildPlanMap -> ShowS
Show,CoreBuildPlanMap -> CoreBuildPlanMap -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CoreBuildPlanMap -> CoreBuildPlanMap -> Bool
$c/= :: CoreBuildPlanMap -> CoreBuildPlanMap -> Bool
== :: CoreBuildPlanMap -> CoreBuildPlanMap -> Bool
$c== :: CoreBuildPlanMap -> CoreBuildPlanMap -> Bool
Eq)

instance HasVersions CoreBuildPlanMap where
  packageVersion :: CoreBuildPlanMap -> CompilerName -> Maybe Version
packageVersion CoreBuildPlanMap
cbp = forall t. HasVersions t => t -> CompilerName -> Maybe Version
packageVersion forall a b. (a -> b) -> a -> b
$ CoreBuildPlanMap -> BuildPlanMap
coreMap CoreBuildPlanMap
cbp

-- | Name of ghc.
ghcName :: CompilerName
ghcName :: CompilerName
ghcName = CompilerName
"ghc"

-- | Compilers and its corresponding core packages.
type CompilerCores = HM.HashMap Compiler CoreBuildPlanMap

addVersions :: Compiler -> [(PackageName, Version)] -> CompilerCores -> CompilerCores
addVersions :: Compiler
-> [(CompilerName, Version)] -> CompilerCores -> CompilerCores
addVersions Compiler
c [(CompilerName, Version)]
pkgs = forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HM.insertWith CoreBuildPlanMap -> CoreBuildPlanMap -> CoreBuildPlanMap
merge Compiler
c CoreBuildPlanMap
inserted_cbp
  where
    inserted_cbp :: CoreBuildPlanMap
inserted_cbp = Compiler -> BuildPlanMap -> CoreBuildPlanMap
CoreBuildPlanMap Compiler
c forall a b. (a -> b) -> a -> b
$ [(CompilerName, Version)] -> BuildPlanMap
BuildPlanMap.fromList [(CompilerName, Version)]
pkgs
    merge :: CoreBuildPlanMap -> CoreBuildPlanMap -> CoreBuildPlanMap
merge CoreBuildPlanMap
new CoreBuildPlanMap
old = CoreBuildPlanMap
new { coreMap :: BuildPlanMap
coreMap = CoreBuildPlanMap -> BuildPlanMap
coreMap CoreBuildPlanMap
new forall a. Semigroup a => a -> a -> a
<> CoreBuildPlanMap -> BuildPlanMap
coreMap CoreBuildPlanMap
old }

parsePkgVersionsLine :: Text -> Either String (Compiler, [(PackageName, Version)])
parsePkgVersionsLine :: CompilerName -> Either String (Compiler, [(CompilerName, Version)])
parsePkgVersionsLine CompilerName
input = forall {a} {b}. Show a => Either a b -> Either String b
mapError forall a b. (a -> b) -> a -> b
$ forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
P.runParser ParsecT
  (ErrorFancy Void)
  CompilerName
  Identity
  (Compiler, [(CompilerName, Version)])
parser String
"" CompilerName
input
  where
    mapError :: Either a b -> Either String b
mapError (Left a
e) = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show a
e
    mapError (Right b
a) = forall a b. b -> Either a b
Right b
a
    parser :: ParsecT
  (ErrorFancy Void)
  CompilerName
  Identity
  (Compiler, [(CompilerName, Version)])
parser = do
      forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
P.space
      CompilerVersion
cv <- ParsecT (ErrorFancy Void) CompilerName Identity CompilerVersion
parserCompilerVersion
      forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
P.space1
      [(CompilerName, Version)]
vers <- forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
P.sepBy ParsecT
  (ErrorFancy Void) CompilerName Identity (CompilerName, Version)
parserPVer forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
P.space1
      forall (m :: * -> *) a. Monad m => a -> m a
return (CompilerName -> CompilerVersion -> Compiler
Compiler CompilerName
ghcName CompilerVersion
cv, [(CompilerName, Version)]
vers)
    parserCompilerVersion :: ParsecT (ErrorFancy Void) CompilerName Identity CompilerVersion
parserCompilerVersion = ParsecT (ErrorFancy Void) CompilerName Identity CompilerVersion
headVersion forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Version -> CompilerVersion
CVNumbered forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Version
parserVersion)
    headVersion :: ParsecT (ErrorFancy Void) CompilerName Identity CompilerVersion
headVersion = do
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ String -> Parser String
P.string String
"HEAD"
      forall (m :: * -> *) a. Monad m => a -> m a
return CompilerVersion
CVHead
    parserPVer :: ParsecT
  (ErrorFancy Void) CompilerName Identity (CompilerName, Version)
parserPVer = do
      CompilerName
name <- (Char -> Bool) -> Parser CompilerName
P.textSatisfying (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
/= Char
'/')
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
'/'
      Version
ver <- Parser Version
parserVersion
      forall (m :: * -> *) a. Monad m => a -> m a
return (CompilerName
name, Version
ver)

-- | Parse the \"pkg_versions.txt\" file for GHC core packages.
parseGHCPkgVersions :: BSL.ByteString -> Either String (HM.HashMap Compiler CoreBuildPlanMap)
parseGHCPkgVersions :: ByteString -> Either String CompilerCores
parseGHCPkgVersions ByteString
content =
  forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM CompilerCores -> CompilerName -> Either String CompilerCores
f forall k v. HashMap k v
HM.empty forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompilerName -> Bool
isWhiteLine) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map CompilerName -> CompilerName
removeComment forall a b. (a -> b) -> a -> b
$ ByteString -> [CompilerName]
toLines ByteString
content
  where
    toLines :: BSL.ByteString -> [Text]
    toLines :: ByteString -> [CompilerName]
toLines = forall a b. (a -> b) -> [a] -> [b]
map Text -> CompilerName
TL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
TL.lines forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TL.decodeUtf8
    removeComment :: CompilerName -> CompilerName
removeComment = (Char -> Bool) -> CompilerName -> CompilerName
T.takeWhile (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
/= Char
'#')
    isWhiteLine :: CompilerName -> Bool
isWhiteLine = (Char -> Bool) -> CompilerName -> Bool
T.all Char -> Bool
isSpace
    f :: CompilerCores -> CompilerName -> Either String CompilerCores
f CompilerCores
acc CompilerName
line = do
      (Compiler
c, [(CompilerName, Version)]
vers) <- CompilerName -> Either String (Compiler, [(CompilerName, Version)])
parsePkgVersionsLine CompilerName
line
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Compiler
-> [(CompilerName, Version)] -> CompilerCores -> CompilerCores
addVersions Compiler
c [(CompilerName, Version)]
vers CompilerCores
acc

-- | Fetch the \"pkg_versions.txt\" from the Web.
fetchGHCPkgVersions :: Manager -> IO BSL.ByteString
fetchGHCPkgVersions :: Manager -> IO ByteString
fetchGHCPkgVersions Manager
man = Manager -> String -> IO ByteString
fetchURL Manager
man String
"https://gitlab.haskell.org/bgamari/ghc-utils/-/raw/master/library-versions/pkg_versions.txt"