{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Distribution.FieldGrammar (
FieldGrammar (..),
uniqueField,
optionalField,
optionalFieldDef,
monoidalField,
ParsecFieldGrammar,
ParsecFieldGrammar',
parseFieldGrammar,
fieldGrammarKnownFieldList,
PrettyFieldGrammar,
PrettyFieldGrammar',
prettyFieldGrammar,
(^^^),
Section(..),
Fields,
partitionFields,
takeFields,
runFieldParser,
runFieldParser',
defaultFreeTextFieldDefST,
module Distribution.FieldGrammar.Newtypes,
) where
import Distribution.Compat.Prelude
import Prelude ()
import qualified Data.Map.Strict as Map
import Distribution.FieldGrammar.Class
import Distribution.FieldGrammar.Newtypes
import Distribution.FieldGrammar.Parsec
import Distribution.FieldGrammar.Pretty
import Distribution.Fields.Field
import Distribution.Utils.Generic (spanMaybe)
type ParsecFieldGrammar' a = ParsecFieldGrammar a a
type PrettyFieldGrammar' a = PrettyFieldGrammar a a
infixl 5 ^^^
(^^^) :: a -> (a -> b) -> b
a
x ^^^ :: forall a b. a -> (a -> b) -> b
^^^ a -> b
f = a -> b
f a
x
data PS ann = PS (Fields ann) [Section ann] [[Section ann]]
partitionFields :: [Field ann] -> (Fields ann, [[Section ann]])
partitionFields :: forall ann. [Field ann] -> (Fields ann, [[Section ann]])
partitionFields = forall ann. PS ann -> (Fields ann, [[Section ann]])
finalize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall ann. PS ann -> Field ann -> PS ann
f (forall ann.
Fields ann -> [Section ann] -> [[Section ann]] -> PS ann
PS forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty)
where
finalize :: PS ann -> (Fields ann, [[Section ann]])
finalize :: forall ann. PS ann -> (Fields ann, [[Section ann]])
finalize (PS Fields ann
fs [Section ann]
s [[Section ann]]
ss)
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Section ann]
s = (Fields ann
fs, forall a. [a] -> [a]
reverse [[Section ann]]
ss)
| Bool
otherwise = (Fields ann
fs, forall a. [a] -> [a]
reverse (forall a. [a] -> [a]
reverse [Section ann]
s forall a. a -> [a] -> [a]
: [[Section ann]]
ss))
f :: PS ann -> Field ann -> PS ann
f :: forall ann. PS ann -> Field ann -> PS ann
f (PS Fields ann
fs [Section ann]
s [[Section ann]]
ss) (Field (Name ann
ann ByteString
name) [FieldLine ann]
fss) =
forall ann.
Fields ann -> [Section ann] -> [[Section ann]] -> PS ann
PS (forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. [a] -> [a] -> [a]
(++)) ByteString
name [forall ann. ann -> [FieldLine ann] -> NamelessField ann
MkNamelessField ann
ann [FieldLine ann]
fss] Fields ann
fs) [] [[Section ann]]
ss'
where
ss' :: [[Section ann]]
ss' | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Section ann]
s = [[Section ann]]
ss
| Bool
otherwise = forall a. [a] -> [a]
reverse [Section ann]
s forall a. a -> [a] -> [a]
: [[Section ann]]
ss
f (PS Fields ann
fs [Section ann]
s [[Section ann]]
ss) (Section Name ann
name [SectionArg ann]
sargs [Field ann]
sfields) =
forall ann.
Fields ann -> [Section ann] -> [[Section ann]] -> PS ann
PS Fields ann
fs (forall ann.
Name ann -> [SectionArg ann] -> [Field ann] -> Section ann
MkSection Name ann
name [SectionArg ann]
sargs [Field ann]
sfields forall a. a -> [a] -> [a]
: [Section ann]
s) [[Section ann]]
ss
takeFields :: [Field ann] -> (Fields ann, [Field ann])
takeFields :: forall ann. [Field ann] -> (Fields ann, [Field ann])
takeFields = forall {k} {a} {b}. Ord k => ([(k, [a])], b) -> (Map k [a], b)
finalize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> ([b], [a])
spanMaybe forall {ann}. Field ann -> Maybe (ByteString, [NamelessField ann])
match
where
finalize :: ([(k, [a])], b) -> (Map k [a], b)
finalize ([(k, [a])]
fs, b
rest) = (forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. [a] -> [a] -> [a]
(++)) [(k, [a])]
fs, b
rest)
match :: Field ann -> Maybe (ByteString, [NamelessField ann])
match (Field (Name ann
ann ByteString
name) [FieldLine ann]
fs) = forall a. a -> Maybe a
Just (ByteString
name, [forall ann. ann -> [FieldLine ann] -> NamelessField ann
MkNamelessField ann
ann [FieldLine ann]
fs])
match Field ann
_ = forall a. Maybe a
Nothing