{-# LANGUAGE ExistentialQuantification, NamedFieldPuns, RankNTypes #-}
module Distribution.Client.ParseUtils (
FieldDescr(..),
liftField,
liftFields,
filterFields,
mapFieldNames,
commandOptionToField,
commandOptionsToFields,
SectionDescr(..),
liftSection,
FGSectionDescr(..),
parseFields,
ppFields,
ppSection,
parseFieldsAndSections,
ppFieldsAndSections,
parseConfig,
showConfig,
)
where
import Distribution.Client.Compat.Prelude hiding (empty, get)
import Prelude ()
import Distribution.Deprecated.ParseUtils
( FieldDescr(..), ParseResult(..), warning, LineNo, lineNo
, Field(..), liftField, readFields )
import Distribution.Deprecated.ViewAsFieldDescr
( viewAsFieldDescr )
import Distribution.Simple.Command
( OptionField )
import Text.PrettyPrint ( ($+$) )
import qualified Data.ByteString as BS
import qualified Data.Map as Map
import qualified Text.PrettyPrint as Disp
( (<>), Doc, text, colon, vcat, empty, isEmpty, nest )
import Distribution.CabalSpecVersion (cabalSpecLatest)
import Distribution.FieldGrammar (partitionFields, parseFieldGrammar)
import Distribution.Fields.ParseResult (runParseResult)
import Distribution.Parsec.Error (showPError)
import Distribution.Parsec.Position (Position (..))
import Distribution.Parsec.Warning (showPWarning)
import Distribution.Simple.Utils (fromUTF8BS, toUTF8BS)
import qualified Distribution.Fields as F
import qualified Distribution.FieldGrammar as FG
liftFields :: (b -> a)
-> (a -> b -> b)
-> [FieldDescr a]
-> [FieldDescr b]
liftFields :: forall b a.
(b -> a) -> (a -> b -> b) -> [FieldDescr a] -> [FieldDescr b]
liftFields b -> a
get a -> b -> b
set = forall a b. (a -> b) -> [a] -> [b]
map (forall b a.
(b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
liftField b -> a
get a -> b -> b
set)
filterFields :: [String] -> [FieldDescr a] -> [FieldDescr a]
filterFields :: forall a. [String] -> [FieldDescr a] -> [FieldDescr a]
filterFields [String]
includeFields = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
includeFields) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FieldDescr a -> String
fieldName)
mapFieldNames :: (String -> String) -> [FieldDescr a] -> [FieldDescr a]
mapFieldNames :: forall a. (String -> String) -> [FieldDescr a] -> [FieldDescr a]
mapFieldNames String -> String
mangleName =
forall a b. (a -> b) -> [a] -> [b]
map (\FieldDescr a
descr -> FieldDescr a
descr { fieldName :: String
fieldName = String -> String
mangleName (forall a. FieldDescr a -> String
fieldName FieldDescr a
descr) })
commandOptionToField :: OptionField a -> FieldDescr a
commandOptionToField :: forall a. OptionField a -> FieldDescr a
commandOptionToField = forall a. OptionField a -> FieldDescr a
viewAsFieldDescr
commandOptionsToFields :: [OptionField a] -> [FieldDescr a]
commandOptionsToFields :: forall a. [OptionField a] -> [FieldDescr a]
commandOptionsToFields = forall a b. (a -> b) -> [a] -> [b]
map forall a. OptionField a -> FieldDescr a
viewAsFieldDescr
data SectionDescr a = forall b. SectionDescr {
forall a. SectionDescr a -> String
sectionName :: String,
()
sectionFields :: [FieldDescr b],
()
sectionSubsections :: [SectionDescr b],
()
sectionGet :: a -> [(String, b)],
()
sectionSet :: LineNo -> String -> b -> a -> ParseResult a,
()
sectionEmpty :: b
}
data FGSectionDescr g a = forall s. FGSectionDescr
{ forall (g :: * -> * -> *) a. FGSectionDescr g a -> String
fgSectionName :: String
, ()
fgSectionGrammar :: g s s
, ()
fgSectionGet :: a -> [(String, s)]
, ()
fgSectionSet :: LineNo -> String -> s -> a -> ParseResult a
}
liftSection :: (b -> a)
-> (a -> b -> b)
-> SectionDescr a
-> SectionDescr b
liftSection :: forall b a.
(b -> a) -> (a -> b -> b) -> SectionDescr a -> SectionDescr b
liftSection b -> a
get' a -> b -> b
set' (SectionDescr String
name [FieldDescr b]
fields [SectionDescr b]
sections a -> [(String, b)]
get LineNo -> String -> b -> a -> ParseResult a
set b
empty) =
let sectionGet' :: b -> [(String, b)]
sectionGet' = a -> [(String, b)]
get forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
get'
sectionSet' :: LineNo -> String -> b -> b -> ParseResult b
sectionSet' LineNo
lineno String
param b
x b
y = do
a
x' <- LineNo -> String -> b -> a -> ParseResult a
set LineNo
lineno String
param b
x (b -> a
get' b
y)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b -> b
set' a
x' b
y)
in forall a b.
String
-> [FieldDescr b]
-> [SectionDescr b]
-> (a -> [(String, b)])
-> (LineNo -> String -> b -> a -> ParseResult a)
-> b
-> SectionDescr a
SectionDescr String
name [FieldDescr b]
fields [SectionDescr b]
sections b -> [(String, b)]
sectionGet' LineNo -> String -> b -> b -> ParseResult b
sectionSet' b
empty
parseFields :: [FieldDescr a] -> a -> [Field] -> ParseResult a
parseFields :: forall a. [FieldDescr a] -> a -> [Field] -> ParseResult a
parseFields [FieldDescr a]
fieldDescrs =
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM a -> Field -> ParseResult a
setField
where
fieldMap :: Map String (FieldDescr a)
fieldMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (forall a. FieldDescr a -> String
fieldName FieldDescr a
f, FieldDescr a
f) | FieldDescr a
f <- [FieldDescr a]
fieldDescrs ]
setField :: a -> Field -> ParseResult a
setField a
accum (F LineNo
line String
name String
value) =
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
name Map String (FieldDescr a)
fieldMap of
Just (FieldDescr String
_ a -> Doc
_ LineNo -> String -> a -> ParseResult a
set) -> LineNo -> String -> a -> ParseResult a
set LineNo
line String
value a
accum
Maybe (FieldDescr a)
Nothing -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String
name forall a. Eq a => a -> a -> Bool
== String
"world-file") forall a b. (a -> b) -> a -> b
$
String -> ParseResult ()
warning forall a b. (a -> b) -> a -> b
$ String
"Unrecognized field " forall a. [a] -> [a] -> [a]
++ String
name forall a. [a] -> [a] -> [a]
++ String
" on line " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show LineNo
line
forall (m :: * -> *) a. Monad m => a -> m a
return a
accum
setField a
accum Field
f = do
String -> ParseResult ()
warning forall a b. (a -> b) -> a -> b
$ String
"Unrecognized stanza on line " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Field -> LineNo
lineNo Field
f)
forall (m :: * -> *) a. Monad m => a -> m a
return a
accum
ppFields :: [FieldDescr a] -> (Maybe a) -> a -> Disp.Doc
ppFields :: forall a. [FieldDescr a] -> Maybe a -> a -> Doc
ppFields [FieldDescr a]
fields Maybe a
def a
cur =
[Doc] -> Doc
Disp.vcat [ String -> Maybe Doc -> Doc -> Doc
ppField String
name (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Doc
getter Maybe a
def) (a -> Doc
getter a
cur)
| FieldDescr String
name a -> Doc
getter LineNo -> String -> a -> ParseResult a
_ <- [FieldDescr a]
fields]
ppField :: String -> (Maybe Disp.Doc) -> Disp.Doc -> Disp.Doc
ppField :: String -> Maybe Doc -> Doc -> Doc
ppField String
name Maybe Doc
mdef Doc
cur
| Doc -> Bool
Disp.isEmpty Doc
cur = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
Disp.empty
(\Doc
def -> String -> Doc
Disp.text String
"--" Doc -> Doc -> Doc
<+> String -> Doc
Disp.text String
name
Doc -> Doc -> Doc
Disp.<> Doc
Disp.colon Doc -> Doc -> Doc
<+> Doc
def) Maybe Doc
mdef
| Bool
otherwise = String -> Doc
Disp.text String
name Doc -> Doc -> Doc
Disp.<> Doc
Disp.colon Doc -> Doc -> Doc
<+> Doc
cur
ppSection :: String -> String -> [FieldDescr a] -> (Maybe a) -> a -> Disp.Doc
ppSection :: forall a. String -> String -> [FieldDescr a] -> Maybe a -> a -> Doc
ppSection String
name String
arg [FieldDescr a]
fields Maybe a
def a
cur
| Doc -> Bool
Disp.isEmpty Doc
fieldsDoc = Doc
Disp.empty
| Bool
otherwise = String -> Doc
Disp.text String
name Doc -> Doc -> Doc
<+> Doc
argDoc
Doc -> Doc -> Doc
$+$ (LineNo -> Doc -> Doc
Disp.nest LineNo
2 Doc
fieldsDoc)
where
fieldsDoc :: Doc
fieldsDoc = forall a. [FieldDescr a] -> Maybe a -> a -> Doc
ppFields [FieldDescr a]
fields Maybe a
def a
cur
argDoc :: Doc
argDoc | String
arg forall a. Eq a => a -> a -> Bool
== String
"" = Doc
Disp.empty
| Bool
otherwise = String -> Doc
Disp.text String
arg
parseFieldsAndSections
:: [FieldDescr a]
-> [SectionDescr a]
-> [FGSectionDescr FG.ParsecFieldGrammar a]
-> a
-> [Field] -> ParseResult a
parseFieldsAndSections :: forall a.
[FieldDescr a]
-> [SectionDescr a]
-> [FGSectionDescr ParsecFieldGrammar a]
-> a
-> [Field]
-> ParseResult a
parseFieldsAndSections [FieldDescr a]
fieldDescrs [SectionDescr a]
sectionDescrs [FGSectionDescr ParsecFieldGrammar a]
fgSectionDescrs =
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM a -> Field -> ParseResult a
setField
where
fieldMap :: Map String (FieldDescr a)
fieldMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (forall a. FieldDescr a -> String
fieldName FieldDescr a
f, FieldDescr a
f) | FieldDescr a
f <- [FieldDescr a]
fieldDescrs ]
sectionMap :: Map String (SectionDescr a)
sectionMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (forall a. SectionDescr a -> String
sectionName SectionDescr a
s, SectionDescr a
s) | SectionDescr a
s <- [SectionDescr a]
sectionDescrs ]
fgSectionMap :: Map String (FGSectionDescr ParsecFieldGrammar a)
fgSectionMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (forall (g :: * -> * -> *) a. FGSectionDescr g a -> String
fgSectionName FGSectionDescr ParsecFieldGrammar a
s, FGSectionDescr ParsecFieldGrammar a
s) | FGSectionDescr ParsecFieldGrammar a
s <- [FGSectionDescr ParsecFieldGrammar a]
fgSectionDescrs ]
setField :: a -> Field -> ParseResult a
setField a
a (F LineNo
line String
name String
value) =
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
name Map String (FieldDescr a)
fieldMap of
Just (FieldDescr String
_ a -> Doc
_ LineNo -> String -> a -> ParseResult a
set) -> LineNo -> String -> a -> ParseResult a
set LineNo
line String
value a
a
Maybe (FieldDescr a)
Nothing -> do
String -> ParseResult ()
warning forall a b. (a -> b) -> a -> b
$ String
"Unrecognized field '" forall a. [a] -> [a] -> [a]
++ String
name
forall a. [a] -> [a] -> [a]
++ String
"' on line " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show LineNo
line
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
setField a
a (Section LineNo
line String
name String
param [Field]
fields) =
case forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
name Map String (SectionDescr a)
sectionMap forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
name Map String (FGSectionDescr ParsecFieldGrammar a)
fgSectionMap of
Just (Left (SectionDescr String
_ [FieldDescr b]
fieldDescrs' [SectionDescr b]
sectionDescrs' a -> [(String, b)]
_ LineNo -> String -> b -> a -> ParseResult a
set b
sectionEmpty)) -> do
b
b <- forall a.
[FieldDescr a]
-> [SectionDescr a]
-> [FGSectionDescr ParsecFieldGrammar a]
-> a
-> [Field]
-> ParseResult a
parseFieldsAndSections [FieldDescr b]
fieldDescrs' [SectionDescr b]
sectionDescrs' [] b
sectionEmpty [Field]
fields
LineNo -> String -> b -> a -> ParseResult a
set LineNo
line String
param b
b a
a
Just (Right (FGSectionDescr String
_ ParsecFieldGrammar s s
grammar a -> [(String, s)]
_getter LineNo -> String -> s -> a -> ParseResult a
setter)) -> do
let fields1 :: [Field Position]
fields1 = forall a b. (a -> b) -> [a] -> [b]
map Field -> Field Position
convertField [Field]
fields
(Fields Position
fields2, [[Section Position]]
sections) = forall ann. [Field ann] -> (Fields ann, [[Section ann]])
partitionFields [Field Position]
fields1
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Section Position]]
sections) forall a b. (a -> b) -> a -> b
$ \(FG.MkSection (F.Name (Position LineNo
line' LineNo
_) FieldName
name') [SectionArg Position]
_ [Field Position]
_) ->
String -> ParseResult ()
warning forall a b. (a -> b) -> a -> b
$ String
"Unrecognized section '" forall a. [a] -> [a] -> [a]
++ FieldName -> String
fromUTF8BS FieldName
name'
forall a. [a] -> [a] -> [a]
++ String
"' on line " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show LineNo
line'
case forall a.
ParseResult a
-> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
runParseResult forall a b. (a -> b) -> a -> b
$ forall s a.
CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar s a -> ParseResult a
parseFieldGrammar CabalSpecVersion
cabalSpecLatest Fields Position
fields2 ParsecFieldGrammar s s
grammar of
([PWarning]
warnings, Right s
b) -> do
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [PWarning]
warnings forall a b. (a -> b) -> a -> b
$ \PWarning
w -> String -> ParseResult ()
warning forall a b. (a -> b) -> a -> b
$ String -> PWarning -> String
showPWarning String
"???" PWarning
w
LineNo -> String -> s -> a -> ParseResult a
setter LineNo
line String
param s
b a
a
([PWarning]
warnings, Left (Maybe Version
_, NonEmpty PError
errs)) -> do
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [PWarning]
warnings forall a b. (a -> b) -> a -> b
$ \PWarning
w -> String -> ParseResult ()
warning forall a b. (a -> b) -> a -> b
$ String -> PWarning -> String
showPWarning String
"???" PWarning
w
case NonEmpty PError
errs of
PError
err :| [PError]
_errs -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String -> PError -> String
showPError String
"???" PError
err
Maybe
(Either (SectionDescr a) (FGSectionDescr ParsecFieldGrammar a))
Nothing -> do
String -> ParseResult ()
warning forall a b. (a -> b) -> a -> b
$ String
"Unrecognized section '" forall a. [a] -> [a] -> [a]
++ String
name
forall a. [a] -> [a] -> [a]
++ String
"' on line " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show LineNo
line
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
convertField :: Field -> F.Field Position
convertField :: Field -> Field Position
convertField (F LineNo
line String
name String
str) =
forall ann. Name ann -> [FieldLine ann] -> Field ann
F.Field (forall ann. ann -> FieldName -> Name ann
F.Name Position
pos (String -> FieldName
toUTF8BS String
name)) [ forall ann. ann -> FieldName -> FieldLine ann
F.FieldLine Position
pos forall a b. (a -> b) -> a -> b
$ String -> FieldName
toUTF8BS String
str ]
where
pos :: Position
pos = LineNo -> LineNo -> Position
Position LineNo
line LineNo
0
convertField (Section LineNo
line String
name String
_arg [Field]
fields) =
forall ann.
Name ann -> [SectionArg ann] -> [Field ann] -> Field ann
F.Section (forall ann. ann -> FieldName -> Name ann
F.Name Position
pos (String -> FieldName
toUTF8BS String
name)) [] (forall a b. (a -> b) -> [a] -> [b]
map Field -> Field Position
convertField [Field]
fields)
where
pos :: Position
pos = LineNo -> LineNo -> Position
Position LineNo
line LineNo
0
ppFieldsAndSections :: [FieldDescr a] -> [SectionDescr a] -> [FGSectionDescr FG.PrettyFieldGrammar a] -> a -> Disp.Doc
ppFieldsAndSections :: forall a.
[FieldDescr a]
-> [SectionDescr a]
-> [FGSectionDescr PrettyFieldGrammar a]
-> a
-> Doc
ppFieldsAndSections [FieldDescr a]
fieldDescrs [SectionDescr a]
sectionDescrs [FGSectionDescr PrettyFieldGrammar a]
fgSectionDescrs a
val =
forall a. [FieldDescr a] -> Maybe a -> a -> Doc
ppFields [FieldDescr a]
fieldDescrs forall a. Maybe a
Nothing a
val
Doc -> Doc -> Doc
$+$
[Doc] -> Doc
Disp.vcat (
[ String -> Doc
Disp.text String
"" Doc -> Doc -> Doc
$+$ Doc
sectionDoc
| SectionDescr {
String
sectionName :: String
sectionName :: forall a. SectionDescr a -> String
sectionName, a -> [(String, b)]
sectionGet :: a -> [(String, b)]
sectionGet :: ()
sectionGet,
[FieldDescr b]
sectionFields :: [FieldDescr b]
sectionFields :: ()
sectionFields, [SectionDescr b]
sectionSubsections :: [SectionDescr b]
sectionSubsections :: ()
sectionSubsections
} <- [SectionDescr a]
sectionDescrs
, (String
param, b
x) <- a -> [(String, b)]
sectionGet a
val
, let sectionDoc :: Doc
sectionDoc = forall a.
String
-> String
-> [FieldDescr a]
-> [SectionDescr a]
-> [FGSectionDescr PrettyFieldGrammar a]
-> a
-> Doc
ppSectionAndSubsections
String
sectionName String
param
[FieldDescr b]
sectionFields [SectionDescr b]
sectionSubsections [] b
x
, Bool -> Bool
not (Doc -> Bool
Disp.isEmpty Doc
sectionDoc)
] forall a. [a] -> [a] -> [a]
++
[ String -> Doc
Disp.text String
"" Doc -> Doc -> Doc
$+$ Doc
sectionDoc
| FGSectionDescr { String
fgSectionName :: String
fgSectionName :: forall (g :: * -> * -> *) a. FGSectionDescr g a -> String
fgSectionName, PrettyFieldGrammar s s
fgSectionGrammar :: PrettyFieldGrammar s s
fgSectionGrammar :: ()
fgSectionGrammar, a -> [(String, s)]
fgSectionGet :: a -> [(String, s)]
fgSectionGet :: ()
fgSectionGet } <- [FGSectionDescr PrettyFieldGrammar a]
fgSectionDescrs
, (String
param, s
x) <- a -> [(String, s)]
fgSectionGet a
val
, let sectionDoc :: Doc
sectionDoc = forall a. String -> String -> PrettyFieldGrammar a a -> a -> Doc
ppFgSection String
fgSectionName String
param PrettyFieldGrammar s s
fgSectionGrammar s
x
, Bool -> Bool
not (Doc -> Bool
Disp.isEmpty Doc
sectionDoc)
])
ppSectionAndSubsections :: String -> String
-> [FieldDescr a] -> [SectionDescr a] -> [FGSectionDescr FG.PrettyFieldGrammar a] -> a -> Disp.Doc
ppSectionAndSubsections :: forall a.
String
-> String
-> [FieldDescr a]
-> [SectionDescr a]
-> [FGSectionDescr PrettyFieldGrammar a]
-> a
-> Doc
ppSectionAndSubsections String
name String
arg [FieldDescr a]
fields [SectionDescr a]
sections [FGSectionDescr PrettyFieldGrammar a]
fgSections a
cur
| Doc -> Bool
Disp.isEmpty Doc
fieldsDoc = Doc
Disp.empty
| Bool
otherwise = String -> Doc
Disp.text String
name Doc -> Doc -> Doc
<+> Doc
argDoc
Doc -> Doc -> Doc
$+$ (LineNo -> Doc -> Doc
Disp.nest LineNo
2 Doc
fieldsDoc)
where
fieldsDoc :: Doc
fieldsDoc = forall a.
[FieldDescr a]
-> [SectionDescr a]
-> [FGSectionDescr PrettyFieldGrammar a]
-> a
-> Doc
showConfig [FieldDescr a]
fields [SectionDescr a]
sections [FGSectionDescr PrettyFieldGrammar a]
fgSections a
cur
argDoc :: Doc
argDoc | String
arg forall a. Eq a => a -> a -> Bool
== String
"" = Doc
Disp.empty
| Bool
otherwise = String -> Doc
Disp.text String
arg
ppFgSection
:: String
-> String
-> FG.PrettyFieldGrammar a a
-> a
-> Disp.Doc
ppFgSection :: forall a. String -> String -> PrettyFieldGrammar a a -> a -> Doc
ppFgSection String
secName String
arg PrettyFieldGrammar a a
grammar a
x
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PrettyField ()]
prettyFields = Doc
Disp.empty
| Bool
otherwise =
String -> Doc
Disp.text String
secName Doc -> Doc -> Doc
<+> Doc
argDoc
Doc -> Doc -> Doc
$+$ (LineNo -> Doc -> Doc
Disp.nest LineNo
2 Doc
fieldsDoc)
where
prettyFields :: [PrettyField ()]
prettyFields = forall s a.
CabalSpecVersion -> PrettyFieldGrammar s a -> s -> [PrettyField ()]
FG.prettyFieldGrammar CabalSpecVersion
cabalSpecLatest PrettyFieldGrammar a a
grammar a
x
argDoc :: Doc
argDoc | String
arg forall a. Eq a => a -> a -> Bool
== String
"" = Doc
Disp.empty
| Bool
otherwise = String -> Doc
Disp.text String
arg
fieldsDoc :: Doc
fieldsDoc = [Doc] -> Doc
Disp.vcat
[ String -> Doc
Disp.text String
fname' Doc -> Doc -> Doc
<<>> Doc
Disp.colon Doc -> Doc -> Doc
<<>> Doc
doc
| F.PrettyField ()
_ FieldName
fname Doc
doc <- [PrettyField ()]
prettyFields
, let fname' :: String
fname' = FieldName -> String
fromUTF8BS FieldName
fname
]
parseConfig :: [FieldDescr a] -> [SectionDescr a] -> [FGSectionDescr FG.ParsecFieldGrammar a] -> a
-> BS.ByteString -> ParseResult a
parseConfig :: forall a.
[FieldDescr a]
-> [SectionDescr a]
-> [FGSectionDescr ParsecFieldGrammar a]
-> a
-> FieldName
-> ParseResult a
parseConfig [FieldDescr a]
fieldDescrs [SectionDescr a]
sectionDescrs [FGSectionDescr ParsecFieldGrammar a]
fgSectionDescrs a
empty FieldName
str =
forall a.
[FieldDescr a]
-> [SectionDescr a]
-> [FGSectionDescr ParsecFieldGrammar a]
-> a
-> [Field]
-> ParseResult a
parseFieldsAndSections [FieldDescr a]
fieldDescrs [SectionDescr a]
sectionDescrs [FGSectionDescr ParsecFieldGrammar a]
fgSectionDescrs a
empty
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FieldName -> ParseResult [Field]
readFields FieldName
str
showConfig :: [FieldDescr a] -> [SectionDescr a] -> [FGSectionDescr FG.PrettyFieldGrammar a] -> a -> Disp.Doc
showConfig :: forall a.
[FieldDescr a]
-> [SectionDescr a]
-> [FGSectionDescr PrettyFieldGrammar a]
-> a
-> Doc
showConfig = forall a.
[FieldDescr a]
-> [SectionDescr a]
-> [FGSectionDescr PrettyFieldGrammar a]
-> a
-> Doc
ppFieldsAndSections