content: {- |
  Module      :  ./HasCASL/ToItem.hs
  Description :  extracted annotated items for xml output from basic specs
  Copyright   :  (c) Christian Maeder and Ewaryst Schulz and DFKI GmbH 2009
  License     :  GPLv2 or higher, see LICENSE.txt
  
  Maintainer  :  Christian.Maeder@dfki.de
  Stability   :  experimental
  Portability :  non-portable (imports Common.Item)
  
  get item representation of 'BasicSpec'
  -}
  
  module HasCASL.ToItem (bsToItem) where
  
  import Common.AS_Annotation
  import Common.Doc
  import Common.DocUtils
  import Common.Id
  import Common.Item
  
  import HasCASL.As
  import HasCASL.PrintAs
  
  bsToItem :: BasicSpec -> Item
  bsToItem (BasicSpec bs) =
      mkItem "BasicSpec" nullRange $ map (fmap biToItem) bs
  
  biToItem :: BasicItem -> Item
  biToItem bi = case bi of
    SigItems si -> siToItem si
    ProgItems pes rg -> mkItem "ProgItems" rg $ map (fmap peToItem) pes
    ClassItems inst cs rg -> mkItem (case inst of
        Instance -> "ClassInstanceItems"
        Plain -> "ClassItems") rg $ map (fmap ciToItem) cs
    GenVarItems gvs rg ->
        mkItem "GenVarItems" rg $ map (emptyAnno . gvdToItem) gvs
    FreeDatatype ds rg -> mkItem "FreeDatatype" rg $ map (fmap dtdToItem) ds
    GenItems sis rg -> mkItem "GenItems" rg $ map (fmap siToItem) sis
    AxiomItems gvs ts rg -> mkItem "AxiomItems" rg $
      map (emptyAnno . gvdToItem) gvs ++ map (fmap trmToItem) ts
    Internal bs rg -> mkItem "Internal" rg $ map (fmap biToItem) bs
  
  siToItem :: SigItems -> Item
  siToItem si = case si of
    TypeItems inst ts rg -> mkItem (case inst of
      Instance -> "TypeInstanceItem"
      Plain -> "TypeItem") rg $ map (fmap tiToItem) ts
    OpItems b os rg -> mkItem (show b ++ "Items") rg $ map (fmap oiToItem) os
  
  tiToItem :: TypeItem -> Item
  tiToItem ti = case ti of
    TypeDecl tps k rg -> mkItem "TypeDecl" rg
      $ map (emptyAnno . tpToItem) tps ++ [emptyAnno (kToItem k)]
    SubtypeDecl tps ty rg -> mkItem "SubtypeDecl" rg
      $ map (emptyAnno . tpToItem) tps ++ [emptyAnno (tyToItem ty)]
    IsoDecl tps rg -> mkItem "IsoDecl" rg $ map (emptyAnno . tpToItem) tps
    SubtypeDefn tp v ty trm rg -> mkItem "SubtypeDefn" rg
       $ map emptyAnno [tpToItem tp, vToItem v, tyToItem ty]
       ++ [fmap trmToItem trm]
    AliasType tp mk sc rg -> mkItem "AliasType" rg $ map emptyAnno
      $ tpToItem tp : (case mk of
        Nothing -> []
        Just k -> [kToItem k]) ++ [scToItem sc]
    Datatype dtd -> dtdToItem dtd
  
  tpToItem :: TypePattern -> Item
  tpToItem tp = mkItem ("TypePattern", pretty tp) (getRange tp) []
  
  kToItem :: Kind -> Item
  kToItem k = mkItem ("Kind", pretty k) nullRange []
  
  tyToItem :: Type -> Item
  tyToItem ty = mkItem ("Type", pretty ty) (getRange ty) []
  
  vToItem :: Vars -> Item
  vToItem vs = mkItem ("Vars", pretty vs) nullRange []
  
  scToItem :: TypeScheme -> Item
  scToItem sc = mkItem ("TypeScheme" , pretty sc) (getRange sc) []
  
  oiToItem :: OpItem -> Item
  oiToItem oi = case oi of
    OpDecl is sc as rg -> mkItem "OpDecl" rg
      $ map (emptyAnno . polyIdToItem) is
        ++ [emptyAnno $ scToItem sc] ++ map (emptyAnno . attrToItem) as
    OpDefn o vs sc trm rg -> mkItem "OpDefn" rg
      $ map emptyAnno
      $ polyIdToItem o : [headToItem vs | not $ null vs ]
      ++ [scToItem sc, trmToItem trm]
  
  polyIdToItem :: PolyId -> Item
  polyIdToItem i@(PolyId _ _ rg) = mkItem ("OpId", pretty i) rg []
  
  attrToItem :: OpAttr -> Item
  attrToItem a = mkItem ("OpAttr", pretty a) (getRange a) []
  
  headToItem :: [[VarDecl]] -> Item
  headToItem vs = mkItem ("OpHead", fcat $ printHead vs) nullRange []
  
  peToItem :: ProgEq -> Item
  peToItem pe@(ProgEq _ _ rg) = mkItem ("ProgEq", pretty pe) rg []
  
  ciToItem :: ClassItem -> Item
  ciToItem (ClassItem cd bs rg) =
    mkItem "ClassItem" rg $ emptyAnno (cdToItem cd) : map (fmap biToItem) bs
  
  cdToItem :: ClassDecl -> Item
  cdToItem (ClassDecl cs k rg) =
    mkItem "ClassDecl" rg $ map (emptyAnno . classToItem) cs
    ++ [emptyAnno $ kToItem k]
  
  classToItem :: Id -> Item
  classToItem i = mkItem ("Class", pretty i) (getRangeSpan i) []
  
  gvdToItem :: GenVarDecl -> Item
  gvdToItem gvd = mkItem ("GenVarDecl", pretty gvd) nullRange []
  
  dtdToItem :: DatatypeDecl -> Item
  dtdToItem (DatatypeDecl tp k as ds rg) =
    mkItem "DatatypeDecl" rg $ emptyAnno (tpToItem tp) :
    emptyAnno (kToItem k) : map (fmap altToItem) as
    ++ map (emptyAnno . classToItem) ds
  
  altToItem :: Alternative -> Item
  altToItem a = case a of
    Constructor _ _ _ r -> mkItem ("Constructor", pretty a) r []
    Subtype _ r -> mkItem ("SubtypeAlternative", pretty a) r []
  
  trmToItem :: Term -> Item
  trmToItem t = mkItem ("Term", pretty t) (getRange t) []
  