{-# 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 Data.List.NonEmpty (NonEmpty((:|)))
import Data.List (intersperse)
import Control.Monad.Catch (throwM)
import GHCup.Errors (ParseError(..))

-- | This reflects the API version of the YAML.
--
-- Note that when updating this, CI requires that the file exsists 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.7.yaml|]

-- | The current ghcup version.
ghcUpVer :: V.PVP
ghcUpVer :: PVP
ghcUpVer = NonEmpty Word -> PVP
V.PVP forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> NonEmpty a
NE.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. PVP -> Text
V.prettyPVP 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 forall a. Ord a => a -> a -> Bool
> Versioning
ver2
versionCmp Versioning
ver1 (VR_gteq Versioning
ver2) = Versioning
ver1 forall a. Ord a => a -> a -> Bool
>= Versioning
ver2
versionCmp Versioning
ver1 (VR_lt Versioning
ver2)   = Versioning
ver1 forall a. Ord a => a -> a -> Bool
< Versioning
ver2
versionCmp Versioning
ver1 (VR_lteq Versioning
ver2) = Versioning
ver1 forall a. Ord a => a -> a -> Bool
<= Versioning
ver2
versionCmp Versioning
ver1 (VR_eq Versioning
ver2)   = Versioning
ver1 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) = 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 =
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ParsingError
_ -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
"Couldn't convert PVP to Version") forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ParsingError Version
V.version forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Semigroup a => a -> a -> a
<> Text
rest) forall b c a. (b -> c) -> (a -> b) -> a -> c
. PVP -> Text
V.prettyPVP 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
_) NonEmpty VChunk
_ [VChunk]
_ Maybe Text
_) = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
"Unexpected epoch"
versionToPVP Version
v = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ParsingError
_ -> (, Version -> Text
rest Version
v) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadThrow m => Version -> m PVP
alternative Version
v) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (, forall a. Monoid a => a
mempty)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ParsingError PVP
V.pvp forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Text
V.prettyVer forall a b. (a -> b) -> a -> b
$ Version
v
 where
  alternative :: MonadThrow m => V.Version -> m V.PVP
  alternative :: forall (m :: * -> *). MonadThrow m => Version -> m PVP
alternative Version
v' = case forall a. (a -> Bool) -> NonEmpty a -> [a]
NE.takeWhile VChunk -> Bool
isDigit (Version -> NonEmpty VChunk
V._vChunks Version
v') of
    [] -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
"Couldn't convert Version to PVP"
    [VChunk]
xs -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Int] -> PVP
pvpFromList (VChunk -> Int
unsafeDigit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VChunk]
xs)

  rest :: V.Version -> Text
  rest :: Version -> Text
rest (V.Version Maybe Word
_ NonEmpty VChunk
cs [VChunk]
pr Maybe Text
me) =
    let chunks :: [VChunk]
chunks = forall a. (a -> Bool) -> NonEmpty a -> [a]
NE.dropWhile VChunk -> Bool
isDigit NonEmpty VChunk
cs
        ver :: [Text]
ver = forall a. a -> [a] -> [a]
intersperse (String -> Text
T.pack String
".") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *). Functor t => t VChunk -> t Text
chunksAsT forall a b. (a -> b) -> a -> b
$ [VChunk]
chunks
        me' :: [Text]
me' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
m -> [String -> Text
T.pack String
"+",Text
m]) Maybe Text
me
        pr' :: [Text]
pr' = forall (f :: * -> *) b a.
Foldable f =>
f b -> (f a -> f b) -> f a -> f b
foldable [] (String -> Text
T.pack String
"-" forall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse (String -> Text
T.pack String
".") (forall (t :: * -> *). Functor t => t VChunk -> t Text
chunksAsT [VChunk]
pr)
        prefix :: Text
prefix = case ([Text]
ver, [Text]
pr', [Text]
me') of
                   (Text
_:[Text]
_, [Text]
_, [Text]
_) -> String -> Text
T.pack String
"."
                   ([Text], [Text], [Text])
_           -> String -> Text
T.pack String
""
    in Text
prefix forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat ([Text]
ver forall a. Semigroup a => a -> a -> a
<> [Text]
pr' forall a. Semigroup a => a -> a -> a
<> [Text]
me')
   where
    chunksAsT :: Functor t => t V.VChunk -> t Text
    chunksAsT :: forall (t :: * -> *). Functor t => t VChunk -> t Text
chunksAsT = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap VUnit -> Text
f)
      where
        f :: V.VUnit -> Text
        f :: VUnit -> Text
f (V.Digits Word
i) = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Word
i
        f (V.Str Text
s)    = Text
s

    foldable :: Foldable f => f b -> (f a -> f b) -> f a -> f b
    foldable :: forall (f :: * -> *) b a.
Foldable f =>
f b -> (f a -> f b) -> f a -> f b
foldable f b
d f a -> f b
g f a
f | forall (t :: * -> *) a. Foldable t => t a -> Bool
null f a
f    = f b
d
                   | Bool
otherwise = f a -> f b
g f a
f



  isDigit :: V.VChunk -> Bool
  isDigit :: VChunk -> Bool
isDigit (V.Digits Word
_ :| []) = Bool
True
  isDigit VChunk
_                = Bool
False

  unsafeDigit :: V.VChunk -> Int
  unsafeDigit :: VChunk -> Int
unsafeDigit (V.Digits Word
x :| []) = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
x
  unsafeDigit VChunk
_ = forall a. HasCallStack => String -> a
error String
"unsafeDigit: wrong input"

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