content: 
  module DDC.Driver.Command.RewriteRules
          ( cmdTryReadRules )
  where
  import DDC.Driver.Interface.Source
  import DDC.Build.Language
  import DDC.Core.Fragment
  import DDC.Core.Simplifier
  import DDC.Core.Module
  import DDC.Core.Codec.Text.Lexer
  import DDC.Core.Codec.Text.Pretty
  import DDC.Core.Exp
  import DDC.Core.Transform.Reannotate
  import DDC.Core.Transform.Rewrite.Rule  hiding (Error)
  import DDC.Core.Transform.Rewrite.Parser
  import System.Directory
  import System.IO
  import qualified DDC.Control.Parser             as BP
  import qualified DDC.Core.Check                 as C
  import qualified DDC.Core.Codec.Text.Parser     as C
  import qualified DDC.Type.Env                   as Env
  import qualified DDC.Core.Env.EnvX              as EnvX
  
  
  -- Read rewrite rules ---------------------------------------------------------
  -- | Load and typecheck a module's rewrite rules, using exported and imported
  --   definitions from module
  cmdTryReadRules
          :: (Ord n, Show n, Pretty n)
          => Fragment n err       -- ^ Language fragment.
          -> FilePath             -- ^ Path to the module.
          -> Module () n          -- ^ Module with types of imports and exports
          -> IO (NamedRewriteRules () n)
  
  cmdTryReadRules frag filePath modu
   = do
          exists  <- doesFileExist filePath
          -- Silently return an empty list if there is no rules file
          case exists of
           False -> return []
           True  -> do
              -- Read the source file
              src        <- readFile filePath
              let source =  SourceFile filePath
              -- Parse and typecheck
              cmdReadRules_parse filePath frag modu source src
  
  
  cmdReadRules_parse filePath frag modu source src
   = case parse frag modu source src of
      Left err -> do
          putStrLn $ "When reading " ++ filePath
          hPutStrLn stderr err
          return []
      Right rules -> return rules
  
  
  parse fragment modu source str
   = case BP.runTokenParser describeToken source'
          (pRuleMany (C.contextOfProfile (fragmentProfile fragment)))
            (fragmentLexExp fragment source' 0 str) of
                  Left err -> Left $ renderIndent $ ppr err
                  Right rules ->
                    case mapM check' rules of
                      Left err     -> Left  $ renderIndent $ ppr err
                      Right rules' -> Right $ rules'
   where
      -- Typecheck, then clear annotations
      check' (n,r)
       = do r' <- checkRewriteRule config env' r
            return (show n, reannotate (const ()) r')
  
      profile     = fragmentProfile fragment
      config      = C.configOfProfile   profile
      kinds       = profilePrimKinds    profile
      types       = profilePrimTypes    profile
      defs        = profilePrimDataDefs profile
  
      kindsImp    = moduleKindEnv modu
      typesImp    = moduleTypeEnv modu
  
      kindsExp    = Env.fromList
                  $ [BName n t | (n, Just t) <- map (liftSnd takeKindOfExportType)
                                             $  moduleExportTypes  modu ]
  
      typesExp    = Env.fromList
                  $ [BName n t | (n, Just t) <- map (liftSnd takeTypeOfExportValue)
                                             $  moduleExportValues modu ]
  
      liftSnd f (x, y) = (x, f y)
  
      -- Final kind and type environments
      kinds'      = kinds `Env.union` kindsImp `Env.union` kindsExp
      types'      = types `Env.union` typesImp `Env.union` typesExp
      env'        = EnvX.fromPrimEnvs kinds' types' defs
  
      source'  = nameOfSource source
  
  
  