{-# LANGUAGE CPP #-}
{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE Rank2Types #-}
module Distribution.Deprecated.ParseUtils (
LineNo, PError(..), PWarning(..), locatedErrorMsg, syntaxError, warning,
runP, runE, ParseResult(..), parseFail, showPWarning,
Field(..), lineNo,
FieldDescr(..), readFields,
parseHaskellString, parseTokenQ,
parseOptCommaList,
showFilePath, showToken, showFreeText,
field, simpleField, listField, listFieldWithSep, spaceListField,
newLineListField,
liftField,
readPToMaybe,
fieldParsec, simpleFieldParsec,
listFieldParsec,
commaListFieldParsec,
commaNewLineListFieldParsec,
UnrecFieldParser,
) where
import Distribution.Client.Compat.Prelude hiding (get)
import Prelude ()
import Distribution.Deprecated.ReadP as ReadP hiding (get)
import Distribution.Pretty
import Distribution.ReadE
import Distribution.Utils.Generic
import System.FilePath (normalise)
import Text.PrettyPrint (Doc, punctuate, comma, fsep, sep)
import qualified Text.Read as Read
import qualified Control.Monad.Fail as Fail
import Distribution.Parsec (ParsecParser, parsecLeadingCommaList, parsecLeadingOptCommaList)
import qualified Data.ByteString as BS
import qualified Distribution.Fields as Fields
import qualified Distribution.Fields.Field as Fields
import qualified Distribution.Parsec as Parsec
import qualified Distribution.Fields.LexerMonad as Fields
import qualified Text.Parsec.Error as PE
import qualified Text.Parsec.Pos as PP
type LineNo = Int
data PError = AmbiguousParse String LineNo
| NoParse String LineNo
| TabsError LineNo
| FromString String (Maybe LineNo)
deriving (PError -> PError -> Bool
(PError -> PError -> Bool)
-> (PError -> PError -> Bool) -> Eq PError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PError -> PError -> Bool
$c/= :: PError -> PError -> Bool
== :: PError -> PError -> Bool
$c== :: PError -> PError -> Bool
Eq, Int -> PError -> ShowS
[PError] -> ShowS
PError -> String
(Int -> PError -> ShowS)
-> (PError -> String) -> ([PError] -> ShowS) -> Show PError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PError] -> ShowS
$cshowList :: [PError] -> ShowS
show :: PError -> String
$cshow :: PError -> String
showsPrec :: Int -> PError -> ShowS
$cshowsPrec :: Int -> PError -> ShowS
Show)
data PWarning = PWarning String
| UTFWarning LineNo String
deriving (PWarning -> PWarning -> Bool
(PWarning -> PWarning -> Bool)
-> (PWarning -> PWarning -> Bool) -> Eq PWarning
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PWarning -> PWarning -> Bool
$c/= :: PWarning -> PWarning -> Bool
== :: PWarning -> PWarning -> Bool
$c== :: PWarning -> PWarning -> Bool
Eq, Int -> PWarning -> ShowS
[PWarning] -> ShowS
PWarning -> String
(Int -> PWarning -> ShowS)
-> (PWarning -> String) -> ([PWarning] -> ShowS) -> Show PWarning
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PWarning] -> ShowS
$cshowList :: [PWarning] -> ShowS
show :: PWarning -> String
$cshow :: PWarning -> String
showsPrec :: Int -> PWarning -> ShowS
$cshowsPrec :: Int -> PWarning -> ShowS
Show)
showPWarning :: FilePath -> PWarning -> String
showPWarning :: String -> PWarning -> String
showPWarning String
fpath (PWarning String
msg) =
ShowS
normalise String
fpath String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg
showPWarning String
fpath (UTFWarning Int
line String
fname) =
ShowS
normalise String
fpath String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
line
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": Invalid UTF-8 text in the '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fname String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' field."
data ParseResult a = ParseFailed PError | ParseOk [PWarning] a
deriving Int -> ParseResult a -> ShowS
[ParseResult a] -> ShowS
ParseResult a -> String
(Int -> ParseResult a -> ShowS)
-> (ParseResult a -> String)
-> ([ParseResult a] -> ShowS)
-> Show (ParseResult a)
forall a. Show a => Int -> ParseResult a -> ShowS
forall a. Show a => [ParseResult a] -> ShowS
forall a. Show a => ParseResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseResult a] -> ShowS
$cshowList :: forall a. Show a => [ParseResult a] -> ShowS
show :: ParseResult a -> String
$cshow :: forall a. Show a => ParseResult a -> String
showsPrec :: Int -> ParseResult a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ParseResult a -> ShowS
Show
instance Functor ParseResult where
fmap :: (a -> b) -> ParseResult a -> ParseResult b
fmap a -> b
_ (ParseFailed PError
err) = PError -> ParseResult b
forall a. PError -> ParseResult a
ParseFailed PError
err
fmap a -> b
f (ParseOk [PWarning]
ws a
x) = [PWarning] -> b -> ParseResult b
forall a. [PWarning] -> a -> ParseResult a
ParseOk [PWarning]
ws (b -> ParseResult b) -> b -> ParseResult b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
x
instance Applicative ParseResult where
pure :: a -> ParseResult a
pure = [PWarning] -> a -> ParseResult a
forall a. [PWarning] -> a -> ParseResult a
ParseOk []
<*> :: ParseResult (a -> b) -> ParseResult a -> ParseResult b
(<*>) = ParseResult (a -> b) -> ParseResult a -> ParseResult b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad ParseResult where
return :: a -> ParseResult a
return = a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
ParseFailed PError
err >>= :: ParseResult a -> (a -> ParseResult b) -> ParseResult b
>>= a -> ParseResult b
_ = PError -> ParseResult b
forall a. PError -> ParseResult a
ParseFailed PError
err
ParseOk [PWarning]
ws a
x >>= a -> ParseResult b
f = case a -> ParseResult b
f a
x of
ParseFailed PError
err -> PError -> ParseResult b
forall a. PError -> ParseResult a
ParseFailed PError
err
ParseOk [PWarning]
ws' b
x' -> [PWarning] -> b -> ParseResult b
forall a. [PWarning] -> a -> ParseResult a
ParseOk ([PWarning]
ws'[PWarning] -> [PWarning] -> [PWarning]
forall a. [a] -> [a] -> [a]
++[PWarning]
ws) b
x'
#if !(MIN_VERSION_base(4,9,0))
fail = parseResultFail
#elif !(MIN_VERSION_base(4,13,0))
fail = Fail.fail
#endif
instance Foldable ParseResult where
foldMap :: (a -> m) -> ParseResult a -> m
foldMap a -> m
_ (ParseFailed PError
_ ) = m
forall a. Monoid a => a
mempty
foldMap a -> m
f (ParseOk [PWarning]
_ a
x) = a -> m
f a
x
instance Traversable ParseResult where
traverse :: (a -> f b) -> ParseResult a -> f (ParseResult b)
traverse a -> f b
_ (ParseFailed PError
err) = ParseResult b -> f (ParseResult b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PError -> ParseResult b
forall a. PError -> ParseResult a
ParseFailed PError
err)
traverse a -> f b
f (ParseOk [PWarning]
ws a
x) = [PWarning] -> b -> ParseResult b
forall a. [PWarning] -> a -> ParseResult a
ParseOk [PWarning]
ws (b -> ParseResult b) -> f b -> f (ParseResult b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
instance Fail.MonadFail ParseResult where
fail :: String -> ParseResult a
fail = String -> ParseResult a
forall a. String -> ParseResult a
parseResultFail
parseResultFail :: String -> ParseResult a
parseResultFail :: String -> ParseResult a
parseResultFail String
s = PError -> ParseResult a
forall a. PError -> ParseResult a
parseFail (String -> Maybe Int -> PError
FromString String
s Maybe Int
forall a. Maybe a
Nothing)
parseFail :: PError -> ParseResult a
parseFail :: PError -> ParseResult a
parseFail = PError -> ParseResult a
forall a. PError -> ParseResult a
ParseFailed
runP :: LineNo -> String -> ReadP a a -> String -> ParseResult a
runP :: Int -> String -> ReadP a a -> String -> ParseResult a
runP Int
line String
fieldname ReadP a a
p String
s =
case [ a
x | (a
x,String
"") <- [(a, String)]
results ] of
[a
a] -> [PWarning] -> a -> ParseResult a
forall a. [PWarning] -> a -> ParseResult a
ParseOk (Int -> String -> String -> [PWarning]
utf8Warnings Int
line String
fieldname String
s) a
a
[] -> case [ a
x | (a
x,String
ys) <- [(a, String)]
results, (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace String
ys ] of
[a
a] -> [PWarning] -> a -> ParseResult a
forall a. [PWarning] -> a -> ParseResult a
ParseOk (Int -> String -> String -> [PWarning]
utf8Warnings Int
line String
fieldname String
s) a
a
[] -> PError -> ParseResult a
forall a. PError -> ParseResult a
ParseFailed (String -> Int -> PError
NoParse String
fieldname Int
line)
[a]
_ -> PError -> ParseResult a
forall a. PError -> ParseResult a
ParseFailed (String -> Int -> PError
AmbiguousParse String
fieldname Int
line)
[a]
_ -> PError -> ParseResult a
forall a. PError -> ParseResult a
ParseFailed (String -> Int -> PError
AmbiguousParse String
fieldname Int
line)
where results :: [(a, String)]
results = ReadP a a -> ReadS a
forall a. ReadP a a -> ReadS a
readP_to_S ReadP a a
p String
s
runE :: LineNo -> String -> ReadE a -> String -> ParseResult a
runE :: Int -> String -> ReadE a -> String -> ParseResult a
runE Int
line String
fieldname ReadE a
p String
s =
case ReadE a -> String -> Either String a
forall a. ReadE a -> String -> Either String a
runReadE ReadE a
p String
s of
Right a
a -> [PWarning] -> a -> ParseResult a
forall a. [PWarning] -> a -> ParseResult a
ParseOk (Int -> String -> String -> [PWarning]
utf8Warnings Int
line String
fieldname String
s) a
a
Left String
e -> Int -> String -> ParseResult a
forall a. Int -> String -> ParseResult a
syntaxError Int
line (String -> ParseResult a) -> String -> ParseResult a
forall a b. (a -> b) -> a -> b
$
String
"Parse of field '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldname String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' failed (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"): " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
utf8Warnings :: LineNo -> String -> String -> [PWarning]
utf8Warnings :: Int -> String -> String -> [PWarning]
utf8Warnings Int
line String
fieldname String
s =
Int -> [PWarning] -> [PWarning]
forall a. Int -> [a] -> [a]
take Int
1 [ Int -> String -> PWarning
UTFWarning Int
n String
fieldname
| (Int
n,String
l) <- [Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
line..] (String -> [String]
lines String
s)
, Char
'\xfffd' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
l ]
locatedErrorMsg :: PError -> (Maybe LineNo, String)
locatedErrorMsg :: PError -> (Maybe Int, String)
locatedErrorMsg (AmbiguousParse String
f Int
n) = (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n,
String
"Ambiguous parse in field '"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
fString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"'.")
locatedErrorMsg (NoParse String
f Int
n) = (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n,
String
"Parse of field '"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
fString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"' failed.")
locatedErrorMsg (TabsError Int
n) = (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n, String
"Tab used as indentation.")
locatedErrorMsg (FromString String
s Maybe Int
n) = (Maybe Int
n, String
s)
syntaxError :: LineNo -> String -> ParseResult a
syntaxError :: Int -> String -> ParseResult a
syntaxError Int
n String
s = PError -> ParseResult a
forall a. PError -> ParseResult a
ParseFailed (PError -> ParseResult a) -> PError -> ParseResult a
forall a b. (a -> b) -> a -> b
$ String -> Maybe Int -> PError
FromString String
s (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n)
warning :: String -> ParseResult ()
warning :: String -> ParseResult ()
warning String
s = [PWarning] -> () -> ParseResult ()
forall a. [PWarning] -> a -> ParseResult a
ParseOk [String -> PWarning
PWarning String
s] ()
data FieldDescr a
= FieldDescr
{ FieldDescr a -> String
fieldName :: String
, FieldDescr a -> a -> Doc
fieldGet :: a -> Doc
, FieldDescr a -> Int -> String -> a -> ParseResult a
fieldSet :: LineNo -> String -> a -> ParseResult a
}
field :: String -> (a -> Doc) -> ReadP a a -> FieldDescr a
field :: String -> (a -> Doc) -> ReadP a a -> FieldDescr a
field String
name a -> Doc
showF ReadP a a
readF =
String
-> (a -> Doc)
-> (Int -> String -> a -> ParseResult a)
-> FieldDescr a
forall a.
String
-> (a -> Doc)
-> (Int -> String -> a -> ParseResult a)
-> FieldDescr a
FieldDescr String
name a -> Doc
showF (\Int
line String
val a
_st -> Int -> String -> ReadP a a -> String -> ParseResult a
forall a. Int -> String -> ReadP a a -> String -> ParseResult a
runP Int
line String
name ReadP a a
readF String
val)
fieldParsec :: String -> (a -> Doc) -> ParsecParser a -> FieldDescr a
fieldParsec :: String -> (a -> Doc) -> ParsecParser a -> FieldDescr a
fieldParsec String
name a -> Doc
showF ParsecParser a
readF =
String
-> (a -> Doc)
-> (Int -> String -> a -> ParseResult a)
-> FieldDescr a
forall a.
String
-> (a -> Doc)
-> (Int -> String -> a -> ParseResult a)
-> FieldDescr a
FieldDescr String
name a -> Doc
showF ((Int -> String -> a -> ParseResult a) -> FieldDescr a)
-> (Int -> String -> a -> ParseResult a) -> FieldDescr a
forall a b. (a -> b) -> a -> b
$ \Int
line String
val a
_st -> case ParsecParser a -> String -> Either String a
forall a. ParsecParser a -> String -> Either String a
explicitEitherParsec ParsecParser a
readF String
val of
Left String
err -> PError -> ParseResult a
forall a. PError -> ParseResult a
ParseFailed (String -> Maybe Int -> PError
FromString String
err (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
line))
Right a
x -> [PWarning] -> a -> ParseResult a
forall a. [PWarning] -> a -> ParseResult a
ParseOk [] a
x
liftField :: (b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
liftField :: (b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
liftField b -> a
get a -> b -> b
set (FieldDescr String
name a -> Doc
showF Int -> String -> a -> ParseResult a
parseF)
= String
-> (b -> Doc)
-> (Int -> String -> b -> ParseResult b)
-> FieldDescr b
forall a.
String
-> (a -> Doc)
-> (Int -> String -> a -> ParseResult a)
-> FieldDescr a
FieldDescr String
name (a -> Doc
showF (a -> Doc) -> (b -> a) -> b -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
get)
(\Int
line String
str b
b -> do
a
a <- Int -> String -> a -> ParseResult a
parseF Int
line String
str (b -> a
get b
b)
b -> ParseResult b
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b -> b
set a
a b
b))
simpleField :: String -> (a -> Doc) -> ReadP a a
-> (b -> a) -> (a -> b -> b) -> FieldDescr b
simpleField :: String
-> (a -> Doc)
-> ReadP a a
-> (b -> a)
-> (a -> b -> b)
-> FieldDescr b
simpleField String
name a -> Doc
showF ReadP a a
readF b -> a
get a -> b -> b
set
= (b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
forall b a.
(b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
liftField b -> a
get a -> b -> b
set (FieldDescr a -> FieldDescr b) -> FieldDescr a -> FieldDescr b
forall a b. (a -> b) -> a -> b
$ String -> (a -> Doc) -> ReadP a a -> FieldDescr a
forall a. String -> (a -> Doc) -> ReadP a a -> FieldDescr a
field String
name a -> Doc
showF ReadP a a
readF
simpleFieldParsec :: String -> (a -> Doc) -> ParsecParser a
-> (b -> a) -> (a -> b -> b) -> FieldDescr b
simpleFieldParsec :: String
-> (a -> Doc)
-> ParsecParser a
-> (b -> a)
-> (a -> b -> b)
-> FieldDescr b
simpleFieldParsec String
name a -> Doc
showF ParsecParser a
readF b -> a
get a -> b -> b
set
= (b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
forall b a.
(b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
liftField b -> a
get a -> b -> b
set (FieldDescr a -> FieldDescr b) -> FieldDescr a -> FieldDescr b
forall a b. (a -> b) -> a -> b
$ String -> (a -> Doc) -> ParsecParser a -> FieldDescr a
forall a. String -> (a -> Doc) -> ParsecParser a -> FieldDescr a
fieldParsec String
name a -> Doc
showF ParsecParser a
readF
commaListFieldWithSepParsec :: Separator -> String -> (a -> Doc) -> ParsecParser a
-> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b
commaListFieldWithSepParsec :: Separator
-> String
-> (a -> Doc)
-> ParsecParser a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
commaListFieldWithSepParsec Separator
separator String
name a -> Doc
showF ParsecParser a
readF b -> [a]
get [a] -> b -> b
set =
(b -> [a]) -> ([a] -> b -> b) -> FieldDescr [a] -> FieldDescr b
forall b a.
(b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
liftField b -> [a]
get [a] -> b -> b
set' (FieldDescr [a] -> FieldDescr b) -> FieldDescr [a] -> FieldDescr b
forall a b. (a -> b) -> a -> b
$
String -> ([a] -> Doc) -> ParsecParser [a] -> FieldDescr [a]
forall a. String -> (a -> Doc) -> ParsecParser a -> FieldDescr a
fieldParsec String
name [a] -> Doc
showF' (ParsecParser a -> ParsecParser [a]
forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
parsecLeadingCommaList ParsecParser a
readF)
where
set' :: [a] -> b -> b
set' [a]
xs b
b = [a] -> b -> b
set (b -> [a]
get b
b [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
xs) b
b
showF' :: [a] -> Doc
showF' = Separator
separator Separator -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([a] -> [Doc]) -> [a] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
showF
commaListFieldParsec :: String -> (a -> Doc) -> ParsecParser a
-> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b
commaListFieldParsec :: String
-> (a -> Doc)
-> ParsecParser a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
commaListFieldParsec = Separator
-> String
-> (a -> Doc)
-> ParsecParser a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
forall a b.
Separator
-> String
-> (a -> Doc)
-> ParsecParser a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
commaListFieldWithSepParsec Separator
fsep
commaNewLineListFieldParsec
:: String -> (a -> Doc) -> ParsecParser a
-> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b
commaNewLineListFieldParsec :: String
-> (a -> Doc)
-> ParsecParser a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
commaNewLineListFieldParsec = Separator
-> String
-> (a -> Doc)
-> ParsecParser a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
forall a b.
Separator
-> String
-> (a -> Doc)
-> ParsecParser a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
commaListFieldWithSepParsec Separator
sep
spaceListField :: String -> (a -> Doc) -> ReadP [a] a
-> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b
spaceListField :: String
-> (a -> Doc)
-> ReadP [a] a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
spaceListField String
name a -> Doc
showF ReadP [a] a
readF b -> [a]
get [a] -> b -> b
set =
(b -> [a]) -> ([a] -> b -> b) -> FieldDescr [a] -> FieldDescr b
forall b a.
(b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
liftField b -> [a]
get [a] -> b -> b
set' (FieldDescr [a] -> FieldDescr b) -> FieldDescr [a] -> FieldDescr b
forall a b. (a -> b) -> a -> b
$
String -> ([a] -> Doc) -> ReadP [a] [a] -> FieldDescr [a]
forall a. String -> (a -> Doc) -> ReadP a a -> FieldDescr a
field String
name [a] -> Doc
showF' (ReadP [a] a -> ReadP [a] [a]
forall r a. ReadP r a -> ReadP r [a]
parseSpaceList ReadP [a] a
readF)
where
set' :: [a] -> b -> b
set' [a]
xs b
b = [a] -> b -> b
set (b -> [a]
get b
b [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
xs) b
b
showF' :: [a] -> Doc
showF' = Separator
fsep Separator -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
showF
newLineListField :: String -> (a -> Doc) -> ReadP [a] a
-> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b
newLineListField :: String
-> (a -> Doc)
-> ReadP [a] a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
newLineListField = Separator
-> String
-> (a -> Doc)
-> ReadP [a] a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
forall a b.
Separator
-> String
-> (a -> Doc)
-> ReadP [a] a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
listFieldWithSep Separator
sep
listFieldWithSep :: Separator -> String -> (a -> Doc) -> ReadP [a] a
-> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b
listFieldWithSep :: Separator
-> String
-> (a -> Doc)
-> ReadP [a] a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
listFieldWithSep Separator
separator String
name a -> Doc
showF ReadP [a] a
readF b -> [a]
get [a] -> b -> b
set =
(b -> [a]) -> ([a] -> b -> b) -> FieldDescr [a] -> FieldDescr b
forall b a.
(b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
liftField b -> [a]
get [a] -> b -> b
set' (FieldDescr [a] -> FieldDescr b) -> FieldDescr [a] -> FieldDescr b
forall a b. (a -> b) -> a -> b
$
String -> ([a] -> Doc) -> ReadP [a] [a] -> FieldDescr [a]
forall a. String -> (a -> Doc) -> ReadP a a -> FieldDescr a
field String
name [a] -> Doc
showF' (ReadP [a] a -> ReadP [a] [a]
forall r a. ReadP r a -> ReadP r [a]
parseOptCommaList ReadP [a] a
readF)
where
set' :: [a] -> b -> b
set' [a]
xs b
b = [a] -> b -> b
set (b -> [a]
get b
b [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
xs) b
b
showF' :: [a] -> Doc
showF' = Separator
separator Separator -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
showF
listFieldWithSepParsec :: Separator -> String -> (a -> Doc) -> ParsecParser a
-> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b
listFieldWithSepParsec :: Separator
-> String
-> (a -> Doc)
-> ParsecParser a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
listFieldWithSepParsec Separator
separator String
name a -> Doc
showF ParsecParser a
readF b -> [a]
get [a] -> b -> b
set =
(b -> [a]) -> ([a] -> b -> b) -> FieldDescr [a] -> FieldDescr b
forall b a.
(b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
liftField b -> [a]
get [a] -> b -> b
set' (FieldDescr [a] -> FieldDescr b) -> FieldDescr [a] -> FieldDescr b
forall a b. (a -> b) -> a -> b
$
String -> ([a] -> Doc) -> ParsecParser [a] -> FieldDescr [a]
forall a. String -> (a -> Doc) -> ParsecParser a -> FieldDescr a
fieldParsec String
name [a] -> Doc
showF' (ParsecParser a -> ParsecParser [a]
forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
parsecLeadingOptCommaList ParsecParser a
readF)
where
set' :: [a] -> b -> b
set' [a]
xs b
b = [a] -> b -> b
set (b -> [a]
get b
b [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
xs) b
b
showF' :: [a] -> Doc
showF' = Separator
separator Separator -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
showF
listField :: String -> (a -> Doc) -> ReadP [a] a
-> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b
listField :: String
-> (a -> Doc)
-> ReadP [a] a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
listField = Separator
-> String
-> (a -> Doc)
-> ReadP [a] a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
forall a b.
Separator
-> String
-> (a -> Doc)
-> ReadP [a] a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
listFieldWithSep Separator
fsep
listFieldParsec
:: String -> (a -> Doc) -> ParsecParser a
-> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b
listFieldParsec :: String
-> (a -> Doc)
-> ParsecParser a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
listFieldParsec = Separator
-> String
-> (a -> Doc)
-> ParsecParser a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
forall a b.
Separator
-> String
-> (a -> Doc)
-> ParsecParser a
-> (b -> [a])
-> ([a] -> b -> b)
-> FieldDescr b
listFieldWithSepParsec Separator
fsep
type UnrecFieldParser a = (String,String) -> a -> Maybe a
data Field
= F LineNo String String
| Section LineNo String String [Field]
deriving (Int -> Field -> ShowS
[Field] -> ShowS
Field -> String
(Int -> Field -> ShowS)
-> (Field -> String) -> ([Field] -> ShowS) -> Show Field
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Field] -> ShowS
$cshowList :: [Field] -> ShowS
show :: Field -> String
$cshow :: Field -> String
showsPrec :: Int -> Field -> ShowS
$cshowsPrec :: Int -> Field -> ShowS
Show
,Field -> Field -> Bool
(Field -> Field -> Bool) -> (Field -> Field -> Bool) -> Eq Field
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Field -> Field -> Bool
$c/= :: Field -> Field -> Bool
== :: Field -> Field -> Bool
$c== :: Field -> Field -> Bool
Eq)
lineNo :: Field -> LineNo
lineNo :: Field -> Int
lineNo (F Int
n String
_ String
_) = Int
n
lineNo (Section Int
n String
_ String
_ [Field]
_) = Int
n
readFields :: BS.ByteString -> ParseResult [Field]
readFields :: ByteString -> ParseResult [Field]
readFields ByteString
input = case ByteString -> Either ParseError ([Field Position], [LexWarning])
Fields.readFields' ByteString
input of
Right ([Field Position]
fs, [LexWarning]
ws) -> [PWarning] -> [Field] -> ParseResult [Field]
forall a. [PWarning] -> a -> ParseResult a
ParseOk
[ String -> PWarning
PWarning String
msg | Fields.PWarning PWarnType
_ Position
_ String
msg <- [LexWarning] -> [PWarning]
Fields.toPWarnings [LexWarning]
ws ]
([Field Position] -> [Field]
legacyFields [Field Position]
fs)
Left ParseError
perr -> PError -> ParseResult [Field]
forall a. PError -> ParseResult a
ParseFailed (PError -> ParseResult [Field]) -> PError -> ParseResult [Field]
forall a b. (a -> b) -> a -> b
$ String -> Int -> PError
NoParse
(String
-> String -> String -> String -> String -> [Message] -> String
PE.showErrorMessages
String
"or" String
"unknown parse error" String
"expecting" String
"unexpected" String
"end of file"
(ParseError -> [Message]
PE.errorMessages ParseError
perr))
(SourcePos -> Int
PP.sourceLine SourcePos
pos)
where
pos :: SourcePos
pos = ParseError -> SourcePos
PE.errorPos ParseError
perr
legacyFields :: [Fields.Field Parsec.Position] -> [Field]
legacyFields :: [Field Position] -> [Field]
legacyFields = (Field Position -> Field) -> [Field Position] -> [Field]
forall a b. (a -> b) -> [a] -> [b]
map Field Position -> Field
legacyField
legacyField :: Fields.Field Parsec.Position -> Field
legacyField :: Field Position -> Field
legacyField (Fields.Field (Fields.Name Position
pos ByteString
name) [FieldLine Position]
fls) =
Int -> String -> String -> Field
F (Position -> Int
posToLineNo Position
pos) (ByteString -> String
fromUTF8BS ByteString
name) ([FieldLine Position] -> String
forall ann. [FieldLine ann] -> String
Fields.fieldLinesToString [FieldLine Position]
fls)
legacyField (Fields.Section (Fields.Name Position
pos ByteString
name) [SectionArg Position]
args [Field Position]
fs) =
Int -> String -> String -> [Field] -> Field
Section (Position -> Int
posToLineNo Position
pos) (ByteString -> String
fromUTF8BS ByteString
name) ([SectionArg Position] -> String
forall ann. [SectionArg ann] -> String
Fields.sectionArgsToString [SectionArg Position]
args) ([Field Position] -> [Field]
legacyFields [Field Position]
fs)
posToLineNo :: Parsec.Position -> LineNo
posToLineNo :: Position -> Int
posToLineNo (Parsec.Position Int
row Int
_) = Int
row
parseHaskellString :: ReadP r String
parseHaskellString :: ReadP r String
parseHaskellString =
ReadS String -> ReadP r String
forall a r. ReadS a -> ReadP r a
readS_to_P (ReadS String -> ReadP r String) -> ReadS String -> ReadP r String
forall a b. (a -> b) -> a -> b
$
ReadPrec String -> Int -> ReadS String
forall a. ReadPrec a -> Int -> ReadS a
Read.readPrec_to_S (do Read.String String
s <- ReadPrec Lexeme
Read.lexP; String -> ReadPrec String
forall (m :: * -> *) a. Monad m => a -> m a
return String
s) Int
0
parseTokenQ :: ReadP r String
parseTokenQ :: ReadP r String
parseTokenQ = ReadP String String
forall r. ReadP r String
parseHaskellString ReadP String String -> ReadP r String -> ReadP r String
forall a r. ReadP a a -> ReadP r a -> ReadP r a
<++ (Char -> Bool) -> ReadP r String
forall r. (Char -> Bool) -> ReadP r String
munch1 (\Char
x -> Bool -> Bool
not (Char -> Bool
isSpace Char
x) Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
',')
parseSpaceList :: ReadP r a
-> ReadP r [a]
parseSpaceList :: ReadP r a -> ReadP r [a]
parseSpaceList ReadP r a
p = ReadP r a -> ReadP r () -> ReadP r [a]
forall r a sep. ReadP r a -> ReadP r sep -> ReadP r [a]
sepBy ReadP r a
p ReadP r ()
forall r. ReadP r ()
skipSpaces
parseOptCommaList :: ReadP r a -> ReadP r [a]
parseOptCommaList :: ReadP r a -> ReadP r [a]
parseOptCommaList ReadP r a
p = ReadP r a -> ReadP r () -> ReadP r [a]
forall r a sep. ReadP r a -> ReadP r sep -> ReadP r [a]
sepBy ReadP r a
p ReadP r ()
forall r. ReadP r ()
localSep
where
localSep :: ReadP r ()
localSep = (ReadP r ()
forall r. ReadP r ()
skipSpaces ReadP r () -> Parser r Char Char -> Parser r Char Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Parser r Char Char
forall r. Char -> ReadP r Char
char Char
',' Parser r Char Char -> ReadP r () -> ReadP r ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP r ()
forall r. ReadP r ()
skipSpaces)
ReadP r () -> ReadP r () -> ReadP r ()
forall r a. ReadP r a -> ReadP r a -> ReadP r a
+++ ((Char -> Bool) -> Parser r Char Char
forall r. (Char -> Bool) -> ReadP r Char
satisfy Char -> Bool
isSpace Parser r Char Char -> ReadP r () -> ReadP r ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP r ()
forall r. ReadP r ()
skipSpaces)
readPToMaybe :: ReadP a a -> String -> Maybe a
readPToMaybe :: ReadP a a -> String -> Maybe a
readPToMaybe ReadP a a
p String
str = [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe [ a
r | (a
r,String
s) <- ReadP a a -> ReadS a
forall a. ReadP a a -> ReadS a
readP_to_S ReadP a a
p String
str
, (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace String
s ]