{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ViewPatterns #-}
module Hpack.Syntax.DependencyVersion (
  githubBaseUrl
, GitRef
, GitUrl

, VersionConstraint(..)
, versionConstraint
, anyVersion
, versionRange

, DependencyVersion(..)
, withDependencyVersion
, dependencyVersion

, SourceDependency(..)
, objectDependency

, versionConstraintFromCabal

, scientificToVersion
, cabalParse
) where

import           Imports

import qualified Control.Monad.Fail as Fail
import           Data.Maybe
import           Data.Scientific
import qualified Data.Text as T
import qualified Data.Aeson.Config.KeyMap as KeyMap
import           Text.PrettyPrint (renderStyle, Style(..), Mode(..))

import qualified Distribution.Version as D

import qualified Distribution.Parsec as D
import qualified Distribution.Pretty as D
import qualified Distribution.Types.VersionRange.Internal as D

import           Data.Aeson.Config.FromValue

githubBaseUrl :: String
githubBaseUrl :: [Char]
githubBaseUrl = [Char]
"https://github.com/"

type GitUrl = String
type GitRef = String

data VersionConstraint = AnyVersion | VersionRange String
  deriving (VersionConstraint -> VersionConstraint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VersionConstraint -> VersionConstraint -> Bool
$c/= :: VersionConstraint -> VersionConstraint -> Bool
== :: VersionConstraint -> VersionConstraint -> Bool
$c== :: VersionConstraint -> VersionConstraint -> Bool
Eq, Eq VersionConstraint
VersionConstraint -> VersionConstraint -> Bool
VersionConstraint -> VersionConstraint -> Ordering
VersionConstraint -> VersionConstraint -> VersionConstraint
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 :: VersionConstraint -> VersionConstraint -> VersionConstraint
$cmin :: VersionConstraint -> VersionConstraint -> VersionConstraint
max :: VersionConstraint -> VersionConstraint -> VersionConstraint
$cmax :: VersionConstraint -> VersionConstraint -> VersionConstraint
>= :: VersionConstraint -> VersionConstraint -> Bool
$c>= :: VersionConstraint -> VersionConstraint -> Bool
> :: VersionConstraint -> VersionConstraint -> Bool
$c> :: VersionConstraint -> VersionConstraint -> Bool
<= :: VersionConstraint -> VersionConstraint -> Bool
$c<= :: VersionConstraint -> VersionConstraint -> Bool
< :: VersionConstraint -> VersionConstraint -> Bool
$c< :: VersionConstraint -> VersionConstraint -> Bool
compare :: VersionConstraint -> VersionConstraint -> Ordering
$ccompare :: VersionConstraint -> VersionConstraint -> Ordering
Ord, Int -> VersionConstraint -> ShowS
[VersionConstraint] -> ShowS
VersionConstraint -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [VersionConstraint] -> ShowS
$cshowList :: [VersionConstraint] -> ShowS
show :: VersionConstraint -> [Char]
$cshow :: VersionConstraint -> [Char]
showsPrec :: Int -> VersionConstraint -> ShowS
$cshowsPrec :: Int -> VersionConstraint -> ShowS
Show)

instance FromValue VersionConstraint where
  fromValue :: Value -> Parser VersionConstraint
fromValue = Value -> Parser VersionConstraint
versionConstraint

versionConstraint :: Value -> Parser VersionConstraint
versionConstraint :: Value -> Parser VersionConstraint
versionConstraint Value
v = case Value
v of
  Value
Null -> forall (m :: * -> *) a. Monad m => a -> m a
return VersionConstraint
AnyVersion
  Number Scientific
n -> forall (m :: * -> *) a. Monad m => a -> m a
return (Scientific -> VersionConstraint
numericVersionConstraint Scientific
n)
  String Text
s -> Text -> Parser VersionConstraint
stringVersionConstraint Text
s
  Value
_ -> forall a. [Char] -> Value -> Parser a
typeMismatch [Char]
"Null, Number, or String" Value
v

anyVersion :: DependencyVersion
anyVersion :: DependencyVersion
anyVersion = Maybe SourceDependency -> VersionConstraint -> DependencyVersion
DependencyVersion forall a. Maybe a
Nothing VersionConstraint
AnyVersion

versionRange :: String -> DependencyVersion
versionRange :: [Char] -> DependencyVersion
versionRange = Maybe SourceDependency -> VersionConstraint -> DependencyVersion
DependencyVersion forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> VersionConstraint
VersionRange

data DependencyVersion = DependencyVersion (Maybe SourceDependency) VersionConstraint
  deriving (DependencyVersion -> DependencyVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DependencyVersion -> DependencyVersion -> Bool
$c/= :: DependencyVersion -> DependencyVersion -> Bool
== :: DependencyVersion -> DependencyVersion -> Bool
$c== :: DependencyVersion -> DependencyVersion -> Bool
Eq, Eq DependencyVersion
DependencyVersion -> DependencyVersion -> Bool
DependencyVersion -> DependencyVersion -> Ordering
DependencyVersion -> DependencyVersion -> DependencyVersion
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 :: DependencyVersion -> DependencyVersion -> DependencyVersion
$cmin :: DependencyVersion -> DependencyVersion -> DependencyVersion
max :: DependencyVersion -> DependencyVersion -> DependencyVersion
$cmax :: DependencyVersion -> DependencyVersion -> DependencyVersion
>= :: DependencyVersion -> DependencyVersion -> Bool
$c>= :: DependencyVersion -> DependencyVersion -> Bool
> :: DependencyVersion -> DependencyVersion -> Bool
$c> :: DependencyVersion -> DependencyVersion -> Bool
<= :: DependencyVersion -> DependencyVersion -> Bool
$c<= :: DependencyVersion -> DependencyVersion -> Bool
< :: DependencyVersion -> DependencyVersion -> Bool
$c< :: DependencyVersion -> DependencyVersion -> Bool
compare :: DependencyVersion -> DependencyVersion -> Ordering
$ccompare :: DependencyVersion -> DependencyVersion -> Ordering
Ord, Int -> DependencyVersion -> ShowS
[DependencyVersion] -> ShowS
DependencyVersion -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [DependencyVersion] -> ShowS
$cshowList :: [DependencyVersion] -> ShowS
show :: DependencyVersion -> [Char]
$cshow :: DependencyVersion -> [Char]
showsPrec :: Int -> DependencyVersion -> ShowS
$cshowsPrec :: Int -> DependencyVersion -> ShowS
Show)

withDependencyVersion
  :: (DependencyVersion -> a)
  -> (Object -> DependencyVersion -> Parser a)
  -> Value
  -> Parser a
withDependencyVersion :: forall a.
(DependencyVersion -> a)
-> (Object -> DependencyVersion -> Parser a) -> Value -> Parser a
withDependencyVersion DependencyVersion -> a
k Object -> DependencyVersion -> Parser a
obj Value
v = case Value
v of
  Value
Null -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DependencyVersion -> a
k DependencyVersion
anyVersion
  Object Object
o -> Object -> Parser DependencyVersion
objectDependency Object
o forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Object -> DependencyVersion -> Parser a
obj Object
o
  Number Scientific
n -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DependencyVersion -> a
k (Maybe SourceDependency -> VersionConstraint -> DependencyVersion
DependencyVersion forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ Scientific -> VersionConstraint
numericVersionConstraint Scientific
n)
  String Text
s -> DependencyVersion -> a
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe SourceDependency -> VersionConstraint -> DependencyVersion
DependencyVersion forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser VersionConstraint
stringVersionConstraint Text
s
  Value
_ -> forall a. [Char] -> Value -> Parser a
typeMismatch [Char]
"Null, Object, Number, or String" Value
v

dependencyVersion :: Value -> Parser DependencyVersion
dependencyVersion :: Value -> Parser DependencyVersion
dependencyVersion = forall a.
(DependencyVersion -> a)
-> (Object -> DependencyVersion -> Parser a) -> Value -> Parser a
withDependencyVersion forall a. a -> a
id (forall a b. a -> b -> a
const forall (m :: * -> *) a. Monad m => a -> m a
return)

data SourceDependency = GitRef GitUrl GitRef (Maybe FilePath) | Local FilePath
  deriving (SourceDependency -> SourceDependency -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourceDependency -> SourceDependency -> Bool
$c/= :: SourceDependency -> SourceDependency -> Bool
== :: SourceDependency -> SourceDependency -> Bool
$c== :: SourceDependency -> SourceDependency -> Bool
Eq, Eq SourceDependency
SourceDependency -> SourceDependency -> Bool
SourceDependency -> SourceDependency -> Ordering
SourceDependency -> SourceDependency -> SourceDependency
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 :: SourceDependency -> SourceDependency -> SourceDependency
$cmin :: SourceDependency -> SourceDependency -> SourceDependency
max :: SourceDependency -> SourceDependency -> SourceDependency
$cmax :: SourceDependency -> SourceDependency -> SourceDependency
>= :: SourceDependency -> SourceDependency -> Bool
$c>= :: SourceDependency -> SourceDependency -> Bool
> :: SourceDependency -> SourceDependency -> Bool
$c> :: SourceDependency -> SourceDependency -> Bool
<= :: SourceDependency -> SourceDependency -> Bool
$c<= :: SourceDependency -> SourceDependency -> Bool
< :: SourceDependency -> SourceDependency -> Bool
$c< :: SourceDependency -> SourceDependency -> Bool
compare :: SourceDependency -> SourceDependency -> Ordering
$ccompare :: SourceDependency -> SourceDependency -> Ordering
Ord, Int -> SourceDependency -> ShowS
[SourceDependency] -> ShowS
SourceDependency -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SourceDependency] -> ShowS
$cshowList :: [SourceDependency] -> ShowS
show :: SourceDependency -> [Char]
$cshow :: SourceDependency -> [Char]
showsPrec :: Int -> SourceDependency -> ShowS
$cshowsPrec :: Int -> SourceDependency -> ShowS
Show)

objectDependency :: Object -> Parser DependencyVersion
objectDependency :: Object -> Parser DependencyVersion
objectDependency Object
o = let
    version :: Parser VersionConstraint
    version :: Parser VersionConstraint
version = forall a. a -> Maybe a -> a
fromMaybe VersionConstraint
AnyVersion forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromValue a => Object -> Key -> Parser (Maybe a)
.:? Key
"version")

    local :: Parser SourceDependency
    local :: Parser SourceDependency
local = [Char] -> SourceDependency
Local forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromValue a => Object -> Key -> Parser a
.: Key
"path"

    git :: Parser SourceDependency
    git :: Parser SourceDependency
git = [Char] -> [Char] -> Maybe [Char] -> SourceDependency
GitRef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [Char]
url forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Char]
ref forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe [Char])
subdir

    url :: Parser String
    url :: Parser [Char]
url =
          (([Char]
githubBaseUrl forall a. [a] -> [a] -> [a]
++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromValue a => Object -> Key -> Parser a
.: Key
"github")
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Object
o forall a. FromValue a => Object -> Key -> Parser a
.: Key
"git")
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"neither key \"git\" nor key \"github\" present"

    ref :: Parser String
    ref :: Parser [Char]
ref = Object
o forall a. FromValue a => Object -> Key -> Parser a
.: Key
"ref"

    subdir :: Parser (Maybe FilePath)
    subdir :: Parser (Maybe [Char])
subdir = Object
o forall a. FromValue a => Object -> Key -> Parser (Maybe a)
.:? Key
"subdir"

    source :: Parser (Maybe SourceDependency)
    source :: Parser (Maybe SourceDependency)
source
      | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Key -> KeyMap a -> Bool
`KeyMap.member` Object
o) [Key
"path", Key
"git", Key
"github", Key
"ref", Key
"subdir"] = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser SourceDependency
local forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser SourceDependency
git)
      | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

    in Maybe SourceDependency -> VersionConstraint -> DependencyVersion
DependencyVersion forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe SourceDependency)
source forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser VersionConstraint
version

numericVersionConstraint :: Scientific -> VersionConstraint
numericVersionConstraint :: Scientific -> VersionConstraint
numericVersionConstraint Scientific
n = [Char] -> VersionConstraint
VersionRange ([Char]
"==" forall a. [a] -> [a] -> [a]
++ [Char]
version)
  where
    version :: [Char]
version = Scientific -> [Char]
scientificToVersion Scientific
n

stringVersionConstraint :: Text -> Parser VersionConstraint
stringVersionConstraint :: Text -> Parser VersionConstraint
stringVersionConstraint Text
s = forall (m :: * -> *). MonadFail m => [Char] -> m VersionConstraint
parseVersionRange ([Char]
"== " forall a. [a] -> [a] -> [a]
++ [Char]
input) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). MonadFail m => [Char] -> m VersionConstraint
parseVersionRange [Char]
input
  where
    input :: [Char]
input = Text -> [Char]
T.unpack Text
s

scientificToVersion :: Scientific -> String
scientificToVersion :: Scientific -> [Char]
scientificToVersion Scientific
n = [Char]
version
  where
    version :: [Char]
version = FPFormat -> Maybe Int -> Scientific -> [Char]
formatScientific FPFormat
Fixed (forall a. a -> Maybe a
Just Int
decimalPlaces) Scientific
n
    decimalPlaces :: Int
decimalPlaces
      | Int
e forall a. Ord a => a -> a -> Bool
< Int
0 = forall a. Num a => a -> a
abs Int
e
      | Bool
otherwise = Int
0
    e :: Int
e = Scientific -> Int
base10Exponent Scientific
n

parseVersionRange :: Fail.MonadFail m => String -> m VersionConstraint
parseVersionRange :: forall (m :: * -> *). MonadFail m => [Char] -> m VersionConstraint
parseVersionRange = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap VersionRange -> VersionConstraint
versionConstraintFromCabal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadFail m => [Char] -> m VersionRange
parseCabalVersionRange

parseCabalVersionRange :: Fail.MonadFail m => String -> m D.VersionRange
parseCabalVersionRange :: forall (m :: * -> *). MonadFail m => [Char] -> m VersionRange
parseCabalVersionRange = forall (m :: * -> *) a.
(MonadFail m, Parsec a) =>
[Char] -> [Char] -> m a
cabalParse [Char]
"constraint"

cabalParse :: (Fail.MonadFail m, D.Parsec a) => String -> String -> m a
cabalParse :: forall (m :: * -> *) a.
(MonadFail m, Parsec a) =>
[Char] -> [Char] -> m a
cabalParse [Char]
subject [Char]
s = case forall a. Parsec a => [Char] -> Either [Char] a
D.eitherParsec [Char]
s of
  Right a
d -> forall (m :: * -> *) a. Monad m => a -> m a
return a
d
  Left [Char]
_ ->forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords [[Char]
"invalid",  [Char]
subject, forall a. Show a => a -> [Char]
show [Char]
s]

renderVersionRange :: D.VersionRange -> String
renderVersionRange :: VersionRange -> [Char]
renderVersionRange = \ case
  D.IntersectVersionRanges (D.OrLaterVersion Version
x) (D.EarlierVersion Version
y) | (Version, Version) -> Bool
differByOneInLeastPosition (Version
x, Version
y) -> [Char]
"==" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> [Char]
render Version
x forall a. [a] -> [a] -> [a]
++ [Char]
".*"
  VersionRange
v -> forall a. Pretty a => a -> [Char]
render VersionRange
v
  where
    differByOneInLeastPosition :: (Version, Version) -> Bool
differByOneInLeastPosition = \ case
      (forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> [Int]
D.versionNumbers -> Int
x : [Int]
xs, forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> [Int]
D.versionNumbers -> Int
y : [Int]
ys) -> [Int]
xs forall a. Eq a => a -> a -> Bool
== [Int]
ys Bool -> Bool -> Bool
&& forall a. Enum a => a -> a
succ Int
x forall a. Eq a => a -> a -> Bool
== Int
y
      (Version, Version)
_ -> Bool
False

render :: D.Pretty a => a -> String
render :: forall a. Pretty a => a -> [Char]
render = Style -> Doc -> [Char]
renderStyle (Mode -> Int -> Float -> Style
Style Mode
OneLineMode Int
0 Float
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Doc
D.pretty

versionConstraintFromCabal :: D.VersionRange -> VersionConstraint
versionConstraintFromCabal :: VersionRange -> VersionConstraint
versionConstraintFromCabal VersionRange
range
  | VersionRange -> Bool
D.isAnyVersion VersionRange
range = VersionConstraint
AnyVersion
  | Bool
otherwise = [Char] -> VersionConstraint
VersionRange forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionRange -> [Char]
renderVersionRange forall a b. (a -> b) -> a -> b
$ VersionRange -> VersionRange
toPreCabal2VersionRange VersionRange
range
  where
    toPreCabal2VersionRange :: D.VersionRange -> D.VersionRange
    toPreCabal2VersionRange :: VersionRange -> VersionRange
toPreCabal2VersionRange = VersionRangeF VersionRange -> VersionRange
D.embedVersionRange forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (VersionRangeF a -> a) -> VersionRange -> a
D.cataVersionRange VersionRangeF (VersionRangeF VersionRange)
-> VersionRangeF VersionRange
f
      where
        f :: D.VersionRangeF (D.VersionRangeF D.VersionRange) -> D.VersionRangeF D.VersionRange
        f :: VersionRangeF (VersionRangeF VersionRange)
-> VersionRangeF VersionRange
f = \ case
          D.MajorBoundVersionF Version
v -> forall a. a -> a -> VersionRangeF a
D.IntersectVersionRangesF (VersionRangeF VersionRange -> VersionRange
D.embedVersionRange forall {a}. VersionRangeF a
lower) (VersionRangeF VersionRange -> VersionRange
D.embedVersionRange forall {a}. VersionRangeF a
upper)
            where
              lower :: VersionRangeF a
lower = forall a. Version -> VersionRangeF a
D.OrLaterVersionF Version
v
              upper :: VersionRangeF a
upper = forall a. Version -> VersionRangeF a
D.EarlierVersionF (Version -> Version
D.majorUpperBound Version
v)

          D.ThisVersionF Version
v -> forall a. Version -> VersionRangeF a
D.ThisVersionF Version
v
          D.LaterVersionF Version
v -> forall a. Version -> VersionRangeF a
D.LaterVersionF Version
v
          D.OrLaterVersionF Version
v -> forall a. Version -> VersionRangeF a
D.OrLaterVersionF Version
v
          D.EarlierVersionF Version
v -> forall a. Version -> VersionRangeF a
D.EarlierVersionF Version
v
          D.OrEarlierVersionF Version
v -> forall a. Version -> VersionRangeF a
D.OrEarlierVersionF Version
v
          D.UnionVersionRangesF VersionRangeF VersionRange
a VersionRangeF VersionRange
b -> forall a. a -> a -> VersionRangeF a
D.UnionVersionRangesF (VersionRangeF VersionRange -> VersionRange
D.embedVersionRange VersionRangeF VersionRange
a) (VersionRangeF VersionRange -> VersionRange
D.embedVersionRange VersionRangeF VersionRange
b)
          D.IntersectVersionRangesF VersionRangeF VersionRange
a VersionRangeF VersionRange
b -> forall a. a -> a -> VersionRangeF a
D.IntersectVersionRangesF (VersionRangeF VersionRange -> VersionRange
D.embedVersionRange VersionRangeF VersionRange
a) (VersionRangeF VersionRange -> VersionRange
D.embedVersionRange VersionRangeF VersionRange
b)
#if !MIN_VERSION_Cabal(3,4,0)
          D.WildcardVersionF v -> D.WildcardVersionF v
          D.VersionRangeParensF a -> D.VersionRangeParensF (D.embedVersionRange a)
          D.AnyVersionF -> D.AnyVersionF
#endif