{-# 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           Data.Versions hiding (version)
import           URI.ByteString
import           URI.ByteString.QQ

import qualified Data.List.NonEmpty            as NE
import qualified Data.Text                     as T

-- | 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 :: PVP
ghcUpVer :: PVP
ghcUpVer = NonEmpty Word -> PVP
PVP (NonEmpty Word -> PVP) -> ([Int] -> NonEmpty Word) -> [Int] -> PVP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word] -> NonEmpty Word
forall a. [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 (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
prettyPVP (PVP -> String) -> PVP -> String
forall a b. (a -> b) -> a -> b
$ PVP
ghcUpVer

versionCmp :: 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 :: Versioning -> VersionRange -> Bool
versionRange :: Versioning -> VersionRange -> Bool
versionRange Versioning
ver' (SimpleRange NonEmpty VersionCmp
cmps) = NonEmpty Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (NonEmpty Bool -> Bool) -> NonEmpty Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (VersionCmp -> Bool) -> NonEmpty VersionCmp -> NonEmpty Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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