{- |
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 -> Item
bsToItem (BasicSpec bs :: [Annoted BasicItem]
bs) =
    [Char] -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem "BasicSpec" Range
nullRange ([Annoted Item] -> Item) -> [Annoted Item] -> Item
forall a b. (a -> b) -> a -> b
$ (Annoted BasicItem -> Annoted Item)
-> [Annoted BasicItem] -> [Annoted Item]
forall a b. (a -> b) -> [a] -> [b]
map ((BasicItem -> Item) -> Annoted BasicItem -> Annoted Item
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BasicItem -> Item
biToItem) [Annoted BasicItem]
bs

biToItem :: BasicItem -> Item
biToItem :: BasicItem -> Item
biToItem bi :: BasicItem
bi = case BasicItem
bi of
  SigItems si :: SigItems
si -> SigItems -> Item
siToItem SigItems
si
  ProgItems pes :: [Annoted ProgEq]
pes rg :: Range
rg -> [Char] -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem "ProgItems" Range
rg ([Annoted Item] -> Item) -> [Annoted Item] -> Item
forall a b. (a -> b) -> a -> b
$ (Annoted ProgEq -> Annoted Item)
-> [Annoted ProgEq] -> [Annoted Item]
forall a b. (a -> b) -> [a] -> [b]
map ((ProgEq -> Item) -> Annoted ProgEq -> Annoted Item
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ProgEq -> Item
peToItem) [Annoted ProgEq]
pes
  ClassItems inst :: Instance
inst cs :: [Annoted ClassItem]
cs rg :: Range
rg -> [Char] -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem (case Instance
inst of
      Instance -> "ClassInstanceItems"
      Plain -> "ClassItems") Range
rg ([Annoted Item] -> Item) -> [Annoted Item] -> Item
forall a b. (a -> b) -> a -> b
$ (Annoted ClassItem -> Annoted Item)
-> [Annoted ClassItem] -> [Annoted Item]
forall a b. (a -> b) -> [a] -> [b]
map ((ClassItem -> Item) -> Annoted ClassItem -> Annoted Item
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ClassItem -> Item
ciToItem) [Annoted ClassItem]
cs
  GenVarItems gvs :: [GenVarDecl]
gvs rg :: Range
rg ->
      [Char] -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem "GenVarItems" Range
rg ([Annoted Item] -> Item) -> [Annoted Item] -> Item
forall a b. (a -> b) -> a -> b
$ (GenVarDecl -> Annoted Item) -> [GenVarDecl] -> [Annoted Item]
forall a b. (a -> b) -> [a] -> [b]
map (Item -> Annoted Item
forall a. a -> Annoted a
emptyAnno (Item -> Annoted Item)
-> (GenVarDecl -> Item) -> GenVarDecl -> Annoted Item
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenVarDecl -> Item
gvdToItem) [GenVarDecl]
gvs
  FreeDatatype ds :: [Annoted DatatypeDecl]
ds rg :: Range
rg -> [Char] -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem "FreeDatatype" Range
rg ([Annoted Item] -> Item) -> [Annoted Item] -> Item
forall a b. (a -> b) -> a -> b
$ (Annoted DatatypeDecl -> Annoted Item)
-> [Annoted DatatypeDecl] -> [Annoted Item]
forall a b. (a -> b) -> [a] -> [b]
map ((DatatypeDecl -> Item) -> Annoted DatatypeDecl -> Annoted Item
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DatatypeDecl -> Item
dtdToItem) [Annoted DatatypeDecl]
ds
  GenItems sis :: [Annoted SigItems]
sis rg :: Range
rg -> [Char] -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem "GenItems" Range
rg ([Annoted Item] -> Item) -> [Annoted Item] -> Item
forall a b. (a -> b) -> a -> b
$ (Annoted SigItems -> Annoted Item)
-> [Annoted SigItems] -> [Annoted Item]
forall a b. (a -> b) -> [a] -> [b]
map ((SigItems -> Item) -> Annoted SigItems -> Annoted Item
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SigItems -> Item
siToItem) [Annoted SigItems]
sis
  AxiomItems gvs :: [GenVarDecl]
gvs ts :: [Annoted Term]
ts rg :: Range
rg -> [Char] -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem "AxiomItems" Range
rg ([Annoted Item] -> Item) -> [Annoted Item] -> Item
forall a b. (a -> b) -> a -> b
$
    (GenVarDecl -> Annoted Item) -> [GenVarDecl] -> [Annoted Item]
forall a b. (a -> b) -> [a] -> [b]
map (Item -> Annoted Item
forall a. a -> Annoted a
emptyAnno (Item -> Annoted Item)
-> (GenVarDecl -> Item) -> GenVarDecl -> Annoted Item
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenVarDecl -> Item
gvdToItem) [GenVarDecl]
gvs [Annoted Item] -> [Annoted Item] -> [Annoted Item]
forall a. [a] -> [a] -> [a]
++ (Annoted Term -> Annoted Item) -> [Annoted Term] -> [Annoted Item]
forall a b. (a -> b) -> [a] -> [b]
map ((Term -> Item) -> Annoted Term -> Annoted Item
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Term -> Item
trmToItem) [Annoted Term]
ts
  Internal bs :: [Annoted BasicItem]
bs rg :: Range
rg -> [Char] -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem "Internal" Range
rg ([Annoted Item] -> Item) -> [Annoted Item] -> Item
forall a b. (a -> b) -> a -> b
$ (Annoted BasicItem -> Annoted Item)
-> [Annoted BasicItem] -> [Annoted Item]
forall a b. (a -> b) -> [a] -> [b]
map ((BasicItem -> Item) -> Annoted BasicItem -> Annoted Item
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BasicItem -> Item
biToItem) [Annoted BasicItem]
bs

siToItem :: SigItems -> Item
siToItem :: SigItems -> Item
siToItem si :: SigItems
si = case SigItems
si of
  TypeItems inst :: Instance
inst ts :: [Annoted TypeItem]
ts rg :: Range
rg -> [Char] -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem (case Instance
inst of
    Instance -> "TypeInstanceItem"
    Plain -> "TypeItem") Range
rg ([Annoted Item] -> Item) -> [Annoted Item] -> Item
forall a b. (a -> b) -> a -> b
$ (Annoted TypeItem -> Annoted Item)
-> [Annoted TypeItem] -> [Annoted Item]
forall a b. (a -> b) -> [a] -> [b]
map ((TypeItem -> Item) -> Annoted TypeItem -> Annoted Item
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeItem -> Item
tiToItem) [Annoted TypeItem]
ts
  OpItems b :: OpBrand
b os :: [Annoted OpItem]
os rg :: Range
rg -> [Char] -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem (OpBrand -> [Char]
forall a. Show a => a -> [Char]
show OpBrand
b [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "Items") Range
rg ([Annoted Item] -> Item) -> [Annoted Item] -> Item
forall a b. (a -> b) -> a -> b
$ (Annoted OpItem -> Annoted Item)
-> [Annoted OpItem] -> [Annoted Item]
forall a b. (a -> b) -> [a] -> [b]
map ((OpItem -> Item) -> Annoted OpItem -> Annoted Item
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OpItem -> Item
oiToItem) [Annoted OpItem]
os

tiToItem :: TypeItem -> Item
tiToItem :: TypeItem -> Item
tiToItem ti :: TypeItem
ti = case TypeItem
ti of
  TypeDecl tps :: [TypePattern]
tps k :: Kind
k rg :: Range
rg -> [Char] -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem "TypeDecl" Range
rg
    ([Annoted Item] -> Item) -> [Annoted Item] -> Item
forall a b. (a -> b) -> a -> b
$ (TypePattern -> Annoted Item) -> [TypePattern] -> [Annoted Item]
forall a b. (a -> b) -> [a] -> [b]
map (Item -> Annoted Item
forall a. a -> Annoted a
emptyAnno (Item -> Annoted Item)
-> (TypePattern -> Item) -> TypePattern -> Annoted Item
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypePattern -> Item
tpToItem) [TypePattern]
tps [Annoted Item] -> [Annoted Item] -> [Annoted Item]
forall a. [a] -> [a] -> [a]
++ [Item -> Annoted Item
forall a. a -> Annoted a
emptyAnno (Kind -> Item
kToItem Kind
k)]
  SubtypeDecl tps :: [TypePattern]
tps ty :: Type
ty rg :: Range
rg -> [Char] -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem "SubtypeDecl" Range
rg
    ([Annoted Item] -> Item) -> [Annoted Item] -> Item
forall a b. (a -> b) -> a -> b
$ (TypePattern -> Annoted Item) -> [TypePattern] -> [Annoted Item]
forall a b. (a -> b) -> [a] -> [b]
map (Item -> Annoted Item
forall a. a -> Annoted a
emptyAnno (Item -> Annoted Item)
-> (TypePattern -> Item) -> TypePattern -> Annoted Item
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypePattern -> Item
tpToItem) [TypePattern]
tps [Annoted Item] -> [Annoted Item] -> [Annoted Item]
forall a. [a] -> [a] -> [a]
++ [Item -> Annoted Item
forall a. a -> Annoted a
emptyAnno (Type -> Item
tyToItem Type
ty)]
  IsoDecl tps :: [TypePattern]
tps rg :: Range
rg -> [Char] -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem "IsoDecl" Range
rg ([Annoted Item] -> Item) -> [Annoted Item] -> Item
forall a b. (a -> b) -> a -> b
$ (TypePattern -> Annoted Item) -> [TypePattern] -> [Annoted Item]
forall a b. (a -> b) -> [a] -> [b]
map (Item -> Annoted Item
forall a. a -> Annoted a
emptyAnno (Item -> Annoted Item)
-> (TypePattern -> Item) -> TypePattern -> Annoted Item
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypePattern -> Item
tpToItem) [TypePattern]
tps
  SubtypeDefn tp :: TypePattern
tp v :: Vars
v ty :: Type
ty trm :: Annoted Term
trm rg :: Range
rg -> [Char] -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem "SubtypeDefn" Range
rg
     ([Annoted Item] -> Item) -> [Annoted Item] -> Item
forall a b. (a -> b) -> a -> b
$ (Item -> Annoted Item) -> [Item] -> [Annoted Item]
forall a b. (a -> b) -> [a] -> [b]
map Item -> Annoted Item
forall a. a -> Annoted a
emptyAnno [TypePattern -> Item
tpToItem TypePattern
tp, Vars -> Item
vToItem Vars
v, Type -> Item
tyToItem Type
ty]
     [Annoted Item] -> [Annoted Item] -> [Annoted Item]
forall a. [a] -> [a] -> [a]
++ [(Term -> Item) -> Annoted Term -> Annoted Item
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Term -> Item
trmToItem Annoted Term
trm]
  AliasType tp :: TypePattern
tp mk :: Maybe Kind
mk sc :: TypeScheme
sc rg :: Range
rg -> [Char] -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem "AliasType" Range
rg ([Annoted Item] -> Item) -> [Annoted Item] -> Item
forall a b. (a -> b) -> a -> b
$ (Item -> Annoted Item) -> [Item] -> [Annoted Item]
forall a b. (a -> b) -> [a] -> [b]
map Item -> Annoted Item
forall a. a -> Annoted a
emptyAnno
    ([Item] -> [Annoted Item]) -> [Item] -> [Annoted Item]
forall a b. (a -> b) -> a -> b
$ TypePattern -> Item
tpToItem TypePattern
tp Item -> [Item] -> [Item]
forall a. a -> [a] -> [a]
: (case Maybe Kind
mk of
      Nothing -> []
      Just k :: Kind
k -> [Kind -> Item
kToItem Kind
k]) [Item] -> [Item] -> [Item]
forall a. [a] -> [a] -> [a]
++ [TypeScheme -> Item
scToItem TypeScheme
sc]
  Datatype dtd :: DatatypeDecl
dtd -> DatatypeDecl -> Item
dtdToItem DatatypeDecl
dtd

tpToItem :: TypePattern -> Item
tpToItem :: TypePattern -> Item
tpToItem tp :: TypePattern
tp = ([Char], Doc) -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem ("TypePattern", TypePattern -> Doc
forall a. Pretty a => a -> Doc
pretty TypePattern
tp) (TypePattern -> Range
forall a. GetRange a => a -> Range
getRange TypePattern
tp) []

kToItem :: Kind -> Item
kToItem :: Kind -> Item
kToItem k :: Kind
k = ([Char], Doc) -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem ("Kind", Kind -> Doc
forall a. Pretty a => a -> Doc
pretty Kind
k) Range
nullRange []

tyToItem :: Type -> Item
tyToItem :: Type -> Item
tyToItem ty :: Type
ty = ([Char], Doc) -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem ("Type", Type -> Doc
forall a. Pretty a => a -> Doc
pretty Type
ty) (Type -> Range
forall a. GetRange a => a -> Range
getRange Type
ty) []

vToItem :: Vars -> Item
vToItem :: Vars -> Item
vToItem vs :: Vars
vs = ([Char], Doc) -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem ("Vars", Vars -> Doc
forall a. Pretty a => a -> Doc
pretty Vars
vs) Range
nullRange []

scToItem :: TypeScheme -> Item
scToItem :: TypeScheme -> Item
scToItem sc :: TypeScheme
sc = ([Char], Doc) -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem ("TypeScheme" , TypeScheme -> Doc
forall a. Pretty a => a -> Doc
pretty TypeScheme
sc) (TypeScheme -> Range
forall a. GetRange a => a -> Range
getRange TypeScheme
sc) []

oiToItem :: OpItem -> Item
oiToItem :: OpItem -> Item
oiToItem oi :: OpItem
oi = case OpItem
oi of
  OpDecl is :: [PolyId]
is sc :: TypeScheme
sc as :: [OpAttr]
as rg :: Range
rg -> [Char] -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem "OpDecl" Range
rg
    ([Annoted Item] -> Item) -> [Annoted Item] -> Item
forall a b. (a -> b) -> a -> b
$ (PolyId -> Annoted Item) -> [PolyId] -> [Annoted Item]
forall a b. (a -> b) -> [a] -> [b]
map (Item -> Annoted Item
forall a. a -> Annoted a
emptyAnno (Item -> Annoted Item)
-> (PolyId -> Item) -> PolyId -> Annoted Item
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PolyId -> Item
polyIdToItem) [PolyId]
is
      [Annoted Item] -> [Annoted Item] -> [Annoted Item]
forall a. [a] -> [a] -> [a]
++ [Item -> Annoted Item
forall a. a -> Annoted a
emptyAnno (Item -> Annoted Item) -> Item -> Annoted Item
forall a b. (a -> b) -> a -> b
$ TypeScheme -> Item
scToItem TypeScheme
sc] [Annoted Item] -> [Annoted Item] -> [Annoted Item]
forall a. [a] -> [a] -> [a]
++ (OpAttr -> Annoted Item) -> [OpAttr] -> [Annoted Item]
forall a b. (a -> b) -> [a] -> [b]
map (Item -> Annoted Item
forall a. a -> Annoted a
emptyAnno (Item -> Annoted Item)
-> (OpAttr -> Item) -> OpAttr -> Annoted Item
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpAttr -> Item
attrToItem) [OpAttr]
as
  OpDefn o :: PolyId
o vs :: [[VarDecl]]
vs sc :: TypeScheme
sc trm :: Term
trm rg :: Range
rg -> [Char] -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem "OpDefn" Range
rg
    ([Annoted Item] -> Item) -> [Annoted Item] -> Item
forall a b. (a -> b) -> a -> b
$ (Item -> Annoted Item) -> [Item] -> [Annoted Item]
forall a b. (a -> b) -> [a] -> [b]
map Item -> Annoted Item
forall a. a -> Annoted a
emptyAnno
    ([Item] -> [Annoted Item]) -> [Item] -> [Annoted Item]
forall a b. (a -> b) -> a -> b
$ PolyId -> Item
polyIdToItem PolyId
o Item -> [Item] -> [Item]
forall a. a -> [a] -> [a]
: [[[VarDecl]] -> Item
headToItem [[VarDecl]]
vs | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [[VarDecl]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[VarDecl]]
vs ]
    [Item] -> [Item] -> [Item]
forall a. [a] -> [a] -> [a]
++ [TypeScheme -> Item
scToItem TypeScheme
sc, Term -> Item
trmToItem Term
trm]

polyIdToItem :: PolyId -> Item
polyIdToItem :: PolyId -> Item
polyIdToItem i :: PolyId
i@(PolyId _ _ rg :: Range
rg) = ([Char], Doc) -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem ("OpId", PolyId -> Doc
forall a. Pretty a => a -> Doc
pretty PolyId
i) Range
rg []

attrToItem :: OpAttr -> Item
attrToItem :: OpAttr -> Item
attrToItem a :: OpAttr
a = ([Char], Doc) -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem ("OpAttr", OpAttr -> Doc
forall a. Pretty a => a -> Doc
pretty OpAttr
a) (OpAttr -> Range
forall a. GetRange a => a -> Range
getRange OpAttr
a) []

headToItem :: [[VarDecl]] -> Item
headToItem :: [[VarDecl]] -> Item
headToItem vs :: [[VarDecl]]
vs = ([Char], Doc) -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem ("OpHead", [Doc] -> Doc
fcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [[VarDecl]] -> [Doc]
printHead [[VarDecl]]
vs) Range
nullRange []

peToItem :: ProgEq -> Item
peToItem :: ProgEq -> Item
peToItem pe :: ProgEq
pe@(ProgEq _ _ rg :: Range
rg) = ([Char], Doc) -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem ("ProgEq", ProgEq -> Doc
forall a. Pretty a => a -> Doc
pretty ProgEq
pe) Range
rg []

ciToItem :: ClassItem -> Item
ciToItem :: ClassItem -> Item
ciToItem (ClassItem cd :: ClassDecl
cd bs :: [Annoted BasicItem]
bs rg :: Range
rg) =
  [Char] -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem "ClassItem" Range
rg ([Annoted Item] -> Item) -> [Annoted Item] -> Item
forall a b. (a -> b) -> a -> b
$ Item -> Annoted Item
forall a. a -> Annoted a
emptyAnno (ClassDecl -> Item
cdToItem ClassDecl
cd) Annoted Item -> [Annoted Item] -> [Annoted Item]
forall a. a -> [a] -> [a]
: (Annoted BasicItem -> Annoted Item)
-> [Annoted BasicItem] -> [Annoted Item]
forall a b. (a -> b) -> [a] -> [b]
map ((BasicItem -> Item) -> Annoted BasicItem -> Annoted Item
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BasicItem -> Item
biToItem) [Annoted BasicItem]
bs

cdToItem :: ClassDecl -> Item
cdToItem :: ClassDecl -> Item
cdToItem (ClassDecl cs :: [Id]
cs k :: Kind
k rg :: Range
rg) =
  [Char] -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem "ClassDecl" Range
rg ([Annoted Item] -> Item) -> [Annoted Item] -> Item
forall a b. (a -> b) -> a -> b
$ (Id -> Annoted Item) -> [Id] -> [Annoted Item]
forall a b. (a -> b) -> [a] -> [b]
map (Item -> Annoted Item
forall a. a -> Annoted a
emptyAnno (Item -> Annoted Item) -> (Id -> Item) -> Id -> Annoted Item
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Item
classToItem) [Id]
cs
  [Annoted Item] -> [Annoted Item] -> [Annoted Item]
forall a. [a] -> [a] -> [a]
++ [Item -> Annoted Item
forall a. a -> Annoted a
emptyAnno (Item -> Annoted Item) -> Item -> Annoted Item
forall a b. (a -> b) -> a -> b
$ Kind -> Item
kToItem Kind
k]

classToItem :: Id -> Item
classToItem :: Id -> Item
classToItem i :: Id
i = ([Char], Doc) -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem ("Class", Id -> Doc
forall a. Pretty a => a -> Doc
pretty Id
i) (Id -> Range
forall a. GetRange a => a -> Range
getRangeSpan Id
i) []

gvdToItem :: GenVarDecl -> Item
gvdToItem :: GenVarDecl -> Item
gvdToItem gvd :: GenVarDecl
gvd = ([Char], Doc) -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem ("GenVarDecl", GenVarDecl -> Doc
forall a. Pretty a => a -> Doc
pretty GenVarDecl
gvd) Range
nullRange []

dtdToItem :: DatatypeDecl -> Item
dtdToItem :: DatatypeDecl -> Item
dtdToItem (DatatypeDecl tp :: TypePattern
tp k :: Kind
k as :: [Annoted Alternative]
as ds :: [Id]
ds rg :: Range
rg) =
  [Char] -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem "DatatypeDecl" Range
rg ([Annoted Item] -> Item) -> [Annoted Item] -> Item
forall a b. (a -> b) -> a -> b
$ Item -> Annoted Item
forall a. a -> Annoted a
emptyAnno (TypePattern -> Item
tpToItem TypePattern
tp) Annoted Item -> [Annoted Item] -> [Annoted Item]
forall a. a -> [a] -> [a]
:
  Item -> Annoted Item
forall a. a -> Annoted a
emptyAnno (Kind -> Item
kToItem Kind
k) Annoted Item -> [Annoted Item] -> [Annoted Item]
forall a. a -> [a] -> [a]
: (Annoted Alternative -> Annoted Item)
-> [Annoted Alternative] -> [Annoted Item]
forall a b. (a -> b) -> [a] -> [b]
map ((Alternative -> Item) -> Annoted Alternative -> Annoted Item
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Alternative -> Item
altToItem) [Annoted Alternative]
as
  [Annoted Item] -> [Annoted Item] -> [Annoted Item]
forall a. [a] -> [a] -> [a]
++ (Id -> Annoted Item) -> [Id] -> [Annoted Item]
forall a b. (a -> b) -> [a] -> [b]
map (Item -> Annoted Item
forall a. a -> Annoted a
emptyAnno (Item -> Annoted Item) -> (Id -> Item) -> Id -> Annoted Item
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Item
classToItem) [Id]
ds

altToItem :: Alternative -> Item
altToItem :: Alternative -> Item
altToItem a :: Alternative
a = case Alternative
a of
  Constructor _ _ _ r :: Range
r -> ([Char], Doc) -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem ("Constructor", Alternative -> Doc
forall a. Pretty a => a -> Doc
pretty Alternative
a) Range
r []
  Subtype _ r :: Range
r -> ([Char], Doc) -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem ("SubtypeAlternative", Alternative -> Doc
forall a. Pretty a => a -> Doc
pretty Alternative
a) Range
r []

trmToItem :: Term -> Item
trmToItem :: Term -> Item
trmToItem t :: Term
t = ([Char], Doc) -> Range -> [Annoted Item] -> Item
forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item
mkItem ("Term", Term -> Doc
forall a. Pretty a => a -> Doc
pretty Term
t) (Term -> Range
forall a. GetRange a => a -> Range
getRange Term
t) []