-- UUAGC 0.9.32 (src/Errs.ag)
module Errs(errsToStr, prettyErrs, Errs, Err(..), debugMsg, nullErrs) where

{-# LINE 6 "src/Errs.ag" #-}

import Common
import Pretty
import UU.Scanner.Position
import Data.Sequence(Seq)
import qualified Data.Sequence as Seq
import Data.Map(Map)
import qualified Data.Map as Map
import Data.Foldable
import Opts
{-# LINE 18 "dist/src/sdist.34564/ruler-core-1.0/dist/build/ruler-core/ruler-core-tmp/Errs.hs" #-}

{-# LINE 20 "src/Errs.ag" #-}

type Errs = Seq Err

prettyErr :: Opts -> Err -> PP_Doc
prettyErr opts e
  = pp_Syn_Err syn
  where
    inh = Inh_Err { opts_Inh_Err = opts }
    syn = wrap_Err sem inh
    sem = sem_Err e

prettyErrs :: Opts -> Errs -> PP_Doc
prettyErrs opts = vlist . map (prettyErr opts) . toList

errsToStr :: Opts -> Errs -> String
errsToStr opts es = disp (prettyErrs opts es) 999999 ""

debugMsg :: String -> Errs
debugMsg = Seq.singleton . Err_General noPos

nullErrs :: Errs -> Bool
nullErrs = Seq.null
{-# LINE 43 "dist/src/sdist.34564/ruler-core-1.0/dist/build/ruler-core/ruler-core-tmp/Errs.hs" #-}

{-# LINE 203 "src/Errs.ag" #-}

locLine :: PP a => Pos -> a -> PP_Doc
locLine (Pos l c f) d
  = pp f >|< ":" >|< pp l >|< "," >|< pp c >|< ":error:" >#< pp d
{-# LINE 50 "dist/src/sdist.34564/ruler-core-1.0/dist/build/ruler-core/ruler-core-tmp/Errs.hs" #-}
-- Err ---------------------------------------------------------
data Err  = Err_AmbAttach !(Ident) !(Ident) 
          | Err_AmbDefault !(Pos) !(Ident) 
          | Err_ChildSynUnav !(Pos) !(Ident) !(Ident) !(Ident) !(Ident) 
          | Err_ClausesCyclic !(Pos) !(Ident) !(Int) 
          | Err_Cyclic !(Pos) !((Map DepItem Pos)) !(([DepItem])) 
          | Err_Dup !(([Ident])) 
          | Err_DupAttr !(Bool) !(Ident) !(Ident) 
          | Err_EffCyclic !(Pos) 
          | Err_ExpVisit !(Pos) !(Ident) !(Ident) 
          | Err_General !(Pos) !(String) 
          | Err_InternalInCyclic !(Pos) !(Ident) 
          | Err_IterCyclic !(Pos) 
          | Err_MatchCyclic !(Pos) 
          | Err_Missing !(([Ident])) 
          | Err_MissingAttr !(Bool) !(Ident) !(Ident) 
          | Err_MissingClause !(Ident) !(Ident) 
          | Err_MissingVisit !(Pos) !(Ident) !(Ident) 
          | Err_NameClash !(Ident) 
          | Err_TypeConflict !(Ident) !(Ident) 
          | Err_UndeclAttr !(Ident) !(Ident) 
          | Err_UndeclVisit !(Pos) !(Ident) !(Ident) 
          | Err_UndefVisit !(Ident) !(Ident) !(([Ident])) 
          | Err_UndetachVisit !(Ident) !(Ident) !(Ident) 
          | Err_VisExpCyclic !(Ident) !(Ident) 
          | Err_VisitsNotImpl !(([Ident])) !(([Ident])) 
-- cata
sem_Err :: Err  ->
           T_Err 
sem_Err (Err_AmbAttach _name _visit )  =
    (sem_Err_AmbAttach _name _visit )
sem_Err (Err_AmbDefault _pos _name )  =
    (sem_Err_AmbDefault _pos _name )
sem_Err (Err_ChildSynUnav _pos _child _itf _vis _name )  =
    (sem_Err_ChildSynUnav _pos _child _itf _vis _name )
sem_Err (Err_ClausesCyclic _pos _name _n )  =
    (sem_Err_ClausesCyclic _pos _name _n )
sem_Err (Err_Cyclic _pos _posMap _comps )  =
    (sem_Err_Cyclic _pos _posMap _comps )
sem_Err (Err_Dup _ks )  =
    (sem_Err_Dup _ks )
sem_Err (Err_DupAttr _inherited _child _name )  =
    (sem_Err_DupAttr _inherited _child _name )
sem_Err (Err_EffCyclic _pos )  =
    (sem_Err_EffCyclic _pos )
sem_Err (Err_ExpVisit _pos _found _expect )  =
    (sem_Err_ExpVisit _pos _found _expect )
sem_Err (Err_General _pos _str )  =
    (sem_Err_General _pos _str )
sem_Err (Err_InternalInCyclic _pos _name )  =
    (sem_Err_InternalInCyclic _pos _name )
sem_Err (Err_IterCyclic _pos )  =
    (sem_Err_IterCyclic _pos )
sem_Err (Err_MatchCyclic _pos )  =
    (sem_Err_MatchCyclic _pos )
sem_Err (Err_Missing _ks )  =
    (sem_Err_Missing _ks )
sem_Err (Err_MissingAttr _inherited _child _name )  =
    (sem_Err_MissingAttr _inherited _child _name )
sem_Err (Err_MissingClause _itf _name )  =
    (sem_Err_MissingClause _itf _name )
sem_Err (Err_MissingVisit _pos _child _visit )  =
    (sem_Err_MissingVisit _pos _child _visit )
sem_Err (Err_NameClash _name )  =
    (sem_Err_NameClash _name )
sem_Err (Err_TypeConflict _found _expect )  =
    (sem_Err_TypeConflict _found _expect )
sem_Err (Err_UndeclAttr _child _name )  =
    (sem_Err_UndeclAttr _child _name )
sem_Err (Err_UndeclVisit _pos _name _itf )  =
    (sem_Err_UndeclVisit _pos _name _itf )
sem_Err (Err_UndefVisit _child _visit _visits )  =
    (sem_Err_UndefVisit _child _visit _visits )
sem_Err (Err_UndetachVisit _child _visit _expect )  =
    (sem_Err_UndetachVisit _child _visit _expect )
sem_Err (Err_VisExpCyclic _name _child )  =
    (sem_Err_VisExpCyclic _name _child )
sem_Err (Err_VisitsNotImpl _nonterm _vs )  =
    (sem_Err_VisitsNotImpl _nonterm _vs )
-- semantic domain
type T_Err  = Opts ->
              ( PP_Doc)
data Inh_Err  = Inh_Err {opts_Inh_Err :: !(Opts)}
data Syn_Err  = Syn_Err {pp_Syn_Err :: !(PP_Doc)}
wrap_Err :: T_Err  ->
            Inh_Err  ->
            Syn_Err 
wrap_Err sem (Inh_Err _lhsIopts )  =
    (let ( _lhsOpp) = sem _lhsIopts 
     in  (Syn_Err _lhsOpp ))
sem_Err_AmbAttach :: Ident ->
                     Ident ->
                     T_Err 
sem_Err_AmbAttach name_ visit_  =
    (\ _lhsIopts ->
         (case (({-# LINE 182 "src/Errs.ag" #-}
                 identPos name_
                 {-# LINE 148 "src/Errs.hs" #-})) of
          { _pos ->
          (case (({-# LINE 144 "src/Errs.ag" #-}
                  locLine _pos     ("ambiguous attach of child" >#< show name_ >#< "and visit" >#< show visit_)
                  {-# LINE 152 "src/Errs.hs" #-})) of
           { _lhsOpp ->
           ( _lhsOpp) }) }))
sem_Err_AmbDefault :: Pos ->
                      Ident ->
                      T_Err 
sem_Err_AmbDefault pos_ name_  =
    (\ _lhsIopts ->
         (case (({-# LINE 145 "src/Errs.ag" #-}
                 locLine pos_     ("ambiguous default statement for" >#< show name_)
                 {-# LINE 162 "src/Errs.hs" #-})) of
          { _lhsOpp ->
          ( _lhsOpp) }))
sem_Err_ChildSynUnav :: Pos ->
                        Ident ->
                        Ident ->
                        Ident ->
                        Ident ->
                        T_Err 
sem_Err_ChildSynUnav pos_ child_ itf_ vis_ name_  =
    (\ _lhsIopts ->
         (case (({-# LINE 147 "src/Errs.ag" #-}
                 locLine pos_     ("default for" >#< show name_ >#< "requires unavailable attribute" >#< show name_ >#< "of" >#< show child_ >|< "'s visit" >#< show vis_)
                 {-# LINE 175 "src/Errs.hs" #-})) of
          { _lhsOpp ->
          ( _lhsOpp) }))
sem_Err_ClausesCyclic :: Pos ->
                         Ident ->
                         Int ->
                         T_Err 
sem_Err_ClausesCyclic pos_ name_ n_  =
    (\ _lhsIopts ->
         (case (({-# LINE 150 "src/Errs.ag" #-}
                 locLine pos_     ("cyclic visit" >#< show name_ >#< "must have one clause, but has" >#< show n_)
                 {-# LINE 186 "src/Errs.hs" #-})) of
          { _lhsOpp ->
          ( _lhsOpp) }))
sem_Err_Cyclic :: Pos ->
                  (Map DepItem Pos) ->
                  ([DepItem]) ->
                  T_Err 
sem_Err_Cyclic pos_ posMap_ comps_  =
    (\ _lhsIopts ->
         (case (({-# LINE 188 "src/Errs.ag" #-}
                 \d -> let pos = Map.findWithDefault noPos d posMap_
                       in case d of
                            DepMatch _               -> "@" >|< show (line pos)
                            DepAssert _              -> "@" >|< show (line pos)
                            DepDefault o             -> "d" >|< show o
                            DepAttach n              -> "@" >|< show (line pos)
                            DepInvoke (visit:name:_) -> show name >|< "." >|< show visit >|< "@" >|< show (line $ identPos name)
                            DepInvoke _              -> text "i???"
                            DepVisStart (visit:_)    -> ">" >|< show visit >|< "@" >|< show (line $ identPos visit)
                            DepVisStart _            -> text ">v???"
                            DepVisEnd  (visit:_)     -> show visit >|< "@" >|< show (line $ identPos visit) >|< "<"
                            DepVisEnd _              -> text "<v???"
                            DepClause (clause:_)     -> "|" >|< show clause >|< "@" >|< show (line $ identPos clause)
                            DepClause _              -> text "|???"
                 {-# LINE 210 "src/Errs.hs" #-})) of
          { _ppDep ->
          (case (({-# LINE 148 "src/Errs.ag" #-}
                  locLine pos_     ("cycle:" >#< hlist_sp (map _ppDep     comps_) )
                  {-# LINE 214 "src/Errs.hs" #-})) of
           { _lhsOpp ->
           ( _lhsOpp) }) }))
sem_Err_Dup :: ([Ident]) ->
               T_Err 
sem_Err_Dup ks_  =
    (\ _lhsIopts ->
         (case (({-# LINE 158 "src/Errs.ag" #-}
                 if null ks_ then ident "<unspecified>" else head ks_
                 {-# LINE 223 "src/Errs.hs" #-})) of
          { _main ->
          (case (({-# LINE 160 "src/Errs.ag" #-}
                  identPos _main
                  {-# LINE 227 "src/Errs.hs" #-})) of
           { _pos ->
           (case (({-# LINE 132 "src/Errs.ag" #-}
                   locLine _pos     ("duplicate identifier" >#< show _main    )
                   {-# LINE 231 "src/Errs.hs" #-})) of
            { _lhsOpp ->
            ( _lhsOpp) }) }) }))
sem_Err_DupAttr :: Bool ->
                   Ident ->
                   Ident ->
                   T_Err 
sem_Err_DupAttr inherited_ child_ name_  =
    (\ _lhsIopts ->
         (case (({-# LINE 178 "src/Errs.ag" #-}
                 if inherited_ then text "inh" else text "syn"
                 {-# LINE 242 "src/Errs.hs" #-})) of
          { _type ->
          (case (({-# LINE 177 "src/Errs.ag" #-}
                  identPos name_
                  {-# LINE 246 "src/Errs.hs" #-})) of
           { _pos ->
           (case (({-# LINE 142 "src/Errs.ag" #-}
                   locLine _pos     ("duplicate" >#< _type     >#< "attr" >#< show child_ >|< "." >|< show name_)
                   {-# LINE 250 "src/Errs.hs" #-})) of
            { _lhsOpp ->
            ( _lhsOpp) }) }) }))
sem_Err_EffCyclic :: Pos ->
                     T_Err 
sem_Err_EffCyclic pos_  =
    (\ _lhsIopts ->
         (case (({-# LINE 151 "src/Errs.ag" #-}
                 locLine pos_     ("effectful code not allowed for cyclic stmt")
                 {-# LINE 259 "src/Errs.hs" #-})) of
          { _lhsOpp ->
          ( _lhsOpp) }))
sem_Err_ExpVisit :: Pos ->
                    Ident ->
                    Ident ->
                    T_Err 
sem_Err_ExpVisit pos_ found_ expect_  =
    (\ _lhsIopts ->
         (case (({-# LINE 133 "src/Errs.ag" #-}
                 locLine pos_     ("expecting visit" >#< show expect_ >#< "found" >#< show found_)
                 {-# LINE 270 "src/Errs.hs" #-})) of
          { _lhsOpp ->
          ( _lhsOpp) }))
sem_Err_General :: Pos ->
                   String ->
                   T_Err 
sem_Err_General pos_ str_  =
    (\ _lhsIopts ->
         (case (({-# LINE 130 "src/Errs.ag" #-}
                 locLine pos_ str_
                 {-# LINE 280 "src/Errs.hs" #-})) of
          { _lhsOpp ->
          ( _lhsOpp) }))
sem_Err_InternalInCyclic :: Pos ->
                            Ident ->
                            T_Err 
sem_Err_InternalInCyclic pos_ name_  =
    (\ _lhsIopts ->
         (case (({-# LINE 154 "src/Errs.ag" #-}
                 locLine pos_  ("internal visit" >#< show name_ >#< "may not occur in a fully cyclic visit")
                 {-# LINE 290 "src/Errs.hs" #-})) of
          { _lhsOpp ->
          ( _lhsOpp) }))
sem_Err_IterCyclic :: Pos ->
                      T_Err 
sem_Err_IterCyclic pos_  =
    (\ _lhsIopts ->
         (case (({-# LINE 153 "src/Errs.ag" #-}
                 locLine pos_     ("visit may not be iterated by cyclic stmt")
                 {-# LINE 299 "src/Errs.hs" #-})) of
          { _lhsOpp ->
          ( _lhsOpp) }))
sem_Err_MatchCyclic :: Pos ->
                       T_Err 
sem_Err_MatchCyclic pos_  =
    (\ _lhsIopts ->
         (case (({-# LINE 149 "src/Errs.ag" #-}
                 locLine pos_     ("match statement not allowed in cyclic visit")
                 {-# LINE 308 "src/Errs.hs" #-})) of
          { _lhsOpp ->
          ( _lhsOpp) }))
sem_Err_Missing :: ([Ident]) ->
                   T_Err 
sem_Err_Missing ks_  =
    (\ _lhsIopts ->
         (case (({-# LINE 158 "src/Errs.ag" #-}
                 if null ks_ then ident "<unspecified>" else head ks_
                 {-# LINE 317 "src/Errs.hs" #-})) of
          { _main ->
          (case (({-# LINE 160 "src/Errs.ag" #-}
                  identPos _main
                  {-# LINE 321 "src/Errs.hs" #-})) of
           { _pos ->
           (case (({-# LINE 131 "src/Errs.ag" #-}
                   locLine _pos     ("undefined identifier" >#< show _main    )
                   {-# LINE 325 "src/Errs.hs" #-})) of
            { _lhsOpp ->
            ( _lhsOpp) }) }) }))
sem_Err_MissingAttr :: Bool ->
                       Ident ->
                       Ident ->
                       T_Err 
sem_Err_MissingAttr inherited_ child_ name_  =
    (\ _lhsIopts ->
         (case (({-# LINE 175 "src/Errs.ag" #-}
                 if inherited_ then text "inh" else text "syn"
                 {-# LINE 336 "src/Errs.hs" #-})) of
          { _type ->
          (case (({-# LINE 174 "src/Errs.ag" #-}
                  identPos name_
                  {-# LINE 340 "src/Errs.hs" #-})) of
           { _pos ->
           (case (({-# LINE 141 "src/Errs.ag" #-}
                   locLine _pos     ("undefined" >#< _type     >#< "attr" >#< show child_ >|< "." >|< show name_)
                   {-# LINE 344 "src/Errs.hs" #-})) of
            { _lhsOpp ->
            ( _lhsOpp) }) }) }))
sem_Err_MissingClause :: Ident ->
                         Ident ->
                         T_Err 
sem_Err_MissingClause itf_ name_  =
    (\ _lhsIopts ->
         (case (({-# LINE 180 "src/Errs.ag" #-}
                 identPos name_
                 {-# LINE 354 "src/Errs.hs" #-})) of
          { _pos ->
          (case (({-# LINE 143 "src/Errs.ag" #-}
                  locLine _pos     ("missing clause " >#< show name_ >#< "of" >#< show itf_)
                  {-# LINE 358 "src/Errs.hs" #-})) of
           { _lhsOpp ->
           ( _lhsOpp) }) }))
sem_Err_MissingVisit :: Pos ->
                        Ident ->
                        Ident ->
                        T_Err 
sem_Err_MissingVisit pos_ child_ visit_  =
    (\ _lhsIopts ->
         (case (({-# LINE 134 "src/Errs.ag" #-}
                 locLine pos_     ("missing invoke of visit" >#< show visit_ >#< "of child" >#< show child_)
                 {-# LINE 369 "src/Errs.hs" #-})) of
          { _lhsOpp ->
          ( _lhsOpp) }))
sem_Err_NameClash :: Ident ->
                     T_Err 
sem_Err_NameClash name_  =
    (\ _lhsIopts ->
         (case (({-# LINE 172 "src/Errs.ag" #-}
                 identPos name_
                 {-# LINE 378 "src/Errs.hs" #-})) of
          { _pos ->
          (case (({-# LINE 140 "src/Errs.ag" #-}
                  locLine _pos     ("name clash" >#< show name_)
                  {-# LINE 382 "src/Errs.hs" #-})) of
           { _lhsOpp ->
           ( _lhsOpp) }) }))
sem_Err_TypeConflict :: Ident ->
                        Ident ->
                        T_Err 
sem_Err_TypeConflict found_ expect_  =
    (\ _lhsIopts ->
         (case (({-# LINE 184 "src/Errs.ag" #-}
                 identPos found_
                 {-# LINE 392 "src/Errs.hs" #-})) of
          { _pos ->
          (case (({-# LINE 146 "src/Errs.ag" #-}
                  locLine _pos     ("type" >#< show found_ >#< "does not match expected type" >#< show expect_)
                  {-# LINE 396 "src/Errs.hs" #-})) of
           { _lhsOpp ->
           ( _lhsOpp) }) }))
sem_Err_UndeclAttr :: Ident ->
                      Ident ->
                      T_Err 
sem_Err_UndeclAttr child_ name_  =
    (\ _lhsIopts ->
         (case (({-# LINE 170 "src/Errs.ag" #-}
                 identPos name_
                 {-# LINE 406 "src/Errs.hs" #-})) of
          { _pos ->
          (case (({-# LINE 139 "src/Errs.ag" #-}
                  locLine _pos     ("undeclared attr" >#< show child_ >|< "." >|< show name_)
                  {-# LINE 410 "src/Errs.hs" #-})) of
           { _lhsOpp ->
           ( _lhsOpp) }) }))
sem_Err_UndeclVisit :: Pos ->
                       Ident ->
                       Ident ->
                       T_Err 
sem_Err_UndeclVisit pos_ name_ itf_  =
    (\ _lhsIopts ->
         (case (({-# LINE 137 "src/Errs.ag" #-}
                 locLine pos_     ("undeclared visit" >#< show name_ >#< "of interface" >#< show itf_)
                 {-# LINE 421 "src/Errs.hs" #-})) of
          { _lhsOpp ->
          ( _lhsOpp) }))
sem_Err_UndefVisit :: Ident ->
                      Ident ->
                      ([Ident]) ->
                      T_Err 
sem_Err_UndefVisit child_ visit_ visits_  =
    (\ _lhsIopts ->
         (case (({-# LINE 166 "src/Errs.ag" #-}
                 identPos visit_
                 {-# LINE 432 "src/Errs.hs" #-})) of
          { _pos ->
          (case (({-# LINE 136 "src/Errs.ag" #-}
                  locLine _pos     ("undefined visit" >#< show visit_ >#< "of child" >#< show child_)
                  {-# LINE 436 "src/Errs.hs" #-})) of
           { _lhsOpp ->
           ( _lhsOpp) }) }))
sem_Err_UndetachVisit :: Ident ->
                         Ident ->
                         Ident ->
                         T_Err 
sem_Err_UndetachVisit child_ visit_ expect_  =
    (\ _lhsIopts ->
         (case (({-# LINE 168 "src/Errs.ag" #-}
                 identPos visit_
                 {-# LINE 447 "src/Errs.hs" #-})) of
          { _pos ->
          (case (({-# LINE 138 "src/Errs.ag" #-}
                  locLine _pos     ("undetachable visit" >#< show visit_ >#< "of child" >#< show child_ >|< ": expecting visit" >#< show expect_)
                  {-# LINE 451 "src/Errs.hs" #-})) of
           { _lhsOpp ->
           ( _lhsOpp) }) }))
sem_Err_VisExpCyclic :: Ident ->
                        Ident ->
                        T_Err 
sem_Err_VisExpCyclic name_ child_  =
    (\ _lhsIopts ->
         (case (({-# LINE 186 "src/Errs.ag" #-}
                 identPos name_
                 {-# LINE 461 "src/Errs.hs" #-})) of
          { _pos ->
          (case (({-# LINE 152 "src/Errs.ag" #-}
                  locLine _pos     ("visit" >#< show name_ >#< "of" >#< show child_ >#< "is on a cycle")
                  {-# LINE 465 "src/Errs.hs" #-})) of
           { _lhsOpp ->
           ( _lhsOpp) }) }))
sem_Err_VisitsNotImpl :: ([Ident]) ->
                         ([Ident]) ->
                         T_Err 
sem_Err_VisitsNotImpl nonterm_ vs_  =
    (\ _lhsIopts ->
         (case (({-# LINE 164 "src/Errs.ag" #-}
                 identPos (head nonterm_)
                 {-# LINE 475 "src/Errs.hs" #-})) of
          { _pos ->
          (case (({-# LINE 162 "src/Errs.ag" #-}
                  if null vs_ then ident "<unspecified>" else head vs_
                  {-# LINE 479 "src/Errs.hs" #-})) of
           { _main ->
           (case (({-# LINE 135 "src/Errs.ag" #-}
                   locLine _pos     ("missing visit" >#< show _main     >#< "for" >#< show (head nonterm_))
                   {-# LINE 483 "src/Errs.hs" #-})) of
            { _lhsOpp ->
            ( _lhsOpp) }) }) }))