content: -- | Entry point for Hydra's adapter (type/term rewriting) framework
  
  module Hydra.Adapt.Modules where
  
  import qualified Hydra.Adapt.Terms as Terms
  import qualified Hydra.Adapt.Utils as Utils
  import qualified Hydra.Annotations as Annotations
  import qualified Hydra.Coders as Coders
  import qualified Hydra.Compute as Compute
  import qualified Hydra.Core as Core
  import qualified Hydra.Decode.Core as Core_
  import qualified Hydra.Describe.Core as Core__
  import qualified Hydra.Graph as Graph
  import qualified Hydra.Lexical as Lexical
  import qualified Hydra.Lib.Flows as Flows
  import qualified Hydra.Lib.Lists as Lists
  import qualified Hydra.Lib.Logic as Logic
  import qualified Hydra.Lib.Maps as Maps
  import qualified Hydra.Lib.Optionals as Optionals
  import qualified Hydra.Lib.Sets as Sets
  import qualified Hydra.Lib.Strings as Strings
  import qualified Hydra.Module as Module
  import qualified Hydra.Monads as Monads
  import qualified Hydra.Rewriting as Rewriting
  import qualified Hydra.Schemas as Schemas
  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
  
  adaptTypeToLanguageAndEncode :: (Coders.Language -> (Core.Type -> Compute.Flow Graph.Graph t0) -> Core.Type -> Compute.Flow Graph.Graph t0)
  adaptTypeToLanguageAndEncode lang enc typ = ((\x -> case x of
    Core.TypeVariable _ -> (enc typ)
    _ -> (Flows.bind (adaptTypeToLanguage lang typ) (\adaptedType -> enc adaptedType))) (Rewriting.deannotateType typ))
  
  -- | Given a target language and a source type, find the target type to which the latter will be adapted
  adaptTypeToLanguage :: (Coders.Language -> Core.Type -> Compute.Flow Graph.Graph Core.Type)
  adaptTypeToLanguage lang typ = (Flows.bind (languageAdapter lang typ) (\adapter -> Flows.pure (Compute.adapterTarget adapter)))
  
  -- | Map a Hydra module to a list of type and/or term definitions which have been adapted to the target language
  adaptedModuleDefinitions :: (Coders.Language -> Module.Module -> Compute.Flow Graph.Graph [Module.Definition])
  adaptedModuleDefinitions lang mod =  
    let els = (Module.moduleElements mod) 
        adaptersFor = (\types -> Flows.bind (Flows.mapList (languageAdapter lang) types) (\adapters -> Flows.pure (Maps.fromList (Lists.zip types adapters))))
        classify = (\adapters -> \pair ->  
                let el = (fst pair) 
                    tt = (snd pair)
                    term = (Core.typedTermTerm tt)
                    typ = (Core.typedTermType tt)
                    name = (Core.bindingName el)
                in (Logic.ifElse (Annotations.isNativeType el) (Flows.bind (Flows.bind (Core_.type_ term) (\coreTyp -> adaptTypeToLanguage lang coreTyp)) (\adaptedTyp -> Flows.pure (Module.DefinitionType (Module.TypeDefinition {
                  Module.typeDefinitionName = name,
                  Module.typeDefinitionType = adaptedTyp})))) (Optionals.maybe (Flows.fail (Strings.cat2 "no adapter for element " (Core.unName name))) (\adapter -> Flows.bind (Compute.coderEncode (Compute.adapterCoder adapter) term) (\adapted -> Flows.pure (Module.DefinitionTerm (Module.TermDefinition {
                  Module.termDefinitionName = name,
                  Module.termDefinitionTerm = adapted,
                  Module.termDefinitionType = (Compute.adapterTarget adapter)})))) (Maps.lookup typ adapters))))
    in (Flows.bind (Lexical.withSchemaContext (Flows.mapList Schemas.elementAsTypedTerm els)) (\tterms ->  
      let types = (Sets.toList (Sets.fromList (Lists.map (\arg_ -> Rewriting.deannotateType (Core.typedTermType arg_)) tterms)))
      in (Flows.bind (adaptersFor types) (\adapters -> Flows.mapList (classify adapters) (Lists.zip els tterms)))))
  
  constructCoder :: (Coders.Language -> (Core.Term -> Compute.Flow t0 t1) -> Core.Type -> Compute.Flow Graph.Graph (Compute.Coder t0 t2 Core.Term t1))
  constructCoder lang encodeTerm typ = (Monads.withTrace (Strings.cat2 "coder for " (Core__.type_ typ)) (Flows.bind (languageAdapter lang typ) (\adapter -> Flows.pure (Utils.composeCoders (Compute.adapterCoder adapter) (Utils.unidirectionalCoder encodeTerm)))))
  
  languageAdapter :: (Coders.Language -> Core.Type -> Compute.Flow Graph.Graph (Compute.Adapter t0 t1 Core.Type Core.Type Core.Term Core.Term))
  languageAdapter lang typ = (Flows.bind Monads.getState (\g ->  
    let cx0 = Coders.AdapterContext {
            Coders.adapterContextGraph = g,
            Coders.adapterContextLanguage = lang,
            Coders.adapterContextAdapters = Maps.empty}
    in (Flows.bind (Monads.withState cx0 (Flows.bind (Terms.termAdapter typ) (\ad -> Flows.bind Monads.getState (\cx -> Flows.pure (ad, cx))))) (\result ->  
      let adapter = (fst result) 
          cx = (snd result)
          encode = (\term -> Monads.withState cx (Compute.coderEncode (Compute.adapterCoder adapter) term))
          decode = (\term -> Monads.withState cx (Compute.coderDecode (Compute.adapterCoder adapter) term))
          ac = Compute.Coder {
                  Compute.coderEncode = encode,
                  Compute.coderDecode = decode}
      in (Flows.pure (Compute.Adapter {
        Compute.adapterIsLossy = (Compute.adapterIsLossy adapter),
        Compute.adapterSource = (Compute.adapterSource adapter),
        Compute.adapterTarget = (Compute.adapterTarget adapter),
        Compute.adapterCoder = ac}))))))
  
  transformModule :: (Coders.Language -> (Core.Term -> Compute.Flow t0 t1) -> (Module.Module -> M.Map Core.Type (Compute.Coder t0 t2 Core.Term t1) -> [(Core.Binding, Core.TypedTerm)] -> Compute.Flow Graph.Graph t3) -> Module.Module -> Compute.Flow Graph.Graph t3)
  transformModule lang encodeTerm createModule mod = (Monads.withTrace (Strings.cat2 "transform module " (Module.unNamespace (Module.moduleNamespace mod))) ( 
    let els = (Module.moduleElements mod) 
        codersFor = (\types -> Flows.bind (Flows.mapList (constructCoder lang encodeTerm) types) (\cdrs -> Flows.pure (Maps.fromList (Lists.zip types cdrs))))
    in (Flows.bind (Lexical.withSchemaContext (Flows.mapList Schemas.elementAsTypedTerm els)) (\tterms ->  
      let types = (Lists.nub (Lists.map Core.typedTermType tterms))
      in (Flows.bind (codersFor types) (\coders -> createModule mod coders (Lists.zip els tterms)))))))
  