{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module GHCup.Prelude.MegaParsec where
import GHCup.Types
import Control.Applicative
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Data.Functor
import Data.Maybe
import Data.Text ( Text )
import Data.Versions
import Data.Void
import System.FilePath
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import qualified Text.Megaparsec as MP
choice' :: (MonadFail f, MP.MonadParsec e s f) => [f a] -> f a
choice' :: forall (f :: * -> *) e s a.
(MonadFail f, MonadParsec e s f) =>
[f a] -> f a
choice' [] = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Empty list"
choice' [f a
x ] = f a
x
choice' (f a
x : [f a]
xs) = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try f a
x forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) e s a.
(MonadFail f, MonadParsec e s f) =>
[f a] -> f a
choice' [f a]
xs
parseUntil :: MP.Parsec Void Text a -> MP.Parsec Void Text Text
parseUntil :: forall a. Parsec Void Text a -> Parsec Void Text Text
parseUntil Parsec Void Text a
p = do
(forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.lookAhead Parsec Void Text a
p) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. Monoid a => a
mempty)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (do
Text
c <- Char -> Text
T.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
MP.anySingle
Text
c2 <- forall a. Parsec Void Text a -> Parsec Void Text Text
parseUntil Parsec Void Text a
p
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
c forall a. Monoid a => a -> a -> a
`mappend` Text
c2)
)
parseUntil1 :: MP.Parsec Void Text a -> MP.Parsec Void Text Text
parseUntil1 :: forall a. Parsec Void Text a -> Parsec Void Text Text
parseUntil1 Parsec Void Text a
p = do
Int
i1 <- forall e s (m :: * -> *). MonadParsec e s m => m Int
MP.getOffset
Text
t <- forall a. Parsec Void Text a -> Parsec Void Text Text
parseUntil Parsec Void Text a
p
Int
i2 <- forall e s (m :: * -> *). MonadParsec e s m => m Int
MP.getOffset
if Int
i1 forall a. Eq a => a -> a -> Bool
== Int
i2 then forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"empty parse" else forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t
ghcTargetBinP :: Text -> MP.Parsec Void Text (Maybe Text, Text)
ghcTargetBinP :: Text -> Parsec Void Text (Maybe Text, Text)
ghcTargetBinP Text
t =
(,)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try
(forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parsec Void Text a -> Parsec Void Text Text
parseUntil1 (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"-" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Text
t) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"-"
)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((\ Maybe Any
_ Maybe Text
x -> Maybe Text
x) forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Monoid a => a
mempty)
)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Text
t forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
MP.eof)
ghcProjectVersion :: MP.Parsec Void Text Version
ghcProjectVersion :: Parsec Void Text Version
ghcProjectVersion = do
Tokens Text
_ <- forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"ProjectVersion=\""
Text
ver <- forall a. Parsec Void Text a -> Parsec Void Text Text
parseUntil1 forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"\""
forall e s (m :: * -> *). MonadParsec e s m => s -> m ()
MP.setInput Text
ver
Parsec Void Text Version
version'
ghcTargetVerP :: MP.Parsec Void Text GHCTargetVersion
ghcTargetVerP :: Parsec Void Text GHCTargetVersion
ghcTargetVerP =
(\Maybe Text
x Version
y -> Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
x Version
y)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parsec Void Text a -> Parsec Void Text Text
parseUntil1 (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"-" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text Text
verP') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"-")
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((\ Maybe Any
_ Maybe Text
x -> Maybe Text
x) forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Monoid a => a
mempty)
)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parsec Void Text Version
version' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
MP.eof)
where
verP' :: MP.Parsec Void Text Text
verP' :: Parsec Void Text Text
verP' = do
Version
v <- Parsec Void Text Version
version'
let startsWithDigists :: Bool
startsWithDigists =
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
(forall a b. (a -> b) -> [a] -> [b]
map
(\case
(Digits Word
_) -> Bool
True
(Str Text
_) -> Bool
False
) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.toList)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.toList
forall a b. (a -> b) -> a -> b
$ Version -> NonEmpty VChunk
_vChunks Version
v
if Bool
startsWithDigists Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing (Version -> Maybe Word
_vEpoch Version
v)
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Version -> Text
prettyVer Version
v
else forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Oh"
verP :: MP.Parsec Void Text Text -> MP.Parsec Void Text Versioning
verP :: Parsec Void Text Text -> Parsec Void Text Versioning
verP Parsec Void Text Text
suffix = do
Text
ver <- forall a. Parsec Void Text a -> Parsec Void Text Text
parseUntil Parsec Void Text Text
suffix
if Text -> Bool
T.null Text
ver
then forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"empty version"
else do
Text
rest <- forall e s (m :: * -> *). MonadParsec e s m => m s
MP.getInput
forall e s (m :: * -> *). MonadParsec e s m => s -> m ()
MP.setInput Text
ver
Versioning
v <- Parsec Void Text Versioning
versioning'
forall e s (m :: * -> *). MonadParsec e s m => s -> m ()
MP.setInput Text
rest
forall (f :: * -> *) a. Applicative f => a -> f a
pure Versioning
v
pathSep :: MP.Parsec Void Text Char
pathSep :: Parsec Void Text Char
pathSep = forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
MP.oneOf String
pathSeparators