{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Cabal.Internal.Newtypes where
import Control.Applicative (Alternative (..), liftA2)
import Data.Char (isSpace)
import Data.Function (on)
import Data.Functor.Identity (Identity (..))
import Data.Proxy (Proxy (..))
import Network.URI (URI, parseURI, uriToString)
import qualified Data.Set as S
import qualified Distribution.Compat.CharParsing as C
import qualified Distribution.Compat.Newtype as C
import qualified Distribution.FieldGrammar.Newtypes as C
import qualified Distribution.Parsec as C
import qualified Distribution.Pretty as C
import qualified Distribution.Version as C
import qualified Text.PrettyPrint as PP
newtype PackageLocation = PackageLocation String
deriving anyclass (C.Newtype String)
instance C.Parsec PackageLocation where
parsec :: forall (m :: * -> *). CabalParsing m => m PackageLocation
parsec = String -> PackageLocation
PackageLocation forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m String
outerTerm
where
outerTerm :: m String
outerTerm = (forall a b. (a -> b) -> a -> b
$ String
"") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). CabalParsing m => m (String -> String)
outerChars
outerChars, outerChar, innerChars, innerChar :: C.CabalParsing m => m ShowS
outerChars :: forall (m :: * -> *). CabalParsing m => m (String -> String)
outerChars = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall a. a -> a
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
C.some forall (m :: * -> *). CabalParsing m => m (String -> String)
outerChar
innerChars :: forall (m :: * -> *). CabalParsing m => m (String -> String)
innerChars = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall a. a -> a
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
C.many forall (m :: * -> *). CabalParsing m => m (String -> String)
innerChar
outerChar :: forall (m :: * -> *). CabalParsing m => m (String -> String)
outerChar = do
Char
c <- forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
C.satisfy forall a b. (a -> b) -> a -> b
$ \Char
c -> Bool -> Bool
not (Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'}' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
',')
forall (m :: * -> *).
CabalParsing m =>
Char -> m (String -> String)
kont Char
c
innerChar :: forall (m :: * -> *). CabalParsing m => m (String -> String)
innerChar = do
Char
c <- forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
C.satisfy forall a b. (a -> b) -> a -> b
$ \Char
c -> Bool -> Bool
not (Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'}')
forall (m :: * -> *).
CabalParsing m =>
Char -> m (String -> String)
kont Char
c
kont :: C.CabalParsing m => Char -> m ShowS
kont :: forall (m :: * -> *).
CabalParsing m =>
Char -> m (String -> String)
kont Char
c = case Char
c of
Char
'{' -> do
String -> String
cs <- forall (m :: * -> *). CabalParsing m => m (String -> String)
innerChars
Char
c' <- forall (m :: * -> *). CharParsing m => Char -> m Char
C.char Char
'}'
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> String -> String
showChar Char
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
cs forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> String
showChar Char
c')
Char
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Char -> String -> String
showChar Char
c
instance C.Pretty PackageLocation where
pretty :: PackageLocation -> Doc
pretty (PackageLocation String
p) = String -> Doc
PP.text String
p
newtype NoCommas = NoCommas String
deriving anyclass (C.Newtype String)
instance C.Parsec NoCommas where
parsec :: forall (m :: * -> *). CabalParsing m => m NoCommas
parsec = String -> NoCommas
NoCommas forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) (forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
C.satisfy (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace)) (forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
C.munch (forall a. Eq a => a -> a -> Bool
/= Char
','))
instance C.Pretty NoCommas where
pretty :: NoCommas -> Doc
pretty (NoCommas String
p) = String -> Doc
PP.text String
p
newtype HeadVersion = HeadVersion { HeadVersion -> Maybe Version
getHeadVersion :: Maybe C.Version }
deriving anyclass (C.Newtype (Maybe C.Version))
instance C.Parsec HeadVersion where
parsec :: forall (m :: * -> *). CabalParsing m => m HeadVersion
parsec = Maybe Version -> HeadVersion
HeadVersion forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). CharParsing m => String -> m String
C.string String
"head" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Maybe Version -> HeadVersion
HeadVersion forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
C.parsec
instance C.Pretty HeadVersion where
pretty :: HeadVersion -> Doc
pretty (HeadVersion Maybe Version
Nothing) = String -> Doc
PP.text String
"head"
pretty (HeadVersion (Just Version
v)) = forall a. Pretty a => a -> Doc
C.pretty Version
v
newtype Int' = Int' Int
deriving anyclass (C.Newtype Int)
instance C.Parsec Int' where
parsec :: forall (m :: * -> *). CabalParsing m => m Int'
parsec = Int -> Int'
Int' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. (CharParsing m, Integral a) => m a
C.integral
instance C.Pretty Int' where
pretty :: Int' -> Doc
pretty (Int' Int
i) = Int -> Doc
PP.int Int
i
newtype Range = Range C.VersionRange
deriving anyclass (C.Newtype C.VersionRange)
instance C.Parsec Range where
parsec :: forall (m :: * -> *). CabalParsing m => m Range
parsec = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap VersionRange -> Range
Range forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
C.parsec forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> VersionRange
fromBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
C.parsec where
fromBool :: Bool -> VersionRange
fromBool Bool
True = VersionRange
C.anyVersion
fromBool Bool
False = VersionRange
C.noVersion
instance C.Pretty Range where
pretty :: Range -> Doc
pretty (Range VersionRange
r)
| VersionRange -> VersionRange -> Bool
equivVersionRanges VersionRange
r VersionRange
C.anyVersion = forall a. Pretty a => a -> Doc
C.pretty Bool
True
| VersionRange -> VersionRange -> Bool
equivVersionRanges VersionRange
r VersionRange
C.noVersion = forall a. Pretty a => a -> Doc
C.pretty Bool
False
| Bool
otherwise = forall a. Pretty a => a -> Doc
C.pretty VersionRange
r
newtype AlaSet sep b a = AlaSet { forall sep b a. AlaSet sep b a -> Set a
getAlaSet :: S.Set a }
deriving anyclass (C.Newtype (S.Set a))
alaSet :: sep -> S.Set a -> AlaSet sep (Identity a) a
alaSet :: forall sep a. sep -> Set a -> AlaSet sep (Identity a) a
alaSet sep
_ = forall sep b a. Set a -> AlaSet sep b a
AlaSet
alaSet' :: sep -> (a -> b) -> S.Set a -> AlaSet sep b a
alaSet' :: forall sep a b. sep -> (a -> b) -> Set a -> AlaSet sep b a
alaSet' sep
_ a -> b
_ = forall sep b a. Set a -> AlaSet sep b a
AlaSet
instance (C.Newtype a b, Ord a, C.Sep sep, C.Parsec b) => C.Parsec (AlaSet sep b a) where
parsec :: forall (m :: * -> *). CabalParsing m => m (AlaSet sep b a)
parsec = forall o n. Newtype o n => o -> n
C.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Set a
S.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall o n. Newtype o n => n -> o
C.unpack :: b -> a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall sep (m :: * -> *) a.
(Sep sep, CabalParsing m) =>
Proxy sep -> m a -> m [a]
C.parseSep (forall a (proxy :: * -> *). Proxy a -> proxy a
hack (forall {k} (t :: k). Proxy t
Proxy :: Proxy sep)) forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
C.parsec
instance (C.Newtype a b, C.Sep sep, C.Pretty b) => C.Pretty (AlaSet sep b a) where
pretty :: AlaSet sep b a -> Doc
pretty = forall sep. Sep sep => Proxy sep -> [Doc] -> Doc
C.prettySep (forall a (proxy :: * -> *). Proxy a -> proxy a
hack (forall {k} (t :: k). Proxy t
Proxy :: Proxy sep)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => a -> Doc
C.pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall o n. Newtype o n => o -> n
C.pack :: a -> b)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
S.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall o n. Newtype o n => n -> o
C.unpack
hack :: Proxy a -> proxy a
hack :: forall a (proxy :: * -> *). Proxy a -> proxy a
hack Proxy a
_ = forall a. HasCallStack => a
undefined
newtype WrappedURI = WrapURI URI
deriving anyclass (C.Newtype URI)
instance C.Parsec WrappedURI where
parsec :: forall (m :: * -> *). CabalParsing m => m WrappedURI
parsec = do
String
t <- forall (m :: * -> *). CabalParsing m => m String
C.parsecToken
case String -> Maybe URI
parseURI String
t of
Just URI
x -> forall (m :: * -> *) a. Monad m => a -> m a
return (URI -> WrappedURI
WrapURI URI
x)
Maybe URI
Nothing -> forall (m :: * -> *) a. Parsing m => String -> m a
C.unexpected forall a b. (a -> b) -> a -> b
$ String
"Not an URI: " forall a. [a] -> [a] -> [a]
++ String
t
instance C.Pretty WrappedURI where
pretty :: WrappedURI -> Doc
pretty (WrapURI URI
uri) = String -> Doc
PP.text ((String -> String) -> URI -> String -> String
uriToString forall a. a -> a
id URI
uri String
"")
equivVersionRanges :: C.VersionRange -> C.VersionRange -> Bool
equivVersionRanges :: VersionRange -> VersionRange -> Bool
equivVersionRanges = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall a. Eq a => a -> a -> Bool
(==) VersionRange -> [VersionInterval]
C.asVersionIntervals