Cabal-syntax/src/Distribution/FieldGrammar.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2 {-# LANGUAGE FlexibleInstances #-}
   3 {-# LANGUAGE ScopedTypeVariables #-}
   4
   5 -- | This module provides a way to specify a grammar of @.cabal@ -like files.
   6 module Distribution.FieldGrammar
   7   ( -- * Field grammar type
   8     FieldGrammar (..)
   9   , uniqueField
  10   , optionalField
  11   , optionalFieldDef
  12   , monoidalField
  13
  14     -- * Concrete grammar implementations
  15   , ParsecFieldGrammar
  16   , ParsecFieldGrammar'
  17   , parseFieldGrammar
  18   , fieldGrammarKnownFieldList
  19   , PrettyFieldGrammar
  20   , PrettyFieldGrammar'
  21   , prettyFieldGrammar
  22
  23     -- * Auxiliary
  24   , (^^^)
  25   , Section (..)
  26   , Fields
  27   , partitionFields
  28   , takeFields
  29   , runFieldParser
  30   , runFieldParser'
  31   , defaultFreeTextFieldDefST
  32
  33     -- * Newtypes
  34   , module Distribution.FieldGrammar.Newtypes
  35   ) where
  36
  37 import Distribution.Compat.Prelude
  38 import Prelude ()
  39
  40 import qualified Data.Map.Strict as Map
  41
  42 import Distribution.FieldGrammar.Class
  43 import Distribution.FieldGrammar.Newtypes
  44 import Distribution.FieldGrammar.Parsec
  45 import Distribution.FieldGrammar.Pretty
  46 import Distribution.Fields.Field
  47 import Distribution.Utils.Generic (spanMaybe)
  48
  49 type ParsecFieldGrammar' a = ParsecFieldGrammar a a
  50 type PrettyFieldGrammar' a = PrettyFieldGrammar a a
  51
  52 infixl 5 ^^^
  53
  54 -- | Reverse function application which binds tighter than '<$>' and '<*>'.
  55 -- Useful for refining grammar specification.
  56 --
  57 -- @
  58 -- \<*\> 'monoidalFieldAla' "extensions"           (alaList' FSep MQuoted)       oldExtensions
  59 --     ^^^ 'deprecatedSince' [1,12] "Please use 'default-extensions' or 'other-extensions' fields."
  60 -- @
  61 (^^^) :: a -> (a -> b) -> b
  62 x ^^^ f = f x
  63
  64 -- | Partitioning state
  65 data PS ann = PS (Fields ann) [Section ann] [[Section ann]]
  66
  67 -- | Partition field list into field map and groups of sections.
  68 partitionFields :: [Field ann] -> (Fields ann, [[Section ann]])
  69 partitionFields = finalize . foldl' f (PS mempty mempty mempty)
  70   where
  71     finalize :: PS ann -> (Fields ann, [[Section ann]])
  72     finalize (PS fs s ss)
  73       | null s = (fs, reverse ss)
  74       | otherwise = (fs, reverse (reverse s : ss))
  75
  76     f :: PS ann -> Field ann -> PS ann
  77     f (PS fs s ss) (Field (Name ann name) fss) =
  78       PS (Map.insertWith (flip (++)) name [MkNamelessField ann fss] fs) [] ss'
  79       where
  80         ss'
  81           | null s = ss
  82           | otherwise = reverse s : ss
  83     f (PS fs s ss) (Section name sargs sfields) =
  84       PS fs (MkSection name sargs sfields : s) ss
  85
  86 -- | Take all fields from the front.
  87 takeFields :: [Field ann] -> (Fields ann, [Field ann])
  88 takeFields = finalize . spanMaybe match
  89   where
  90     finalize (fs, rest) = (Map.fromListWith (flip (++)) fs, rest)
  91
  92     match (Field (Name ann name) fs) = Just (name, [MkNamelessField ann fs])
  93     match _ = Nothing