{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- | This module provides a way to specify a grammar of @.cabal@ -like files.
module Distribution.FieldGrammar  (
    -- * Field grammar type
    FieldGrammar (..),
    uniqueField,
    optionalField,
    optionalFieldDef,
    monoidalField,
    -- * Concrete grammar implementations
    ParsecFieldGrammar,
    ParsecFieldGrammar',
    parseFieldGrammar,
    fieldGrammarKnownFieldList,
    PrettyFieldGrammar,
    PrettyFieldGrammar',
    prettyFieldGrammar,
    -- * Auxlilary
    (^^^),
    Section(..),
    Fields,
    partitionFields,
    takeFields,
    runFieldParser,
    runFieldParser',
    defaultFreeTextFieldDefST,
    -- * Newtypes
    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 ^^^

-- | Reverse function application which binds tighter than '<$>' and '<*>'.
-- Useful for refining grammar specification.
--
-- @
-- \<*\> 'monoidalFieldAla' "extensions"           (alaList' FSep MQuoted)       oldExtensions
--     ^^^ 'deprecatedSince' [1,12] "Please use 'default-extensions' or 'other-extensions' fields."
-- @
(^^^) :: a -> (a -> b) -> b
a
x ^^^ :: forall a b. a -> (a -> b) -> b
^^^ a -> b
f = a -> b
f a
x

-- | Partitioning state
data PS ann = PS (Fields ann) [Section ann] [[Section ann]]

-- | Partition field list into field map and groups of sections.
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

-- | Take all fields from the front.
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