{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | This module provides a 'FieldGrammarParser', one way to parse
-- @.cabal@ -like files.
--
-- Fields can be specified multiple times in the .cabal files.  The order of
-- such entries is important, but the mutual ordering of different fields is
-- not.Also conditional sections are considered after non-conditional data.
-- The example of this silent-commutation quirk is the fact that
--
-- @
-- buildable: True
-- if os(linux)
--   buildable: False
-- @
--
-- and
--
-- @
-- if os(linux)
--   buildable: False
-- buildable: True
-- @
--
-- behave the same! This is the limitation of 'GeneralPackageDescription'
-- structure.
--
-- So we transform the list of fields @['Field' ann]@ into
-- a map of grouped ordinary fields and a list of lists of sections:
-- @'Fields' ann = 'Map' 'FieldName' ['NamelessField' ann]@ and @[['Section' ann]]@.
--
-- We need list of list of sections, because we need to distinguish situations
-- where there are fields in between. For example
--
-- @
-- if flag(bytestring-lt-0_10_4)
--   build-depends: bytestring < 0.10.4
--
-- default-language: Haskell2020
--
-- else
--   build-depends: bytestring >= 0.10.4
--
-- @
--
-- is obviously invalid specification.
--
-- We can parse 'Fields' like we parse @aeson@ objects, yet we use
-- slightly higher-level API, so we can process unspecified fields,
-- to report unknown fields and save custom @x-fields@.
module Distribution.FieldGrammar.Parsec
  ( ParsecFieldGrammar
  , parseFieldGrammar
  , fieldGrammarKnownFieldList

    -- * Auxiliary
  , Fields
  , NamelessField (..)
  , namelessFieldAnn
  , Section (..)
  , runFieldParser
  , runFieldParser'
  , fieldLinesToStream
  ) where

import Distribution.Compat.Newtype
import Distribution.Compat.Prelude
import Distribution.Utils.Generic (fromUTF8BS)
import Distribution.Utils.String (trim)
import Prelude ()

import qualified Data.ByteString as BS
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Distribution.Utils.ShortText as ShortText
import qualified Text.Parsec as P
import qualified Text.Parsec.Error as P

import Distribution.CabalSpecVersion
import Distribution.FieldGrammar.Class
import Distribution.Fields.Field
import Distribution.Fields.ParseResult
import Distribution.Parsec
import Distribution.Parsec.FieldLineStream
import Distribution.Parsec.Position (positionCol, positionRow)

-------------------------------------------------------------------------------
-- Auxiliary types
-------------------------------------------------------------------------------

type Fields ann = Map FieldName [NamelessField ann]

-- | Single field, without name, but with its annotation.
data NamelessField ann = MkNamelessField !ann [FieldLine ann]
  deriving (NamelessField ann -> NamelessField ann -> Bool
(NamelessField ann -> NamelessField ann -> Bool)
-> (NamelessField ann -> NamelessField ann -> Bool)
-> Eq (NamelessField ann)
forall ann.
Eq ann =>
NamelessField ann -> NamelessField ann -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall ann.
Eq ann =>
NamelessField ann -> NamelessField ann -> Bool
== :: NamelessField ann -> NamelessField ann -> Bool
$c/= :: forall ann.
Eq ann =>
NamelessField ann -> NamelessField ann -> Bool
/= :: NamelessField ann -> NamelessField ann -> Bool
Eq, Int -> NamelessField ann -> ShowS
[NamelessField ann] -> ShowS
NamelessField ann -> [Char]
(Int -> NamelessField ann -> ShowS)
-> (NamelessField ann -> [Char])
-> ([NamelessField ann] -> ShowS)
-> Show (NamelessField ann)
forall ann. Show ann => Int -> NamelessField ann -> ShowS
forall ann. Show ann => [NamelessField ann] -> ShowS
forall ann. Show ann => NamelessField ann -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall ann. Show ann => Int -> NamelessField ann -> ShowS
showsPrec :: Int -> NamelessField ann -> ShowS
$cshow :: forall ann. Show ann => NamelessField ann -> [Char]
show :: NamelessField ann -> [Char]
$cshowList :: forall ann. Show ann => [NamelessField ann] -> ShowS
showList :: [NamelessField ann] -> ShowS
Show, (forall a b. (a -> b) -> NamelessField a -> NamelessField b)
-> (forall a b. a -> NamelessField b -> NamelessField a)
-> Functor NamelessField
forall a b. a -> NamelessField b -> NamelessField a
forall a b. (a -> b) -> NamelessField a -> NamelessField b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> NamelessField a -> NamelessField b
fmap :: forall a b. (a -> b) -> NamelessField a -> NamelessField b
$c<$ :: forall a b. a -> NamelessField b -> NamelessField a
<$ :: forall a b. a -> NamelessField b -> NamelessField a
Functor)

namelessFieldAnn :: NamelessField ann -> ann
namelessFieldAnn :: forall ann. NamelessField ann -> ann
namelessFieldAnn (MkNamelessField ann
ann [FieldLine ann]
_) = ann
ann

-- | The 'Section' constructor of 'Field'.
data Section ann = MkSection !(Name ann) [SectionArg ann] [Field ann]
  deriving (Section ann -> Section ann -> Bool
(Section ann -> Section ann -> Bool)
-> (Section ann -> Section ann -> Bool) -> Eq (Section ann)
forall ann. Eq ann => Section ann -> Section ann -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall ann. Eq ann => Section ann -> Section ann -> Bool
== :: Section ann -> Section ann -> Bool
$c/= :: forall ann. Eq ann => Section ann -> Section ann -> Bool
/= :: Section ann -> Section ann -> Bool
Eq, Int -> Section ann -> ShowS
[Section ann] -> ShowS
Section ann -> [Char]
(Int -> Section ann -> ShowS)
-> (Section ann -> [Char])
-> ([Section ann] -> ShowS)
-> Show (Section ann)
forall ann. Show ann => Int -> Section ann -> ShowS
forall ann. Show ann => [Section ann] -> ShowS
forall ann. Show ann => Section ann -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall ann. Show ann => Int -> Section ann -> ShowS
showsPrec :: Int -> Section ann -> ShowS
$cshow :: forall ann. Show ann => Section ann -> [Char]
show :: Section ann -> [Char]
$cshowList :: forall ann. Show ann => [Section ann] -> ShowS
showList :: [Section ann] -> ShowS
Show, (forall a b. (a -> b) -> Section a -> Section b)
-> (forall a b. a -> Section b -> Section a) -> Functor Section
forall a b. a -> Section b -> Section a
forall a b. (a -> b) -> Section a -> Section b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Section a -> Section b
fmap :: forall a b. (a -> b) -> Section a -> Section b
$c<$ :: forall a b. a -> Section b -> Section a
<$ :: forall a b. a -> Section b -> Section a
Functor)

-------------------------------------------------------------------------------
-- ParsecFieldGrammar
-------------------------------------------------------------------------------

data ParsecFieldGrammar s a = ParsecFG
  { forall s a. ParsecFieldGrammar s a -> Set ByteString
fieldGrammarKnownFields :: !(Set FieldName)
  , forall s a. ParsecFieldGrammar s a -> Set ByteString
fieldGrammarKnownPrefixes :: !(Set FieldName)
  , forall s a.
ParsecFieldGrammar s a
-> CabalSpecVersion -> Fields Position -> ParseResult a
fieldGrammarParser :: !(CabalSpecVersion -> Fields Position -> ParseResult a)
  }
  deriving ((forall a b.
 (a -> b) -> ParsecFieldGrammar s a -> ParsecFieldGrammar s b)
-> (forall a b.
    a -> ParsecFieldGrammar s b -> ParsecFieldGrammar s a)
-> Functor (ParsecFieldGrammar s)
forall a b. a -> ParsecFieldGrammar s b -> ParsecFieldGrammar s a
forall a b.
(a -> b) -> ParsecFieldGrammar s a -> ParsecFieldGrammar s b
forall s a b. a -> ParsecFieldGrammar s b -> ParsecFieldGrammar s a
forall s a b.
(a -> b) -> ParsecFieldGrammar s a -> ParsecFieldGrammar s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall s a b.
(a -> b) -> ParsecFieldGrammar s a -> ParsecFieldGrammar s b
fmap :: forall a b.
(a -> b) -> ParsecFieldGrammar s a -> ParsecFieldGrammar s b
$c<$ :: forall s a b. a -> ParsecFieldGrammar s b -> ParsecFieldGrammar s a
<$ :: forall a b. a -> ParsecFieldGrammar s b -> ParsecFieldGrammar s a
Functor)

parseFieldGrammar :: CabalSpecVersion -> Fields Position -> ParsecFieldGrammar s a -> ParseResult a
parseFieldGrammar :: forall s a.
CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar s a -> ParseResult a
parseFieldGrammar CabalSpecVersion
v Fields Position
fields ParsecFieldGrammar s a
grammar = do
  [(ByteString, [NamelessField Position])]
-> ((ByteString, [NamelessField Position]) -> ParseResult ())
-> ParseResult ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Fields Position -> [(ByteString, [NamelessField Position])]
forall k a. Map k a -> [(k, a)]
Map.toList ((ByteString -> [NamelessField Position] -> Bool)
-> Fields Position -> Fields Position
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey ByteString -> [NamelessField Position] -> Bool
forall {p}. ByteString -> p -> Bool
isUnknownField Fields Position
fields)) (((ByteString, [NamelessField Position]) -> ParseResult ())
 -> ParseResult ())
-> ((ByteString, [NamelessField Position]) -> ParseResult ())
-> ParseResult ()
forall a b. (a -> b) -> a -> b
$ \(ByteString
name, [NamelessField Position]
nfields) ->
    [NamelessField Position]
-> (NamelessField Position -> ParseResult ()) -> ParseResult ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [NamelessField Position]
nfields ((NamelessField Position -> ParseResult ()) -> ParseResult ())
-> (NamelessField Position -> ParseResult ()) -> ParseResult ()
forall a b. (a -> b) -> a -> b
$ \(MkNamelessField Position
pos [FieldLine Position]
_) ->
      Position -> PWarnType -> [Char] -> ParseResult ()
parseWarning Position
pos PWarnType
PWTUnknownField ([Char] -> ParseResult ()) -> [Char] -> ParseResult ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Unknown field: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
name
  -- TODO: fields allowed in this section

  -- parse
  ParsecFieldGrammar s a
-> CabalSpecVersion -> Fields Position -> ParseResult a
forall s a.
ParsecFieldGrammar s a
-> CabalSpecVersion -> Fields Position -> ParseResult a
fieldGrammarParser ParsecFieldGrammar s a
grammar CabalSpecVersion
v Fields Position
fields
  where
    isUnknownField :: ByteString -> p -> Bool
isUnknownField ByteString
k p
_ =
      Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
        ByteString
k ByteString -> Set ByteString -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` ParsecFieldGrammar s a -> Set ByteString
forall s a. ParsecFieldGrammar s a -> Set ByteString
fieldGrammarKnownFields ParsecFieldGrammar s a
grammar
          Bool -> Bool -> Bool
|| (ByteString -> Bool) -> Set ByteString -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ByteString -> ByteString -> Bool
`BS.isPrefixOf` ByteString
k) (ParsecFieldGrammar s a -> Set ByteString
forall s a. ParsecFieldGrammar s a -> Set ByteString
fieldGrammarKnownPrefixes ParsecFieldGrammar s a
grammar)

fieldGrammarKnownFieldList :: ParsecFieldGrammar s a -> [FieldName]
fieldGrammarKnownFieldList :: forall s a. ParsecFieldGrammar s a -> [ByteString]
fieldGrammarKnownFieldList = Set ByteString -> [ByteString]
forall a. Set a -> [a]
Set.toList (Set ByteString -> [ByteString])
-> (ParsecFieldGrammar s a -> Set ByteString)
-> ParsecFieldGrammar s a
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecFieldGrammar s a -> Set ByteString
forall s a. ParsecFieldGrammar s a -> Set ByteString
fieldGrammarKnownFields

instance Applicative (ParsecFieldGrammar s) where
  pure :: forall a. a -> ParsecFieldGrammar s a
pure a
x = Set ByteString
-> Set ByteString
-> (CabalSpecVersion -> Fields Position -> ParseResult a)
-> ParsecFieldGrammar s a
forall s a.
Set ByteString
-> Set ByteString
-> (CabalSpecVersion -> Fields Position -> ParseResult a)
-> ParsecFieldGrammar s a
ParsecFG Set ByteString
forall a. Monoid a => a
mempty Set ByteString
forall a. Monoid a => a
mempty (\CabalSpecVersion
_ Fields Position
_ -> a -> ParseResult a
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
  {-# INLINE pure #-}

  ParsecFG Set ByteString
f Set ByteString
f' CabalSpecVersion -> Fields Position -> ParseResult (a -> b)
f'' <*> :: forall a b.
ParsecFieldGrammar s (a -> b)
-> ParsecFieldGrammar s a -> ParsecFieldGrammar s b
<*> ParsecFG Set ByteString
x Set ByteString
x' CabalSpecVersion -> Fields Position -> ParseResult a
x'' =
    Set ByteString
-> Set ByteString
-> (CabalSpecVersion -> Fields Position -> ParseResult b)
-> ParsecFieldGrammar s b
forall s a.
Set ByteString
-> Set ByteString
-> (CabalSpecVersion -> Fields Position -> ParseResult a)
-> ParsecFieldGrammar s a
ParsecFG
      (Set ByteString -> Set ByteString -> Set ByteString
forall a. Monoid a => a -> a -> a
mappend Set ByteString
f Set ByteString
x)
      (Set ByteString -> Set ByteString -> Set ByteString
forall a. Monoid a => a -> a -> a
mappend Set ByteString
f' Set ByteString
x')
      (\CabalSpecVersion
v Fields Position
fields -> CabalSpecVersion -> Fields Position -> ParseResult (a -> b)
f'' CabalSpecVersion
v Fields Position
fields ParseResult (a -> b) -> ParseResult a -> ParseResult b
forall a b. ParseResult (a -> b) -> ParseResult a -> ParseResult b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CabalSpecVersion -> Fields Position -> ParseResult a
x'' CabalSpecVersion
v Fields Position
fields)
  {-# INLINE (<*>) #-}

warnMultipleSingularFields :: FieldName -> [NamelessField Position] -> ParseResult ()
warnMultipleSingularFields :: ByteString -> [NamelessField Position] -> ParseResult ()
warnMultipleSingularFields ByteString
_ [] = () -> ParseResult ()
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
warnMultipleSingularFields ByteString
fn (NamelessField Position
x : [NamelessField Position]
xs) = do
  let pos :: Position
pos = NamelessField Position -> Position
forall ann. NamelessField ann -> ann
namelessFieldAnn NamelessField Position
x
      poss :: [Position]
poss = (NamelessField Position -> Position)
-> [NamelessField Position] -> [Position]
forall a b. (a -> b) -> [a] -> [b]
map NamelessField Position -> Position
forall ann. NamelessField ann -> ann
namelessFieldAnn [NamelessField Position]
xs
  Position -> PWarnType -> [Char] -> ParseResult ()
parseWarning Position
pos PWarnType
PWTMultipleSingularField ([Char] -> ParseResult ()) -> [Char] -> ParseResult ()
forall a b. (a -> b) -> a -> b
$
    [Char]
"The field " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
fn [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" is specified more than once at positions " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " ((Position -> [Char]) -> [Position] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Position -> [Char]
showPos (Position
pos Position -> [Position] -> [Position]
forall a. a -> [a] -> [a]
: [Position]
poss))

instance FieldGrammar Parsec ParsecFieldGrammar where
  blurFieldGrammar :: forall a b d.
ALens' a b -> ParsecFieldGrammar b d -> ParsecFieldGrammar a d
blurFieldGrammar ALens' a b
_ (ParsecFG Set ByteString
s Set ByteString
s' CabalSpecVersion -> Fields Position -> ParseResult d
parser) = Set ByteString
-> Set ByteString
-> (CabalSpecVersion -> Fields Position -> ParseResult d)
-> ParsecFieldGrammar a d
forall s a.
Set ByteString
-> Set ByteString
-> (CabalSpecVersion -> Fields Position -> ParseResult a)
-> ParsecFieldGrammar s a
ParsecFG Set ByteString
s Set ByteString
s' CabalSpecVersion -> Fields Position -> ParseResult d
parser

  uniqueFieldAla :: forall b a s.
(Parsec b, Newtype a b) =>
ByteString -> (a -> b) -> ALens' s a -> ParsecFieldGrammar s a
uniqueFieldAla ByteString
fn a -> b
_pack ALens' s a
_extract = Set ByteString
-> Set ByteString
-> (CabalSpecVersion -> Fields Position -> ParseResult a)
-> ParsecFieldGrammar s a
forall s a.
Set ByteString
-> Set ByteString
-> (CabalSpecVersion -> Fields Position -> ParseResult a)
-> ParsecFieldGrammar s a
ParsecFG (ByteString -> Set ByteString
forall a. a -> Set a
Set.singleton ByteString
fn) Set ByteString
forall a. Set a
Set.empty CabalSpecVersion -> Fields Position -> ParseResult a
parser
    where
      parser :: CabalSpecVersion -> Fields Position -> ParseResult a
parser CabalSpecVersion
v Fields Position
fields = case ByteString -> Fields Position -> Maybe [NamelessField Position]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
fn Fields Position
fields of
        Maybe [NamelessField Position]
Nothing -> Position -> [Char] -> ParseResult a
forall a. Position -> [Char] -> ParseResult a
parseFatalFailure Position
zeroPos ([Char] -> ParseResult a) -> [Char] -> ParseResult a
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
fn [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" field missing"
        Just [] -> Position -> [Char] -> ParseResult a
forall a. Position -> [Char] -> ParseResult a
parseFatalFailure Position
zeroPos ([Char] -> ParseResult a) -> [Char] -> ParseResult a
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
fn [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" field missing"
        Just [NamelessField Position
x] -> CabalSpecVersion -> NamelessField Position -> ParseResult a
parseOne CabalSpecVersion
v NamelessField Position
x
        Just xs :: [NamelessField Position]
xs@(NamelessField Position
_ : NamelessField Position
y : [NamelessField Position]
ys) -> do
          ByteString -> [NamelessField Position] -> ParseResult ()
warnMultipleSingularFields ByteString
fn [NamelessField Position]
xs
          NonEmpty a -> a
forall a. NonEmpty a -> a
NE.last (NonEmpty a -> a) -> ParseResult (NonEmpty a) -> ParseResult a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NamelessField Position -> ParseResult a)
-> NonEmpty (NamelessField Position) -> ParseResult (NonEmpty a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
traverse (CabalSpecVersion -> NamelessField Position -> ParseResult a
parseOne CabalSpecVersion
v) (NamelessField Position
y NamelessField Position
-> [NamelessField Position] -> NonEmpty (NamelessField Position)
forall a. a -> [a] -> NonEmpty a
:| [NamelessField Position]
ys)

      parseOne :: CabalSpecVersion -> NamelessField Position -> ParseResult a
parseOne CabalSpecVersion
v (MkNamelessField Position
pos [FieldLine Position]
fls) =
        (a -> b) -> b -> a
forall o n. Newtype o n => (o -> n) -> n -> o
unpack' a -> b
_pack (b -> a) -> ParseResult b -> ParseResult a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Position
-> ParsecParser b
-> CabalSpecVersion
-> [FieldLine Position]
-> ParseResult b
forall a.
Position
-> ParsecParser a
-> CabalSpecVersion
-> [FieldLine Position]
-> ParseResult a
runFieldParser Position
pos ParsecParser b
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m b
parsec CabalSpecVersion
v [FieldLine Position]
fls

  booleanFieldDef :: forall s.
ByteString -> ALens' s Bool -> Bool -> ParsecFieldGrammar s Bool
booleanFieldDef ByteString
fn ALens' s Bool
_extract Bool
def = Set ByteString
-> Set ByteString
-> (CabalSpecVersion -> Fields Position -> ParseResult Bool)
-> ParsecFieldGrammar s Bool
forall s a.
Set ByteString
-> Set ByteString
-> (CabalSpecVersion -> Fields Position -> ParseResult a)
-> ParsecFieldGrammar s a
ParsecFG (ByteString -> Set ByteString
forall a. a -> Set a
Set.singleton ByteString
fn) Set ByteString
forall a. Set a
Set.empty CabalSpecVersion -> Fields Position -> ParseResult Bool
parser
    where
      parser :: CabalSpecVersion -> Fields Position -> ParseResult Bool
parser CabalSpecVersion
v Fields Position
fields = case ByteString -> Fields Position -> Maybe [NamelessField Position]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
fn Fields Position
fields of
        Maybe [NamelessField Position]
Nothing -> Bool -> ParseResult Bool
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
def
        Just [] -> Bool -> ParseResult Bool
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
def
        Just [NamelessField Position
x] -> CabalSpecVersion -> NamelessField Position -> ParseResult Bool
forall {a}.
Parsec a =>
CabalSpecVersion -> NamelessField Position -> ParseResult a
parseOne CabalSpecVersion
v NamelessField Position
x
        Just xs :: [NamelessField Position]
xs@(NamelessField Position
_ : NamelessField Position
y : [NamelessField Position]
ys) -> do
          ByteString -> [NamelessField Position] -> ParseResult ()
warnMultipleSingularFields ByteString
fn [NamelessField Position]
xs
          NonEmpty Bool -> Bool
forall a. NonEmpty a -> a
NE.last (NonEmpty Bool -> Bool)
-> ParseResult (NonEmpty Bool) -> ParseResult Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NamelessField Position -> ParseResult Bool)
-> NonEmpty (NamelessField Position) -> ParseResult (NonEmpty Bool)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
traverse (CabalSpecVersion -> NamelessField Position -> ParseResult Bool
forall {a}.
Parsec a =>
CabalSpecVersion -> NamelessField Position -> ParseResult a
parseOne CabalSpecVersion
v) (NamelessField Position
y NamelessField Position
-> [NamelessField Position] -> NonEmpty (NamelessField Position)
forall a. a -> [a] -> NonEmpty a
:| [NamelessField Position]
ys)

      parseOne :: CabalSpecVersion -> NamelessField Position -> ParseResult a
parseOne CabalSpecVersion
v (MkNamelessField Position
pos [FieldLine Position]
fls) = Position
-> ParsecParser a
-> CabalSpecVersion
-> [FieldLine Position]
-> ParseResult a
forall a.
Position
-> ParsecParser a
-> CabalSpecVersion
-> [FieldLine Position]
-> ParseResult a
runFieldParser Position
pos ParsecParser a
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m a
parsec CabalSpecVersion
v [FieldLine Position]
fls

  optionalFieldAla :: forall b a s.
(Parsec b, Newtype a b) =>
ByteString
-> (a -> b) -> ALens' s (Maybe a) -> ParsecFieldGrammar s (Maybe a)
optionalFieldAla ByteString
fn a -> b
_pack ALens' s (Maybe a)
_extract = Set ByteString
-> Set ByteString
-> (CabalSpecVersion -> Fields Position -> ParseResult (Maybe a))
-> ParsecFieldGrammar s (Maybe a)
forall s a.
Set ByteString
-> Set ByteString
-> (CabalSpecVersion -> Fields Position -> ParseResult a)
-> ParsecFieldGrammar s a
ParsecFG (ByteString -> Set ByteString
forall a. a -> Set a
Set.singleton ByteString
fn) Set ByteString
forall a. Set a
Set.empty CabalSpecVersion -> Fields Position -> ParseResult (Maybe a)
parser
    where
      parser :: CabalSpecVersion -> Fields Position -> ParseResult (Maybe a)
parser CabalSpecVersion
v Fields Position
fields = case ByteString -> Fields Position -> Maybe [NamelessField Position]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
fn Fields Position
fields of
        Maybe [NamelessField Position]
Nothing -> Maybe a -> ParseResult (Maybe a)
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
        Just [] -> Maybe a -> ParseResult (Maybe a)
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
        Just [NamelessField Position
x] -> CabalSpecVersion -> NamelessField Position -> ParseResult (Maybe a)
parseOne CabalSpecVersion
v NamelessField Position
x
        Just xs :: [NamelessField Position]
xs@(NamelessField Position
_ : NamelessField Position
y : [NamelessField Position]
ys) -> do
          ByteString -> [NamelessField Position] -> ParseResult ()
warnMultipleSingularFields ByteString
fn [NamelessField Position]
xs
          NonEmpty (Maybe a) -> Maybe a
forall a. NonEmpty a -> a
NE.last (NonEmpty (Maybe a) -> Maybe a)
-> ParseResult (NonEmpty (Maybe a)) -> ParseResult (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NamelessField Position -> ParseResult (Maybe a))
-> NonEmpty (NamelessField Position)
-> ParseResult (NonEmpty (Maybe a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
traverse (CabalSpecVersion -> NamelessField Position -> ParseResult (Maybe a)
parseOne CabalSpecVersion
v) (NamelessField Position
y NamelessField Position
-> [NamelessField Position] -> NonEmpty (NamelessField Position)
forall a. a -> [a] -> NonEmpty a
:| [NamelessField Position]
ys)

      parseOne :: CabalSpecVersion -> NamelessField Position -> ParseResult (Maybe a)
parseOne CabalSpecVersion
v (MkNamelessField Position
pos [FieldLine Position]
fls)
        | [FieldLine Position] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FieldLine Position]
fls = Maybe a -> ParseResult (Maybe a)
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
        | Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (b -> a) -> b -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> b -> a
forall o n. Newtype o n => (o -> n) -> n -> o
unpack' a -> b
_pack (b -> Maybe a) -> ParseResult b -> ParseResult (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Position
-> ParsecParser b
-> CabalSpecVersion
-> [FieldLine Position]
-> ParseResult b
forall a.
Position
-> ParsecParser a
-> CabalSpecVersion
-> [FieldLine Position]
-> ParseResult a
runFieldParser Position
pos ParsecParser b
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m b
parsec CabalSpecVersion
v [FieldLine Position]
fls

  optionalFieldDefAla :: forall b a s.
(Parsec b, Newtype a b, Eq a) =>
ByteString -> (a -> b) -> ALens' s a -> a -> ParsecFieldGrammar s a
optionalFieldDefAla ByteString
fn a -> b
_pack ALens' s a
_extract a
def = Set ByteString
-> Set ByteString
-> (CabalSpecVersion -> Fields Position -> ParseResult a)
-> ParsecFieldGrammar s a
forall s a.
Set ByteString
-> Set ByteString
-> (CabalSpecVersion -> Fields Position -> ParseResult a)
-> ParsecFieldGrammar s a
ParsecFG (ByteString -> Set ByteString
forall a. a -> Set a
Set.singleton ByteString
fn) Set ByteString
forall a. Set a
Set.empty CabalSpecVersion -> Fields Position -> ParseResult a
parser
    where
      parser :: CabalSpecVersion -> Fields Position -> ParseResult a
parser CabalSpecVersion
v Fields Position
fields = case ByteString -> Fields Position -> Maybe [NamelessField Position]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
fn Fields Position
fields of
        Maybe [NamelessField Position]
Nothing -> a -> ParseResult a
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
def
        Just [] -> a -> ParseResult a
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
def
        Just [NamelessField Position
x] -> CabalSpecVersion -> NamelessField Position -> ParseResult a
parseOne CabalSpecVersion
v NamelessField Position
x
        Just xs :: [NamelessField Position]
xs@(NamelessField Position
_ : NamelessField Position
y : [NamelessField Position]
ys) -> do
          ByteString -> [NamelessField Position] -> ParseResult ()
warnMultipleSingularFields ByteString
fn [NamelessField Position]
xs
          NonEmpty a -> a
forall a. NonEmpty a -> a
NE.last (NonEmpty a -> a) -> ParseResult (NonEmpty a) -> ParseResult a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NamelessField Position -> ParseResult a)
-> NonEmpty (NamelessField Position) -> ParseResult (NonEmpty a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
traverse (CabalSpecVersion -> NamelessField Position -> ParseResult a
parseOne CabalSpecVersion
v) (NamelessField Position
y NamelessField Position
-> [NamelessField Position] -> NonEmpty (NamelessField Position)
forall a. a -> [a] -> NonEmpty a
:| [NamelessField Position]
ys)

      parseOne :: CabalSpecVersion -> NamelessField Position -> ParseResult a
parseOne CabalSpecVersion
v (MkNamelessField Position
pos [FieldLine Position]
fls)
        | [FieldLine Position] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FieldLine Position]
fls = a -> ParseResult a
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
def
        | Bool
otherwise = (a -> b) -> b -> a
forall o n. Newtype o n => (o -> n) -> n -> o
unpack' a -> b
_pack (b -> a) -> ParseResult b -> ParseResult a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Position
-> ParsecParser b
-> CabalSpecVersion
-> [FieldLine Position]
-> ParseResult b
forall a.
Position
-> ParsecParser a
-> CabalSpecVersion
-> [FieldLine Position]
-> ParseResult a
runFieldParser Position
pos ParsecParser b
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m b
parsec CabalSpecVersion
v [FieldLine Position]
fls

  freeTextField :: forall s.
ByteString
-> ALens' s (Maybe [Char]) -> ParsecFieldGrammar s (Maybe [Char])
freeTextField ByteString
fn ALens' s (Maybe [Char])
_ = Set ByteString
-> Set ByteString
-> (CabalSpecVersion
    -> Fields Position -> ParseResult (Maybe [Char]))
-> ParsecFieldGrammar s (Maybe [Char])
forall s a.
Set ByteString
-> Set ByteString
-> (CabalSpecVersion -> Fields Position -> ParseResult a)
-> ParsecFieldGrammar s a
ParsecFG (ByteString -> Set ByteString
forall a. a -> Set a
Set.singleton ByteString
fn) Set ByteString
forall a. Set a
Set.empty CabalSpecVersion -> Fields Position -> ParseResult (Maybe [Char])
parser
    where
      parser :: CabalSpecVersion -> Fields Position -> ParseResult (Maybe [Char])
parser CabalSpecVersion
v Fields Position
fields = case ByteString -> Fields Position -> Maybe [NamelessField Position]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
fn Fields Position
fields of
        Maybe [NamelessField Position]
Nothing -> Maybe [Char] -> ParseResult (Maybe [Char])
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [Char]
forall a. Maybe a
Nothing
        Just [] -> Maybe [Char] -> ParseResult (Maybe [Char])
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [Char]
forall a. Maybe a
Nothing
        Just [NamelessField Position
x] -> CabalSpecVersion
-> NamelessField Position -> ParseResult (Maybe [Char])
forall {f :: * -> *}.
Applicative f =>
CabalSpecVersion -> NamelessField Position -> f (Maybe [Char])
parseOne CabalSpecVersion
v NamelessField Position
x
        Just xs :: [NamelessField Position]
xs@(NamelessField Position
_ : NamelessField Position
y : [NamelessField Position]
ys) -> do
          ByteString -> [NamelessField Position] -> ParseResult ()
warnMultipleSingularFields ByteString
fn [NamelessField Position]
xs
          NonEmpty (Maybe [Char]) -> Maybe [Char]
forall a. NonEmpty a -> a
NE.last (NonEmpty (Maybe [Char]) -> Maybe [Char])
-> ParseResult (NonEmpty (Maybe [Char]))
-> ParseResult (Maybe [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NamelessField Position -> ParseResult (Maybe [Char]))
-> NonEmpty (NamelessField Position)
-> ParseResult (NonEmpty (Maybe [Char]))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
traverse (CabalSpecVersion
-> NamelessField Position -> ParseResult (Maybe [Char])
forall {f :: * -> *}.
Applicative f =>
CabalSpecVersion -> NamelessField Position -> f (Maybe [Char])
parseOne CabalSpecVersion
v) (NamelessField Position
y NamelessField Position
-> [NamelessField Position] -> NonEmpty (NamelessField Position)
forall a. a -> [a] -> NonEmpty a
:| [NamelessField Position]
ys)

      parseOne :: CabalSpecVersion -> NamelessField Position -> f (Maybe [Char])
parseOne CabalSpecVersion
v (MkNamelessField Position
pos [FieldLine Position]
fls)
        | [FieldLine Position] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FieldLine Position]
fls = Maybe [Char] -> f (Maybe [Char])
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [Char]
forall a. Maybe a
Nothing
        | CabalSpecVersion
v CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV3_0 = Maybe [Char] -> f (Maybe [Char])
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just (Position -> [FieldLine Position] -> [Char]
fieldlinesToFreeText3 Position
pos [FieldLine Position]
fls))
        | Bool
otherwise = Maybe [Char] -> f (Maybe [Char])
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([FieldLine Position] -> [Char]
forall ann. [FieldLine ann] -> [Char]
fieldlinesToFreeText [FieldLine Position]
fls))

  freeTextFieldDef :: forall s.
ByteString -> ALens' s [Char] -> ParsecFieldGrammar s [Char]
freeTextFieldDef ByteString
fn ALens' s [Char]
_ = Set ByteString
-> Set ByteString
-> (CabalSpecVersion -> Fields Position -> ParseResult [Char])
-> ParsecFieldGrammar s [Char]
forall s a.
Set ByteString
-> Set ByteString
-> (CabalSpecVersion -> Fields Position -> ParseResult a)
-> ParsecFieldGrammar s a
ParsecFG (ByteString -> Set ByteString
forall a. a -> Set a
Set.singleton ByteString
fn) Set ByteString
forall a. Set a
Set.empty CabalSpecVersion -> Fields Position -> ParseResult [Char]
parser
    where
      parser :: CabalSpecVersion -> Fields Position -> ParseResult [Char]
parser CabalSpecVersion
v Fields Position
fields = case ByteString -> Fields Position -> Maybe [NamelessField Position]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
fn Fields Position
fields of
        Maybe [NamelessField Position]
Nothing -> [Char] -> ParseResult [Char]
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
""
        Just [] -> [Char] -> ParseResult [Char]
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
""
        Just [NamelessField Position
x] -> CabalSpecVersion -> NamelessField Position -> ParseResult [Char]
forall {f :: * -> *}.
Applicative f =>
CabalSpecVersion -> NamelessField Position -> f [Char]
parseOne CabalSpecVersion
v NamelessField Position
x
        Just xs :: [NamelessField Position]
xs@(NamelessField Position
_ : NamelessField Position
y : [NamelessField Position]
ys) -> do
          ByteString -> [NamelessField Position] -> ParseResult ()
warnMultipleSingularFields ByteString
fn [NamelessField Position]
xs
          NonEmpty [Char] -> [Char]
forall a. NonEmpty a -> a
NE.last (NonEmpty [Char] -> [Char])
-> ParseResult (NonEmpty [Char]) -> ParseResult [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NamelessField Position -> ParseResult [Char])
-> NonEmpty (NamelessField Position)
-> ParseResult (NonEmpty [Char])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
traverse (CabalSpecVersion -> NamelessField Position -> ParseResult [Char]
forall {f :: * -> *}.
Applicative f =>
CabalSpecVersion -> NamelessField Position -> f [Char]
parseOne CabalSpecVersion
v) (NamelessField Position
y NamelessField Position
-> [NamelessField Position] -> NonEmpty (NamelessField Position)
forall a. a -> [a] -> NonEmpty a
:| [NamelessField Position]
ys)

      parseOne :: CabalSpecVersion -> NamelessField Position -> f [Char]
parseOne CabalSpecVersion
v (MkNamelessField Position
pos [FieldLine Position]
fls)
        | [FieldLine Position] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FieldLine Position]
fls = [Char] -> f [Char]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
""
        | CabalSpecVersion
v CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV3_0 = [Char] -> f [Char]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Position -> [FieldLine Position] -> [Char]
fieldlinesToFreeText3 Position
pos [FieldLine Position]
fls)
        | Bool
otherwise = [Char] -> f [Char]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FieldLine Position] -> [Char]
forall ann. [FieldLine ann] -> [Char]
fieldlinesToFreeText [FieldLine Position]
fls)

  -- freeTextFieldDefST = defaultFreeTextFieldDefST
  freeTextFieldDefST :: forall s.
ByteString -> ALens' s ShortText -> ParsecFieldGrammar s ShortText
freeTextFieldDefST ByteString
fn ALens' s ShortText
_ = Set ByteString
-> Set ByteString
-> (CabalSpecVersion -> Fields Position -> ParseResult ShortText)
-> ParsecFieldGrammar s ShortText
forall s a.
Set ByteString
-> Set ByteString
-> (CabalSpecVersion -> Fields Position -> ParseResult a)
-> ParsecFieldGrammar s a
ParsecFG (ByteString -> Set ByteString
forall a. a -> Set a
Set.singleton ByteString
fn) Set ByteString
forall a. Set a
Set.empty CabalSpecVersion -> Fields Position -> ParseResult ShortText
parser
    where
      parser :: CabalSpecVersion -> Fields Position -> ParseResult ShortText
parser CabalSpecVersion
v Fields Position
fields = case ByteString -> Fields Position -> Maybe [NamelessField Position]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
fn Fields Position
fields of
        Maybe [NamelessField Position]
Nothing -> ShortText -> ParseResult ShortText
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ShortText
forall a. Monoid a => a
mempty
        Just [] -> ShortText -> ParseResult ShortText
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ShortText
forall a. Monoid a => a
mempty
        Just [NamelessField Position
x] -> CabalSpecVersion -> NamelessField Position -> ParseResult ShortText
forall {f :: * -> *}.
Applicative f =>
CabalSpecVersion -> NamelessField Position -> f ShortText
parseOne CabalSpecVersion
v NamelessField Position
x
        Just xs :: [NamelessField Position]
xs@(NamelessField Position
_ : NamelessField Position
y : [NamelessField Position]
ys) -> do
          ByteString -> [NamelessField Position] -> ParseResult ()
warnMultipleSingularFields ByteString
fn [NamelessField Position]
xs
          NonEmpty ShortText -> ShortText
forall a. NonEmpty a -> a
NE.last (NonEmpty ShortText -> ShortText)
-> ParseResult (NonEmpty ShortText) -> ParseResult ShortText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NamelessField Position -> ParseResult ShortText)
-> NonEmpty (NamelessField Position)
-> ParseResult (NonEmpty ShortText)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
traverse (CabalSpecVersion -> NamelessField Position -> ParseResult ShortText
forall {f :: * -> *}.
Applicative f =>
CabalSpecVersion -> NamelessField Position -> f ShortText
parseOne CabalSpecVersion
v) (NamelessField Position
y NamelessField Position
-> [NamelessField Position] -> NonEmpty (NamelessField Position)
forall a. a -> [a] -> NonEmpty a
:| [NamelessField Position]
ys)

      parseOne :: CabalSpecVersion -> NamelessField Position -> f ShortText
parseOne CabalSpecVersion
v (MkNamelessField Position
pos [FieldLine Position]
fls) = case [FieldLine Position]
fls of
        [] -> ShortText -> f ShortText
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ShortText
forall a. Monoid a => a
mempty
        [FieldLine Position
_ ByteString
bs] -> ShortText -> f ShortText
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> ShortText
ShortText.unsafeFromUTF8BS ByteString
bs)
        [FieldLine Position]
_
          | CabalSpecVersion
v CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV3_0 -> ShortText -> f ShortText
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> ShortText
ShortText.toShortText ([Char] -> ShortText) -> [Char] -> ShortText
forall a b. (a -> b) -> a -> b
$ Position -> [FieldLine Position] -> [Char]
fieldlinesToFreeText3 Position
pos [FieldLine Position]
fls)
          | Bool
otherwise -> ShortText -> f ShortText
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> ShortText
ShortText.toShortText ([Char] -> ShortText) -> [Char] -> ShortText
forall a b. (a -> b) -> a -> b
$ [FieldLine Position] -> [Char]
forall ann. [FieldLine ann] -> [Char]
fieldlinesToFreeText [FieldLine Position]
fls)

  monoidalFieldAla :: forall b a s.
(Parsec b, Monoid a, Newtype a b) =>
ByteString -> (a -> b) -> ALens' s a -> ParsecFieldGrammar s a
monoidalFieldAla ByteString
fn a -> b
_pack ALens' s a
_extract = Set ByteString
-> Set ByteString
-> (CabalSpecVersion -> Fields Position -> ParseResult a)
-> ParsecFieldGrammar s a
forall s a.
Set ByteString
-> Set ByteString
-> (CabalSpecVersion -> Fields Position -> ParseResult a)
-> ParsecFieldGrammar s a
ParsecFG (ByteString -> Set ByteString
forall a. a -> Set a
Set.singleton ByteString
fn) Set ByteString
forall a. Set a
Set.empty CabalSpecVersion -> Fields Position -> ParseResult a
forall {t :: * -> *}.
Traversable t =>
CabalSpecVersion
-> Map ByteString (t (NamelessField Position)) -> ParseResult a
parser
    where
      parser :: CabalSpecVersion
-> Map ByteString (t (NamelessField Position)) -> ParseResult a
parser CabalSpecVersion
v Map ByteString (t (NamelessField Position))
fields = case ByteString
-> Map ByteString (t (NamelessField Position))
-> Maybe (t (NamelessField Position))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
fn Map ByteString (t (NamelessField Position))
fields of
        Maybe (t (NamelessField Position))
Nothing -> a -> ParseResult a
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
        Just t (NamelessField Position)
xs -> (b -> a) -> t b -> a
forall m a. Monoid m => (a -> m) -> t a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> b) -> b -> a
forall o n. Newtype o n => (o -> n) -> n -> o
unpack' a -> b
_pack) (t b -> a) -> ParseResult (t b) -> ParseResult a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NamelessField Position -> ParseResult b)
-> t (NamelessField Position) -> ParseResult (t b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b)
traverse (CabalSpecVersion -> NamelessField Position -> ParseResult b
forall {a}.
Parsec a =>
CabalSpecVersion -> NamelessField Position -> ParseResult a
parseOne CabalSpecVersion
v) t (NamelessField Position)
xs

      parseOne :: CabalSpecVersion -> NamelessField Position -> ParseResult a
parseOne CabalSpecVersion
v (MkNamelessField Position
pos [FieldLine Position]
fls) = Position
-> ParsecParser a
-> CabalSpecVersion
-> [FieldLine Position]
-> ParseResult a
forall a.
Position
-> ParsecParser a
-> CabalSpecVersion
-> [FieldLine Position]
-> ParseResult a
runFieldParser Position
pos ParsecParser a
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m a
parsec CabalSpecVersion
v [FieldLine Position]
fls

  prefixedFields :: forall s.
ByteString
-> ALens' s [([Char], [Char])]
-> ParsecFieldGrammar s [([Char], [Char])]
prefixedFields ByteString
fnPfx ALens' s [([Char], [Char])]
_extract = Set ByteString
-> Set ByteString
-> (CabalSpecVersion
    -> Fields Position -> ParseResult [([Char], [Char])])
-> ParsecFieldGrammar s [([Char], [Char])]
forall s a.
Set ByteString
-> Set ByteString
-> (CabalSpecVersion -> Fields Position -> ParseResult a)
-> ParsecFieldGrammar s a
ParsecFG Set ByteString
forall a. Monoid a => a
mempty (ByteString -> Set ByteString
forall a. a -> Set a
Set.singleton ByteString
fnPfx) (\CabalSpecVersion
_ Fields Position
fs -> [([Char], [Char])] -> ParseResult [([Char], [Char])]
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Fields Position -> [([Char], [Char])]
parser Fields Position
fs))
    where
      parser :: Fields Position -> [(String, String)]
      parser :: Fields Position -> [([Char], [Char])]
parser Fields Position
values = [(Position, ([Char], [Char]))] -> [([Char], [Char])]
forall {b}. [(Position, b)] -> [b]
reorder ([(Position, ([Char], [Char]))] -> [([Char], [Char])])
-> [(Position, ([Char], [Char]))] -> [([Char], [Char])]
forall a b. (a -> b) -> a -> b
$ ((ByteString, [NamelessField Position])
 -> [(Position, ([Char], [Char]))])
-> [(ByteString, [NamelessField Position])]
-> [(Position, ([Char], [Char]))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ByteString, [NamelessField Position])
-> [(Position, ([Char], [Char]))]
forall {ann}.
(ByteString, [NamelessField ann]) -> [(ann, ([Char], [Char]))]
convert ([(ByteString, [NamelessField Position])]
 -> [(Position, ([Char], [Char]))])
-> [(ByteString, [NamelessField Position])]
-> [(Position, ([Char], [Char]))]
forall a b. (a -> b) -> a -> b
$ ((ByteString, [NamelessField Position]) -> Bool)
-> [(ByteString, [NamelessField Position])]
-> [(ByteString, [NamelessField Position])]
forall a. (a -> Bool) -> [a] -> [a]
filter (ByteString, [NamelessField Position]) -> Bool
forall {b}. (ByteString, b) -> Bool
match ([(ByteString, [NamelessField Position])]
 -> [(ByteString, [NamelessField Position])])
-> [(ByteString, [NamelessField Position])]
-> [(ByteString, [NamelessField Position])]
forall a b. (a -> b) -> a -> b
$ Fields Position -> [(ByteString, [NamelessField Position])]
forall k a. Map k a -> [(k, a)]
Map.toList Fields Position
values

      match :: (ByteString, b) -> Bool
match (ByteString
fn, b
_) = ByteString
fnPfx ByteString -> ByteString -> Bool
`BS.isPrefixOf` ByteString
fn
      convert :: (ByteString, [NamelessField ann]) -> [(ann, ([Char], [Char]))]
convert (ByteString
fn, [NamelessField ann]
fields) =
        [ (ann
pos, (ByteString -> [Char]
fromUTF8BS ByteString
fn, ShowS
trim ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
fromUTF8BS (ByteString -> [Char]) -> ByteString -> [Char]
forall a b. (a -> b) -> a -> b
$ [FieldLine ann] -> ByteString
forall ann. [FieldLine ann] -> ByteString
fieldlinesToBS [FieldLine ann]
fls))
        | MkNamelessField ann
pos [FieldLine ann]
fls <- [NamelessField ann]
fields
        ]
      -- hack: recover the order of prefixed fields
      reorder :: [(Position, b)] -> [b]
reorder = ((Position, b) -> b) -> [(Position, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (Position, b) -> b
forall a b. (a, b) -> b
snd ([(Position, b)] -> [b])
-> ([(Position, b)] -> [(Position, b)]) -> [(Position, b)] -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Position, b) -> (Position, b) -> Ordering)
-> [(Position, b)] -> [(Position, b)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Position, b) -> Position)
-> (Position, b) -> (Position, b) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Position, b) -> Position
forall a b. (a, b) -> a
fst)

  availableSince :: forall a s.
CabalSpecVersion
-> a -> ParsecFieldGrammar s a -> ParsecFieldGrammar s a
availableSince CabalSpecVersion
vs a
def (ParsecFG Set ByteString
names Set ByteString
prefixes CabalSpecVersion -> Fields Position -> ParseResult a
parser) = Set ByteString
-> Set ByteString
-> (CabalSpecVersion -> Fields Position -> ParseResult a)
-> ParsecFieldGrammar s a
forall s a.
Set ByteString
-> Set ByteString
-> (CabalSpecVersion -> Fields Position -> ParseResult a)
-> ParsecFieldGrammar s a
ParsecFG Set ByteString
names Set ByteString
prefixes CabalSpecVersion -> Fields Position -> ParseResult a
parser'
    where
      parser' :: CabalSpecVersion -> Fields Position -> ParseResult a
parser' CabalSpecVersion
v Fields Position
values
        | CabalSpecVersion
v CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
vs = CabalSpecVersion -> Fields Position -> ParseResult a
parser CabalSpecVersion
v Fields Position
values
        | Bool
otherwise = do
            let unknownFields :: Fields Position
unknownFields = Fields Position -> Map ByteString () -> Fields Position
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.intersection Fields Position
values (Map ByteString () -> Fields Position)
-> Map ByteString () -> Fields Position
forall a b. (a -> b) -> a -> b
$ (ByteString -> ()) -> Set ByteString -> Map ByteString ()
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (() -> ByteString -> ()
forall a b. a -> b -> a
const ()) Set ByteString
names
            [(ByteString, [NamelessField Position])]
-> ((ByteString, [NamelessField Position]) -> ParseResult ())
-> ParseResult ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Fields Position -> [(ByteString, [NamelessField Position])]
forall k a. Map k a -> [(k, a)]
Map.toList Fields Position
unknownFields) (((ByteString, [NamelessField Position]) -> ParseResult ())
 -> ParseResult ())
-> ((ByteString, [NamelessField Position]) -> ParseResult ())
-> ParseResult ()
forall a b. (a -> b) -> a -> b
$ \(ByteString
name, [NamelessField Position]
fields) ->
              [NamelessField Position]
-> (NamelessField Position -> ParseResult ()) -> ParseResult ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [NamelessField Position]
fields ((NamelessField Position -> ParseResult ()) -> ParseResult ())
-> (NamelessField Position -> ParseResult ()) -> ParseResult ()
forall a b. (a -> b) -> a -> b
$ \(MkNamelessField Position
pos [FieldLine Position]
_) ->
                Position -> PWarnType -> [Char] -> ParseResult ()
parseWarning Position
pos PWarnType
PWTUnknownField ([Char] -> ParseResult ()) -> [Char] -> ParseResult ()
forall a b. (a -> b) -> a -> b
$
                  [Char]
"The field " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
name [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" is available only since the Cabal specification version " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ CabalSpecVersion -> [Char]
showCabalSpecVersion CabalSpecVersion
vs [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
". This field will be ignored."

            a -> ParseResult a
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
def

  availableSinceWarn :: forall s a.
CabalSpecVersion
-> ParsecFieldGrammar s a -> ParsecFieldGrammar s a
availableSinceWarn CabalSpecVersion
vs (ParsecFG Set ByteString
names Set ByteString
prefixes CabalSpecVersion -> Fields Position -> ParseResult a
parser) = Set ByteString
-> Set ByteString
-> (CabalSpecVersion -> Fields Position -> ParseResult a)
-> ParsecFieldGrammar s a
forall s a.
Set ByteString
-> Set ByteString
-> (CabalSpecVersion -> Fields Position -> ParseResult a)
-> ParsecFieldGrammar s a
ParsecFG Set ByteString
names Set ByteString
prefixes CabalSpecVersion -> Fields Position -> ParseResult a
parser'
    where
      parser' :: CabalSpecVersion -> Fields Position -> ParseResult a
parser' CabalSpecVersion
v Fields Position
values
        | CabalSpecVersion
v CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
vs = CabalSpecVersion -> Fields Position -> ParseResult a
parser CabalSpecVersion
v Fields Position
values
        | Bool
otherwise = do
            let unknownFields :: Fields Position
unknownFields = Fields Position -> Map ByteString () -> Fields Position
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.intersection Fields Position
values (Map ByteString () -> Fields Position)
-> Map ByteString () -> Fields Position
forall a b. (a -> b) -> a -> b
$ (ByteString -> ()) -> Set ByteString -> Map ByteString ()
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (() -> ByteString -> ()
forall a b. a -> b -> a
const ()) Set ByteString
names
            [(ByteString, [NamelessField Position])]
-> ((ByteString, [NamelessField Position]) -> ParseResult ())
-> ParseResult ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Fields Position -> [(ByteString, [NamelessField Position])]
forall k a. Map k a -> [(k, a)]
Map.toList Fields Position
unknownFields) (((ByteString, [NamelessField Position]) -> ParseResult ())
 -> ParseResult ())
-> ((ByteString, [NamelessField Position]) -> ParseResult ())
-> ParseResult ()
forall a b. (a -> b) -> a -> b
$ \(ByteString
name, [NamelessField Position]
fields) ->
              [NamelessField Position]
-> (NamelessField Position -> ParseResult ()) -> ParseResult ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [NamelessField Position]
fields ((NamelessField Position -> ParseResult ()) -> ParseResult ())
-> (NamelessField Position -> ParseResult ()) -> ParseResult ()
forall a b. (a -> b) -> a -> b
$ \(MkNamelessField Position
pos [FieldLine Position]
_) ->
                Position -> PWarnType -> [Char] -> ParseResult ()
parseWarning Position
pos PWarnType
PWTUnknownField ([Char] -> ParseResult ()) -> [Char] -> ParseResult ()
forall a b. (a -> b) -> a -> b
$
                  [Char]
"The field " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
name [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" is available only since the Cabal specification version " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ CabalSpecVersion -> [Char]
showCabalSpecVersion CabalSpecVersion
vs [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"."

            CabalSpecVersion -> Fields Position -> ParseResult a
parser CabalSpecVersion
v Fields Position
values

  -- todo we know about this field
  deprecatedSince :: forall s a.
CabalSpecVersion
-> [Char] -> ParsecFieldGrammar s a -> ParsecFieldGrammar s a
deprecatedSince CabalSpecVersion
vs [Char]
msg (ParsecFG Set ByteString
names Set ByteString
prefixes CabalSpecVersion -> Fields Position -> ParseResult a
parser) = Set ByteString
-> Set ByteString
-> (CabalSpecVersion -> Fields Position -> ParseResult a)
-> ParsecFieldGrammar s a
forall s a.
Set ByteString
-> Set ByteString
-> (CabalSpecVersion -> Fields Position -> ParseResult a)
-> ParsecFieldGrammar s a
ParsecFG Set ByteString
names Set ByteString
prefixes CabalSpecVersion -> Fields Position -> ParseResult a
parser'
    where
      parser' :: CabalSpecVersion -> Fields Position -> ParseResult a
parser' CabalSpecVersion
v Fields Position
values
        | CabalSpecVersion
v CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
vs = do
            let deprecatedFields :: Fields Position
deprecatedFields = Fields Position -> Map ByteString () -> Fields Position
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.intersection Fields Position
values (Map ByteString () -> Fields Position)
-> Map ByteString () -> Fields Position
forall a b. (a -> b) -> a -> b
$ (ByteString -> ()) -> Set ByteString -> Map ByteString ()
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (() -> ByteString -> ()
forall a b. a -> b -> a
const ()) Set ByteString
names
            [(ByteString, [NamelessField Position])]
-> ((ByteString, [NamelessField Position]) -> ParseResult ())
-> ParseResult ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Fields Position -> [(ByteString, [NamelessField Position])]
forall k a. Map k a -> [(k, a)]
Map.toList Fields Position
deprecatedFields) (((ByteString, [NamelessField Position]) -> ParseResult ())
 -> ParseResult ())
-> ((ByteString, [NamelessField Position]) -> ParseResult ())
-> ParseResult ()
forall a b. (a -> b) -> a -> b
$ \(ByteString
name, [NamelessField Position]
fields) ->
              [NamelessField Position]
-> (NamelessField Position -> ParseResult ()) -> ParseResult ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [NamelessField Position]
fields ((NamelessField Position -> ParseResult ()) -> ParseResult ())
-> (NamelessField Position -> ParseResult ()) -> ParseResult ()
forall a b. (a -> b) -> a -> b
$ \(MkNamelessField Position
pos [FieldLine Position]
_) ->
                Position -> PWarnType -> [Char] -> ParseResult ()
parseWarning Position
pos PWarnType
PWTDeprecatedField ([Char] -> ParseResult ()) -> [Char] -> ParseResult ()
forall a b. (a -> b) -> a -> b
$
                  [Char]
"The field " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
name [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" is deprecated in the Cabal specification version " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ CabalSpecVersion -> [Char]
showCabalSpecVersion CabalSpecVersion
vs [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
". " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
msg

            CabalSpecVersion -> Fields Position -> ParseResult a
parser CabalSpecVersion
v Fields Position
values
        | Bool
otherwise = CabalSpecVersion -> Fields Position -> ParseResult a
parser CabalSpecVersion
v Fields Position
values

  removedIn :: forall s a.
CabalSpecVersion
-> [Char] -> ParsecFieldGrammar s a -> ParsecFieldGrammar s a
removedIn CabalSpecVersion
vs [Char]
msg (ParsecFG Set ByteString
names Set ByteString
prefixes CabalSpecVersion -> Fields Position -> ParseResult a
parser) = Set ByteString
-> Set ByteString
-> (CabalSpecVersion -> Fields Position -> ParseResult a)
-> ParsecFieldGrammar s a
forall s a.
Set ByteString
-> Set ByteString
-> (CabalSpecVersion -> Fields Position -> ParseResult a)
-> ParsecFieldGrammar s a
ParsecFG Set ByteString
names Set ByteString
prefixes CabalSpecVersion -> Fields Position -> ParseResult a
parser'
    where
      parser' :: CabalSpecVersion -> Fields Position -> ParseResult a
parser' CabalSpecVersion
v Fields Position
values
        | CabalSpecVersion
v CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
vs = do
            let msg' :: [Char]
msg' = if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
msg then [Char]
"" else Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
msg
            let unknownFields :: Fields Position
unknownFields = Fields Position -> Map ByteString () -> Fields Position
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.intersection Fields Position
values (Map ByteString () -> Fields Position)
-> Map ByteString () -> Fields Position
forall a b. (a -> b) -> a -> b
$ (ByteString -> ()) -> Set ByteString -> Map ByteString ()
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (() -> ByteString -> ()
forall a b. a -> b -> a
const ()) Set ByteString
names
            let namePos :: [(ByteString, Position)]
namePos =
                  [ (ByteString
name, Position
pos)
                  | (ByteString
name, [NamelessField Position]
fields) <- Fields Position -> [(ByteString, [NamelessField Position])]
forall k a. Map k a -> [(k, a)]
Map.toList Fields Position
unknownFields
                  , MkNamelessField Position
pos [FieldLine Position]
_ <- [NamelessField Position]
fields
                  ]

            let makeMsg :: a -> [Char]
makeMsg a
name = [Char]
"The field " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> [Char]
forall a. Show a => a -> [Char]
show a
name [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" is removed in the Cabal specification version " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ CabalSpecVersion -> [Char]
showCabalSpecVersion CabalSpecVersion
vs [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"." [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
msg'

            case [(ByteString, Position)]
namePos of
              -- no fields => proceed (with empty values, to be sure)
              [] -> CabalSpecVersion -> Fields Position -> ParseResult a
parser CabalSpecVersion
v Fields Position
forall a. Monoid a => a
mempty
              -- if there's single field: fail fatally with it
              ((ByteString
name, Position
pos) : [(ByteString, Position)]
rest) -> do
                [(ByteString, Position)]
-> ((ByteString, Position) -> ParseResult ()) -> ParseResult ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(ByteString, Position)]
rest (((ByteString, Position) -> ParseResult ()) -> ParseResult ())
-> ((ByteString, Position) -> ParseResult ()) -> ParseResult ()
forall a b. (a -> b) -> a -> b
$ \(ByteString
name', Position
pos') -> Position -> [Char] -> ParseResult ()
parseFailure Position
pos' ([Char] -> ParseResult ()) -> [Char] -> ParseResult ()
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
forall a. Show a => a -> [Char]
makeMsg ByteString
name'
                Position -> [Char] -> ParseResult a
forall a. Position -> [Char] -> ParseResult a
parseFatalFailure Position
pos ([Char] -> ParseResult a) -> [Char] -> ParseResult a
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
forall a. Show a => a -> [Char]
makeMsg ByteString
name
        | Bool
otherwise = CabalSpecVersion -> Fields Position -> ParseResult a
parser CabalSpecVersion
v Fields Position
values

  knownField :: forall s. ByteString -> ParsecFieldGrammar s ()
knownField ByteString
fn = Set ByteString
-> Set ByteString
-> (CabalSpecVersion -> Fields Position -> ParseResult ())
-> ParsecFieldGrammar s ()
forall s a.
Set ByteString
-> Set ByteString
-> (CabalSpecVersion -> Fields Position -> ParseResult a)
-> ParsecFieldGrammar s a
ParsecFG (ByteString -> Set ByteString
forall a. a -> Set a
Set.singleton ByteString
fn) Set ByteString
forall a. Set a
Set.empty (\CabalSpecVersion
_ Fields Position
_ -> () -> ParseResult ()
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

  hiddenField :: forall s a. ParsecFieldGrammar s a -> ParsecFieldGrammar s a
hiddenField = ParsecFieldGrammar s a -> ParsecFieldGrammar s a
forall a. a -> a
id

-------------------------------------------------------------------------------
-- Parsec
-------------------------------------------------------------------------------

runFieldParser' :: [Position] -> ParsecParser a -> CabalSpecVersion -> FieldLineStream -> ParseResult a
runFieldParser' :: forall a.
[Position]
-> ParsecParser a
-> CabalSpecVersion
-> FieldLineStream
-> ParseResult a
runFieldParser' [Position]
inputPoss ParsecParser a
p CabalSpecVersion
v FieldLineStream
str = case Parsec FieldLineStream [PWarning] (a, [PWarning])
-> [PWarning]
-> [Char]
-> FieldLineStream
-> Either ParseError (a, [PWarning])
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> [Char] -> s -> Either ParseError a
P.runParser Parsec FieldLineStream [PWarning] (a, [PWarning])
p' [] [Char]
"<field>" FieldLineStream
str of
  Right (a
pok, [PWarning]
ws) -> do
    (PWarning -> ParseResult ()) -> [PWarning] -> ParseResult ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (\(PWarning PWarnType
t Position
pos [Char]
w) -> Position -> PWarnType -> [Char] -> ParseResult ()
parseWarning (Position -> Position
mapPosition Position
pos) PWarnType
t [Char]
w) [PWarning]
ws
    a -> ParseResult a
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
pok
  Left ParseError
err -> do
    let ppos :: SourcePos
ppos = ParseError -> SourcePos
P.errorPos ParseError
err
    let epos :: Position
epos = Position -> Position
mapPosition (Position -> Position) -> Position -> Position
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Position
Position (SourcePos -> Int
P.sourceLine SourcePos
ppos) (SourcePos -> Int
P.sourceColumn SourcePos
ppos)

    let msg :: [Char]
msg =
          [Char]
-> [Char] -> [Char] -> [Char] -> [Char] -> [Message] -> [Char]
P.showErrorMessages
            [Char]
"or"
            [Char]
"unknown parse error"
            [Char]
"expecting"
            [Char]
"unexpected"
            [Char]
"end of input"
            (ParseError -> [Message]
P.errorMessages ParseError
err)
    Position -> [Char] -> ParseResult a
forall a. Position -> [Char] -> ParseResult a
parseFatalFailure Position
epos ([Char] -> ParseResult a) -> [Char] -> ParseResult a
forall a b. (a -> b) -> a -> b
$ [Char]
msg [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
  where
    p' :: Parsec FieldLineStream [PWarning] (a, [PWarning])
p' = (,) (a -> [PWarning] -> (a, [PWarning]))
-> ParsecT FieldLineStream [PWarning] Identity ()
-> ParsecT
     FieldLineStream
     [PWarning]
     Identity
     (a -> [PWarning] -> (a, [PWarning]))
forall a b.
a
-> ParsecT FieldLineStream [PWarning] Identity b
-> ParsecT FieldLineStream [PWarning] Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT FieldLineStream [PWarning] Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces ParsecT
  FieldLineStream
  [PWarning]
  Identity
  (a -> [PWarning] -> (a, [PWarning]))
-> ParsecT FieldLineStream [PWarning] Identity a
-> ParsecT
     FieldLineStream [PWarning] Identity ([PWarning] -> (a, [PWarning]))
forall a b.
ParsecT FieldLineStream [PWarning] Identity (a -> b)
-> ParsecT FieldLineStream [PWarning] Identity a
-> ParsecT FieldLineStream [PWarning] Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecParser a
-> CabalSpecVersion
-> ParsecT FieldLineStream [PWarning] Identity a
forall a.
ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
unPP ParsecParser a
p CabalSpecVersion
v ParsecT
  FieldLineStream [PWarning] Identity ([PWarning] -> (a, [PWarning]))
-> ParsecT FieldLineStream [PWarning] Identity ()
-> ParsecT
     FieldLineStream [PWarning] Identity ([PWarning] -> (a, [PWarning]))
forall a b.
ParsecT FieldLineStream [PWarning] Identity a
-> ParsecT FieldLineStream [PWarning] Identity b
-> ParsecT FieldLineStream [PWarning] Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT FieldLineStream [PWarning] Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces ParsecT
  FieldLineStream [PWarning] Identity ([PWarning] -> (a, [PWarning]))
-> ParsecT FieldLineStream [PWarning] Identity ()
-> ParsecT
     FieldLineStream [PWarning] Identity ([PWarning] -> (a, [PWarning]))
forall a b.
ParsecT FieldLineStream [PWarning] Identity a
-> ParsecT FieldLineStream [PWarning] Identity b
-> ParsecT FieldLineStream [PWarning] Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT FieldLineStream [PWarning] Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
P.eof ParsecT
  FieldLineStream [PWarning] Identity ([PWarning] -> (a, [PWarning]))
-> ParsecT FieldLineStream [PWarning] Identity [PWarning]
-> Parsec FieldLineStream [PWarning] (a, [PWarning])
forall a b.
ParsecT FieldLineStream [PWarning] Identity (a -> b)
-> ParsecT FieldLineStream [PWarning] Identity a
-> ParsecT FieldLineStream [PWarning] Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT FieldLineStream [PWarning] Identity [PWarning]
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
P.getState

    -- Positions start from 1:1, not 0:0
    mapPosition :: Position -> Position
mapPosition (Position Int
prow Int
pcol) = Int -> [Position] -> Position
forall {t}. (Ord t, Num t) => t -> [Position] -> Position
go (Int
prow Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Position]
inputPoss
      where
        go :: t -> [Position] -> Position
go t
_ [] = Position
zeroPos
        go t
_ [Position Int
row Int
col] = Int -> Int -> Position
Position Int
row (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pcol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        go t
n (Position Int
row Int
col : [Position]
_) | t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0 = Int -> Int -> Position
Position Int
row (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pcol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        go t
n (Position
_ : [Position]
ps) = t -> [Position] -> Position
go (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1) [Position]
ps

runFieldParser :: Position -> ParsecParser a -> CabalSpecVersion -> [FieldLine Position] -> ParseResult a
runFieldParser :: forall a.
Position
-> ParsecParser a
-> CabalSpecVersion
-> [FieldLine Position]
-> ParseResult a
runFieldParser Position
pp ParsecParser a
p CabalSpecVersion
v [FieldLine Position]
ls = [Position]
-> ParsecParser a
-> CabalSpecVersion
-> FieldLineStream
-> ParseResult a
forall a.
[Position]
-> ParsecParser a
-> CabalSpecVersion
-> FieldLineStream
-> ParseResult a
runFieldParser' [Position]
poss ParsecParser a
p CabalSpecVersion
v ([FieldLine Position] -> FieldLineStream
forall ann. [FieldLine ann] -> FieldLineStream
fieldLinesToStream [FieldLine Position]
ls)
  where
    poss :: [Position]
poss = (FieldLine Position -> Position)
-> [FieldLine Position] -> [Position]
forall a b. (a -> b) -> [a] -> [b]
map (\(FieldLine Position
pos ByteString
_) -> Position
pos) [FieldLine Position]
ls [Position] -> [Position] -> [Position]
forall a. [a] -> [a] -> [a]
++ [Position
pp] -- add "default" position

fieldlinesToBS :: [FieldLine ann] -> BS.ByteString
fieldlinesToBS :: forall ann. [FieldLine ann] -> ByteString
fieldlinesToBS = ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
"\n" ([ByteString] -> ByteString)
-> ([FieldLine ann] -> [ByteString])
-> [FieldLine ann]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldLine ann -> ByteString) -> [FieldLine ann] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (\(FieldLine ann
_ ByteString
bs) -> ByteString
bs)

-- Example package with dot lines
-- http://hackage.haskell.org/package/copilot-cbmc-0.1/copilot-cbmc.cabal
fieldlinesToFreeText :: [FieldLine ann] -> String
fieldlinesToFreeText :: forall ann. [FieldLine ann] -> [Char]
fieldlinesToFreeText [FieldLine ann
_ ByteString
"."] = [Char]
"."
fieldlinesToFreeText [FieldLine ann]
fls = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" ((FieldLine ann -> [Char]) -> [FieldLine ann] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map FieldLine ann -> [Char]
forall {ann}. FieldLine ann -> [Char]
go [FieldLine ann]
fls)
  where
    go :: FieldLine ann -> [Char]
go (FieldLine ann
_ ByteString
bs)
      | [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"." = [Char]
""
      | Bool
otherwise = [Char]
s
      where
        s :: [Char]
s = ShowS
trim (ByteString -> [Char]
fromUTF8BS ByteString
bs)

fieldlinesToFreeText3 :: Position -> [FieldLine Position] -> String
fieldlinesToFreeText3 :: Position -> [FieldLine Position] -> [Char]
fieldlinesToFreeText3 Position
_ [] = [Char]
""
fieldlinesToFreeText3 Position
_ [FieldLine Position
_ ByteString
bs] = ByteString -> [Char]
fromUTF8BS ByteString
bs
fieldlinesToFreeText3 Position
pos (FieldLine Position
pos1 ByteString
bs1 : fls2 :: [FieldLine Position]
fls2@(FieldLine Position
pos2 ByteString
_ : [FieldLine Position]
_))
  -- if first line is on the same line with field name:
  -- the indentation level is either
  -- 1. the indentation of left most line in rest fields
  -- 2. the indentation of the first line
  -- whichever is leftmost
  | Position -> Int
positionRow Position
pos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Position -> Int
positionRow Position
pos1 =
      [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$
        ByteString -> [Char]
fromUTF8BS ByteString
bs1
          [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: (Position -> FieldLine Position -> (Position, [Char]))
-> Position -> [FieldLine Position] -> [[Char]]
forall s a b. (s -> a -> (s, b)) -> s -> [a] -> [b]
mealy (Int -> Position -> FieldLine Position -> (Position, [Char])
mk Int
mcol1) Position
pos1 [FieldLine Position]
fls2
  -- otherwise, also indent the first line
  | Bool
otherwise =
      [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$
        Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Position -> Int
positionCol Position
pos1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
mcol2) Char
' '
          [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: ByteString -> [Char]
fromUTF8BS ByteString
bs1
          [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: (Position -> FieldLine Position -> (Position, [Char]))
-> Position -> [FieldLine Position] -> [[Char]]
forall s a b. (s -> a -> (s, b)) -> s -> [a] -> [b]
mealy (Int -> Position -> FieldLine Position -> (Position, [Char])
mk Int
mcol2) Position
pos1 [FieldLine Position]
fls2
  where
    mcol1 :: Int
mcol1 = (Int -> FieldLine Position -> Int)
-> Int -> [FieldLine Position] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
a FieldLine Position
b -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
a (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Position -> Int
positionCol (Position -> Int) -> Position -> Int
forall a b. (a -> b) -> a -> b
$ FieldLine Position -> Position
forall ann. FieldLine ann -> ann
fieldLineAnn FieldLine Position
b) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Position -> Int
positionCol Position
pos1) (Position -> Int
positionCol Position
pos2)) [FieldLine Position]
fls2
    mcol2 :: Int
mcol2 = (Int -> FieldLine Position -> Int)
-> Int -> [FieldLine Position] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
a FieldLine Position
b -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
a (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Position -> Int
positionCol (Position -> Int) -> Position -> Int
forall a b. (a -> b) -> a -> b
$ FieldLine Position -> Position
forall ann. FieldLine ann -> ann
fieldLineAnn FieldLine Position
b) (Position -> Int
positionCol Position
pos1) [FieldLine Position]
fls2

    mk :: Int -> Position -> FieldLine Position -> (Position, String)
    mk :: Int -> Position -> FieldLine Position -> (Position, [Char])
mk Int
col Position
p (FieldLine Position
q ByteString
bs) =
      ( Position
q
      , Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
newlines Char
'\n'
          [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
indent Char
' '
          [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
fromUTF8BS ByteString
bs
      )
      where
        newlines :: Int
newlines = Position -> Int
positionRow Position
q Int -> Int -> Int
forall a. Num a => a -> a -> a
- Position -> Int
positionRow Position
p
        indent :: Int
indent = Position -> Int
positionCol Position
q Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
col

mealy :: (s -> a -> (s, b)) -> s -> [a] -> [b]
mealy :: forall s a b. (s -> a -> (s, b)) -> s -> [a] -> [b]
mealy s -> a -> (s, b)
f = s -> [a] -> [b]
go
  where
    go :: s -> [a] -> [b]
go s
_ [] = []
    go s
s (a
x : [a]
xs) = let ~(s
s', b
y) = s -> a -> (s, b)
f s
s a
x in b
y b -> [b] -> [b]
forall a. a -> [a] -> [a]
: s -> [a] -> [b]
go s
s' [a]
xs

fieldLinesToStream :: [FieldLine ann] -> FieldLineStream
fieldLinesToStream :: forall ann. [FieldLine ann] -> FieldLineStream
fieldLinesToStream [] = FieldLineStream
fieldLineStreamEnd
fieldLinesToStream [FieldLine ann
_ ByteString
bs] = ByteString -> FieldLineStream
FLSLast ByteString
bs
fieldLinesToStream (FieldLine ann
_ ByteString
bs : [FieldLine ann]
fs) = ByteString -> FieldLineStream -> FieldLineStream
FLSCons ByteString
bs ([FieldLine ann] -> FieldLineStream
forall ann. [FieldLine ann] -> FieldLineStream
fieldLinesToStream [FieldLine ann]
fs)