{-# LANGUAGE QuasiQuotes       #-}


{-|
Module      : GHCup.Version
Description : Version information and version handling.
Copyright   : (c) Julian Ospald, 2020
License     : LGPL-3.0
Maintainer  : hasufell@hasufell.de
Stability   : experimental
Portability : portable
-}
module GHCup.Version where

import           GHCup.Types
import           Paths_ghcup (version)

import           Data.Version (Version(versionBranch))
import           URI.ByteString
import           URI.ByteString.QQ

import qualified Data.List.NonEmpty            as NE
import qualified Data.Text                     as T
import qualified Data.Versions as V
import Control.Exception.Safe (MonadThrow)
import Data.Text (Text)
import Control.Monad.Catch (throwM)
import GHCup.Errors (ParseError(..))
import Text.Megaparsec
import Data.Void (Void)

-- | This reflects the API version of the YAML.
--
-- Note that when updating this, CI requires that the file exists AND the same file exists at
-- 'https://www.haskell.org/ghcup/exp/ghcup-<ver>.yaml' with some newlines added.
ghcupURL :: URI
ghcupURL :: URI
ghcupURL = [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-0.0.8.yaml|]

stackSetupURL :: URI
stackSetupURL :: URI
stackSetupURL = [uri|https://raw.githubusercontent.com/commercialhaskell/stackage-content/master/stack/stack-setup-2.yaml|]

shimGenURL :: URI
shimGenURL :: URI
shimGenURL = [uri|https://downloads.haskell.org/~ghcup/shimgen/shim-2.exe|]

shimGenSHA :: T.Text
shimGenSHA :: Text
shimGenSHA = String -> Text
T.pack String
"7c55e201f71860c5babea886007c8fa44b861abf50d1c07e5677eb0bda387a70"

-- | The current ghcup version.
ghcUpVer :: V.PVP
ghcUpVer :: PVP
ghcUpVer = NonEmpty Word -> PVP
V.PVP (NonEmpty Word -> PVP) -> ([Int] -> NonEmpty Word) -> [Int] -> PVP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word] -> NonEmpty Word
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList ([Word] -> NonEmpty Word)
-> ([Int] -> [Word]) -> [Int] -> NonEmpty Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Word) -> [Int] -> [Word]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> PVP) -> [Int] -> PVP
forall a b. (a -> b) -> a -> b
$ Version -> [Int]
versionBranch Version
version

-- | ghcup version as numeric string.
numericVer :: String
numericVer :: String
numericVer = Text -> String
T.unpack (Text -> String) -> (PVP -> Text) -> PVP -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PVP -> Text
V.prettyPVP (PVP -> String) -> PVP -> String
forall a b. (a -> b) -> a -> b
$ PVP
ghcUpVer

versionCmp :: V.Versioning -> VersionCmp -> Bool
versionCmp :: Versioning -> VersionCmp -> Bool
versionCmp Versioning
ver1 (VR_gt Versioning
ver2)   = Versioning
ver1 Versioning -> Versioning -> Bool
forall a. Ord a => a -> a -> Bool
> Versioning
ver2
versionCmp Versioning
ver1 (VR_gteq Versioning
ver2) = Versioning
ver1 Versioning -> Versioning -> Bool
forall a. Ord a => a -> a -> Bool
>= Versioning
ver2
versionCmp Versioning
ver1 (VR_lt Versioning
ver2)   = Versioning
ver1 Versioning -> Versioning -> Bool
forall a. Ord a => a -> a -> Bool
< Versioning
ver2
versionCmp Versioning
ver1 (VR_lteq Versioning
ver2) = Versioning
ver1 Versioning -> Versioning -> Bool
forall a. Ord a => a -> a -> Bool
<= Versioning
ver2
versionCmp Versioning
ver1 (VR_eq Versioning
ver2)   = Versioning
ver1 Versioning -> Versioning -> Bool
forall a. Eq a => a -> a -> Bool
== Versioning
ver2

versionRange :: V.Versioning -> VersionRange -> Bool
versionRange :: Versioning -> VersionRange -> Bool
versionRange Versioning
ver' (SimpleRange NonEmpty VersionCmp
cmps) = (VersionCmp -> Bool) -> NonEmpty VersionCmp -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Versioning -> VersionCmp -> Bool
versionCmp Versioning
ver') NonEmpty VersionCmp
cmps
versionRange Versioning
ver' (OrRange NonEmpty VersionCmp
cmps VersionRange
range) =
  Versioning -> VersionRange -> Bool
versionRange Versioning
ver' (NonEmpty VersionCmp -> VersionRange
SimpleRange NonEmpty VersionCmp
cmps) Bool -> Bool -> Bool
|| Versioning -> VersionRange -> Bool
versionRange Versioning
ver' VersionRange
range

pvpToVersion :: MonadThrow m => V.PVP -> Text -> m V.Version
pvpToVersion :: forall (m :: * -> *). MonadThrow m => PVP -> Text -> m Version
pvpToVersion PVP
pvp_ Text
rest =
  (ParsingError -> m Version)
-> (Version -> m Version)
-> Either ParsingError Version
-> m Version
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ParsingError
_ -> ParseError -> m Version
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m Version) -> ParseError -> m Version
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
"Couldn't convert PVP to Version") Version -> m Version
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParsingError Version -> m Version)
-> (PVP -> Either ParsingError Version) -> PVP -> m Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ParsingError Version
V.version (Text -> Either ParsingError Version)
-> (PVP -> Text) -> PVP -> Either ParsingError Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rest) (Text -> Text) -> (PVP -> Text) -> PVP -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PVP -> Text
V.prettyPVP (PVP -> m Version) -> PVP -> m Version
forall a b. (a -> b) -> a -> b
$ PVP
pvp_

-- | Convert a version to a PVP and unparsable rest.
--
-- -- prop> \v -> let (Just (pvp', r)) = versionToPVP v in pvpToVersion pvp' r === Just v
versionToPVP :: MonadThrow m => V.Version -> m (V.PVP, Text)
versionToPVP :: forall (m :: * -> *). MonadThrow m => Version -> m (PVP, Text)
versionToPVP (V.Version (Just Word
_) Chunks
_ Maybe Release
_ Maybe Text
_) = ParseError -> m (PVP, Text)
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m (PVP, Text)) -> ParseError -> m (PVP, Text)
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
"Unexpected epoch"
versionToPVP Version
v = case Parsec Void Text (PVP, Text)
-> String -> Text -> Either ParsingError (PVP, Text)
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parsec Void Text (PVP, Text)
pvp'' String
"Version->PVP" (Text -> Either ParsingError (PVP, Text))
-> Text -> Either ParsingError (PVP, Text)
forall a b. (a -> b) -> a -> b
$ Version -> Text
V.prettyVer Version
v of
  Left ParsingError
_  -> ParseError -> m (PVP, Text)
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m (PVP, Text)) -> ParseError -> m (PVP, Text)
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
"Couldn't convert Version to PVP"
  Right (PVP, Text)
r -> (PVP, Text) -> m (PVP, Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PVP, Text)
r
 where
   pvp'' :: Parsec Void T.Text (V.PVP, T.Text)
   pvp'' :: Parsec Void Text (PVP, Text)
pvp'' = do
     PVP
p <- Parsec Void Text PVP
V.pvp'
     State Text Void
s <- ParsecT Void Text Identity (State Text Void)
forall e s (m :: * -> *). MonadParsec e s m => m (State s e)
getParserState
     (PVP, Text) -> Parsec Void Text (PVP, Text)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PVP
p, State Text Void -> Text
forall s e. State s e -> s
stateInput State Text Void
s)

pvpFromList :: [Int] -> V.PVP
pvpFromList :: [Int] -> PVP
pvpFromList = NonEmpty Word -> PVP
V.PVP (NonEmpty Word -> PVP) -> ([Int] -> NonEmpty Word) -> [Int] -> PVP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word] -> NonEmpty Word
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList ([Word] -> NonEmpty Word)
-> ([Int] -> [Word]) -> [Int] -> NonEmpty Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Word) -> [Int] -> [Word]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral