{-# LANGUAGE PatternGuards #-}
module Text.XML.HaXml.Schema.Environment
  ( module Text.XML.HaXml.Schema.Environment
  ) where

import Text.XML.HaXml.Types (QName(..),Name(..),Namespace(..))
import Text.XML.HaXml.Schema.XSDTypeModel
import Text.XML.HaXml.Schema.NameConversion (wordsBy)
import Text.XML.HaXml.Schema.Parse (targetPrefix)

import qualified Data.Map as Map
import Data.Map (Map)
import Data.List (foldl')

-- Some things we probably want to do.
-- * Build Maps from :
--       typename        to definition
--       element name    to definition
--       attribute name  to definition
--       (element) group to definition
--       attribute group to definition
--       abstract complextype to its extension types
--       substitution group to its substitutable elements
--       abstract/substGroup to defining module
-- * XSD types become top-level types in Haskell.
-- * XSD element decls also become top-level types in Haskell.
-- * Element groups get their own Haskell types too.
-- * Attributes and attribute groups do not become types, they are
--   simply constituent parts of an element.
-- * Resolve element/attribute references by inlining their names.

-- If a complextype definition includes nested in-line decls of other
-- types, we need to be able to lift them out to the top-level, then
-- refer to them by name only at the nested position(?)

-- When dealing with sub/supertype relationships, we often need to know all
-- of the subtypes of a supertype before some of the subtypes are actually
-- available in scope.  The environment must therefore first be closed
-- over all modules: the resulting type mapping (env_type) should be _copied_
-- across to (env_allTypes) in a fresh initial environment, which latter is
-- then used to rebuild the local scope from scratch.
-- Likewise, the mappings from supertype->subtype (env_extendty) and for
-- substitution groups (env_substGrp) also need to be global.

data Environment =  Environment
    { Environment -> Map QName (Either SimpleType ComplexType)
env_type      :: Map QName (Either SimpleType ComplexType)
                                 -- ^ type definitions in scope
    , Environment -> Map QName (Either SimpleType ComplexType)
env_allTypes  :: Map QName (Either SimpleType ComplexType)
                                 -- ^ all type definitions, regardless of scope
    , Environment -> Map QName ElementDecl
env_element   :: Map QName ElementDecl
    , Environment -> Map QName AttributeDecl
env_attribute :: Map QName AttributeDecl
    , Environment -> Map QName Group
env_group     :: Map QName Group
    , Environment -> Map QName AttrGroup
env_attrgroup :: Map QName AttrGroup
    , Environment -> Map String String
env_namespace :: Map String{-URI-} String{-Prefix-}
    , Environment -> Map QName [(QName, String)]
env_extendty  :: Map QName [(QName,FilePath)] -- ^ supertype -> subtypes
    , Environment -> Map QName [(QName, String)]
env_substGrp  :: Map QName [(QName,FilePath)] -- ^ substitution groups
    , Environment -> Map QName String
env_typeloc   :: Map QName FilePath           -- ^ where type is defined
    }

-- | An empty environment of XSD type mappings.
emptyEnv :: Environment
emptyEnv :: Environment
emptyEnv = Map QName (Either SimpleType ComplexType)
-> Map QName (Either SimpleType ComplexType)
-> Map QName ElementDecl
-> Map QName AttributeDecl
-> Map QName Group
-> Map QName AttrGroup
-> Map String String
-> Map QName [(QName, String)]
-> Map QName [(QName, String)]
-> Map QName String
-> Environment
Environment Map QName (Either SimpleType ComplexType)
forall k a. Map k a
Map.empty Map QName (Either SimpleType ComplexType)
forall k a. Map k a
Map.empty Map QName ElementDecl
forall k a. Map k a
Map.empty Map QName AttributeDecl
forall k a. Map k a
Map.empty Map QName Group
forall k a. Map k a
Map.empty
                       Map QName AttrGroup
forall k a. Map k a
Map.empty Map String String
forall k a. Map k a
Map.empty Map QName [(QName, String)]
forall k a. Map k a
Map.empty Map QName [(QName, String)]
forall k a. Map k a
Map.empty Map QName String
forall k a. Map k a
Map.empty

-- | Combine two environments (e.g. read from different interface files)
combineEnv :: Environment -> Environment -> Environment
combineEnv :: Environment -> Environment -> Environment
combineEnv e1 :: Environment
e1 e0 :: Environment
e0 = Environment :: Map QName (Either SimpleType ComplexType)
-> Map QName (Either SimpleType ComplexType)
-> Map QName ElementDecl
-> Map QName AttributeDecl
-> Map QName Group
-> Map QName AttrGroup
-> Map String String
-> Map QName [(QName, String)]
-> Map QName [(QName, String)]
-> Map QName String
-> Environment
Environment
    { env_type :: Map QName (Either SimpleType ComplexType)
env_type      = Map QName (Either SimpleType ComplexType)
-> Map QName (Either SimpleType ComplexType)
-> Map QName (Either SimpleType ComplexType)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (Environment -> Map QName (Either SimpleType ComplexType)
env_type Environment
e1)      (Environment -> Map QName (Either SimpleType ComplexType)
env_type Environment
e0)
    , env_allTypes :: Map QName (Either SimpleType ComplexType)
env_allTypes  = Map QName (Either SimpleType ComplexType)
-> Map QName (Either SimpleType ComplexType)
-> Map QName (Either SimpleType ComplexType)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (Environment -> Map QName (Either SimpleType ComplexType)
env_allTypes Environment
e1)  (Environment -> Map QName (Either SimpleType ComplexType)
env_allTypes Environment
e0)
    , env_element :: Map QName ElementDecl
env_element   = Map QName ElementDecl
-> Map QName ElementDecl -> Map QName ElementDecl
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (Environment -> Map QName ElementDecl
env_element Environment
e1)   (Environment -> Map QName ElementDecl
env_element Environment
e0)
    , env_attribute :: Map QName AttributeDecl
env_attribute = Map QName AttributeDecl
-> Map QName AttributeDecl -> Map QName AttributeDecl
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (Environment -> Map QName AttributeDecl
env_attribute Environment
e1) (Environment -> Map QName AttributeDecl
env_attribute Environment
e0)
    , env_group :: Map QName Group
env_group     = Map QName Group -> Map QName Group -> Map QName Group
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (Environment -> Map QName Group
env_group Environment
e1)     (Environment -> Map QName Group
env_group Environment
e0)
    , env_attrgroup :: Map QName AttrGroup
env_attrgroup = Map QName AttrGroup -> Map QName AttrGroup -> Map QName AttrGroup
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (Environment -> Map QName AttrGroup
env_attrgroup Environment
e1) (Environment -> Map QName AttrGroup
env_attrgroup Environment