content: -- | A utility for converting a BNF grammar to a Hydra module.
  
  module Hydra.Grammars where
  
  import qualified Hydra.Annotations as Annotations
  import qualified Hydra.Constants as Constants
  import qualified Hydra.Core as Core
  import qualified Hydra.Formatting as Formatting
  import qualified Hydra.Grammar as Grammar
  import qualified Hydra.Lib.Equality as Equality
  import qualified Hydra.Lib.Lists as Lists
  import qualified Hydra.Lib.Literals as Literals
  import qualified Hydra.Lib.Logic as Logic
  import qualified Hydra.Lib.Maps as Maps
  import qualified Hydra.Lib.Math as Math
  import qualified Hydra.Lib.Optionals as Optionals
  import qualified Hydra.Lib.Strings as Strings
  import qualified Hydra.Module as Module
  import qualified Hydra.Names as Names
  import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)
  import qualified Data.Int as I
  import qualified Data.List as L
  import qualified Data.Map as M
  import qualified Data.Set as S
  
  -- | Generate child name
  childName :: (String -> String -> String)
  childName lname n = (Strings.cat [
    lname,
    "_",
    (Formatting.capitalize n)])
  
  -- | Find unique names for patterns
  findNames :: ([Grammar.Pattern] -> [String])
  findNames pats =  
    let nextName = (\acc -> \pat ->  
            let names = (fst acc) 
                nameMap = (snd acc)
                rn = (rawName pat)
                nameAndIndex = (Optionals.maybe (rn, 1) (\i -> (Strings.cat2 rn (Literals.showInt32 (Math.add i 1)), (Math.add i 1))) (Maps.lookup rn nameMap))
                nn = (fst nameAndIndex)
                ni = (snd nameAndIndex)
            in (Lists.cons nn names, (Maps.insert rn ni nameMap)))
    in (Lists.reverse (fst (Lists.foldl nextName ([], Maps.empty) pats)))
  
  -- | Convert a BNF grammar to a Hydra module
  grammarToModule :: (Module.Namespace -> Grammar.Grammar -> Maybe String -> Module.Module)
  grammarToModule ns grammar desc =  
    let prodPairs = (Lists.map (\prod -> (Grammar.unSymbol (Grammar.productionSymbol prod), (Grammar.productionPattern prod))) (Grammar.unGrammar grammar)) 
        capitalizedNames = (Lists.map (\pair -> Formatting.capitalize (fst pair)) prodPairs)
        patterns = (Lists.map (\pair -> snd pair) prodPairs)
        elementPairs = (Lists.concat (Lists.zipWith (makeElements False ns) capitalizedNames patterns))
        elements = (Lists.map (\pair ->  
                let lname = (fst pair) 
                    typ = (wrapType (snd pair))
                in (Annotations.typeElement (toName ns lname) typ)) elementPairs)
    in Module.Module {
      Module.moduleNamespace = ns,
      Module.moduleElements = elements,
      Module.moduleTermDependencies = [],
      Module.moduleTypeDependencies = [],
      Module.moduleDescription = desc}
  
  -- | Check if pattern is complex
  isComplex :: (Grammar.Pattern -> Bool)
  isComplex pat = ((\x -> case x of
    Grammar.PatternLabeled v1 -> (isComplex (Grammar.labeledPatternPattern v1))
    Grammar.PatternSequence v1 -> (isNontrivial True v1)
    Grammar.PatternAlternatives v1 -> (isNontrivial False v1)
    _ -> False) pat)
  
  -- | Check if patterns are nontrivial
  isNontrivial :: (Bool -> [Grammar.Pattern] -> Bool)
  isNontrivial isRecord pats =  
    let minPats = (simplify isRecord pats)
    in (Logic.ifElse (Equality.equal (Lists.length minPats) 1) ((\x -> case x of
      Grammar.PatternLabeled _ -> True
      _ -> False) (Lists.head minPats)) True)
  
  -- | Create elements from pattern
  makeElements :: (Bool -> Module.Namespace -> String -> Grammar.Pattern -> [(String, Core.Type)])
  makeElements omitTrivial ns lname pat =  
    let trivial = (Logic.ifElse omitTrivial [] [
            (lname, Core.TypeUnit)]) 
        forRecordOrUnion = (\isRecord -> \construct -> \pats ->  
                let minPats = (simplify isRecord pats) 
                    fieldNames = (findNames minPats)
                    toField = (\n -> \p -> descend n (\pairs -> (Core.FieldType {
                            Core.fieldTypeName = (Core.Name n),
                            Core.fieldTypeType = (snd (Lists.head pairs))}, (Lists.tail pairs))) p)
                    fieldPairs = (Lists.zipWith toField fieldNames minPats)
                    fields = (Lists.map fst fieldPairs)
                    els = (Lists.concat (Lists.map snd fieldPairs))
                in (Logic.ifElse (isNontrivial isRecord pats) (Lists.cons (lname, (construct fields)) els) (forPat (Lists.head minPats))))
        mod = (\n -> \f -> \p -> descend n (\pairs -> Lists.cons (lname, (f (snd (Lists.head pairs)))) (Lists.tail pairs)) p)
        descend = (\n -> \f -> \p ->  
                let cpairs = (makeElements False ns (childName lname n) p)
                in (f (Logic.ifElse (isComplex p) (Lists.cons (lname, (Core.TypeVariable (toName ns (fst (Lists.head cpairs))))) cpairs) (Logic.ifElse (Lists.null cpairs) [
                  (lname, Core.TypeUnit)] (Lists.cons (lname, (snd (Lists.head cpairs))) (Lists.tail cpairs))))))
        forPat = (\pat -> (\x -> case x of
                Grammar.PatternAlternatives v1 -> (forRecordOrUnion False (\fields -> Core.TypeUnion (Core.RowType {
                  Core.rowTypeTypeName = Constants.placeholderName,
                  Core.rowTypeFields = fields})) v1)
                Grammar.PatternConstant _ -> trivial
                Grammar.PatternIgnored _ -> []
                Grammar.PatternLabeled v1 -> (forPat (Grammar.labeledPatternPattern v1))
                Grammar.PatternNil -> trivial
                Grammar.PatternNonterminal v1 -> [
                  (lname, (Core.TypeVariable (toName ns (Grammar.unSymbol v1))))]
                Grammar.PatternOption v1 -> (mod "Option" (\x -> Core.TypeOptional x) v1)
                Grammar.PatternPlus v1 -> (mod "Elmt" (\x -> Core.TypeList x) v1)
                Grammar.PatternRegex _ -> [
                  (lname, (Core.TypeLiteral Core.LiteralTypeString))]
                Grammar.PatternSequence v1 -> (forRecordOrUnion True (\fields -> Core.TypeRecord (Core.RowType {
                  Core.rowTypeTypeName = Constants.placeholderName,
                  Core.rowTypeFields = fields})) v1)
                Grammar.PatternStar v1 -> (mod "Elmt" (\x -> Core.TypeList x) v1)) pat)
    in (forPat pat)
  
  -- | Get raw name from pattern
  rawName :: (Grammar.Pattern -> String)
  rawName pat = ((\x -> case x of
    Grammar.PatternAlternatives _ -> "alts"
    Grammar.PatternConstant v1 -> (Formatting.capitalize (Formatting.withCharacterAliases (Grammar.unConstant v1)))
    Grammar.PatternIgnored _ -> "ignored"
    Grammar.PatternLabeled v1 -> (Grammar.unLabel (Grammar.labeledPatternLabel v1))
    Grammar.PatternNil -> "none"
    Grammar.PatternNonterminal v1 -> (Formatting.capitalize (Grammar.unSymbol v1))
    Grammar.PatternOption v1 -> (Formatting.capitalize (rawName v1))
    Grammar.PatternPlus v1 -> (Strings.cat2 "listOf" (Formatting.capitalize (rawName v1)))
    Grammar.PatternRegex _ -> "regex"
    Grammar.PatternSequence _ -> "sequence"
    Grammar.PatternStar v1 -> (Strings.cat2 "listOf" (Formatting.capitalize (rawName v1)))) pat)
  
  -- | Remove trivial patterns from records
  simplify :: (Bool -> [Grammar.Pattern] -> [Grammar.Pattern])
  simplify isRecord pats =  
    let isConstant = (\p -> (\x -> case x of
            Grammar.PatternConstant _ -> True
            _ -> False) p)
    in (Logic.ifElse isRecord (Lists.filter (\p -> Logic.not (isConstant p)) pats) pats)
  
  -- | Convert local name to qualified name
  toName :: (Module.Namespace -> String -> Core.Name)
  toName ns local = (Names.unqualifyName (Module.QualifiedName {
    Module.qualifiedNameNamespace = (Just ns),
    Module.qualifiedNameLocal = local}))
  
  -- | Wrap a type in a placeholder name, unless it is already a wrapper, record, or union type
  wrapType :: (Core.Type -> Core.Type)
  wrapType t = ((\x -> case x of
    Core.TypeRecord _ -> t
    Core.TypeUnion _ -> t
    Core.TypeWrap _ -> t
    _ -> (Core.TypeWrap (Core.WrappedType {
      Core.wrappedTypeTypeName = (Core.Name "Placeholder"),
      Core.wrappedTypeObject = t}))) t)
  