5056N/A{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances #-}

5056N/A{- |

5056N/AModule : $Header$

5056N/ADescription : positions, simple and mixfix identifiers

5056N/ACopyright : (c) Christian Maeder and Ewaryst Schulz and Uni Bremen 2009

5056N/ALicense : GPLv2 or higher

5056N/A

5056N/AMaintainer : Ewaryst.Schulz@dfki.de

5056N/AStability : experimental

5056N/APortability : non-portable (MPTC)

5056N/A

5056N/AThis module provides the item datatype for an abstract logic independent

5056N/Arepresentation of basic specs.

5056N/A

5056N/A-}

5056N/A

5056N/Amodule Common.Item where

5056N/A

5056N/Aimport Common.Id

5056N/Aimport Common.AS_Annotation

5784N/Aimport Common.Doc

5056N/A

5371N/Aimport Data.Maybe

5371N/Aimport Control.Monad

5784N/A

5056N/A-- element name, attributes and optional text

5056N/Adata ItemType = IT

5056N/A { getName :: String

5056N/A , attrList :: [(String, String)]

5056N/A , getText :: Maybe Doc }

5056N/A

5056N/A-- flat items (isFlat=True) are intended for output as xml-attributes

5056N/A-- but this is not yet used

5056N/Adata Item = Item { itemType :: ItemType

5056N/A , isFlat :: Bool

5056N/A , range :: Range

5056N/A , items :: [Annoted Item]

5056N/A }

5056N/A

5056N/AhasValue :: ItemType -> Bool

5056N/AhasValue (IT _ attrs md) = isJust md || not (null attrs)

5056N/A

5056N/Ainstance GetRange Item where

5056N/A getRange = range

5056N/A

5152N/A{-

5152N/A In the following we use these abbreviations:

5056N/A I = Item

5056N/A AI = Annoted Item

5056N/A IT = ItemType or ItemTypeable

5056N/A-}

5056N/A

5056N/A-- often we have the situation where we want to obtain an ItemType

-- from a certain Type:

class ItemTypeable a where

toIT :: a -> ItemType

instance ItemTypeable ItemType where

toIT = id

-- intelligent ItemType generation

instance ItemTypeable String where

toIT s = IT s [] Nothing

instance ItemTypeable (String, Doc) where

toIT (s, s') = IT s [] $ Just s'

instance ItemTypeable (String, String, String) where

toIT (s, s', s'') = IT s [(s', s'')] Nothing

class Monad m => ItemConvertible a m where

toitem :: a -> m Item

-- -------------------------- Sublist creation ----------------------------

listFromAL :: ItemConvertible a m => [Annoted a] -> m [Annoted Item]

listFromAL = mapM annToAItem

listFromLWithA :: ItemConvertible a m =>

(Item -> Annoted Item) -> [a] -> m [Annoted Item]

listFromLWithA f = mapM (toAItemWithA f)

listFromL :: ItemConvertible a m => [a] -> m [Annoted Item]

listFromL = mapM toAItem

annToAItem :: ItemConvertible a m => Annoted a -> m (Annoted Item)

annToAItem v = liftM (`replaceAnnoted` v) (toitem $ item v)

toAItemWithA :: ItemConvertible a m =>

(Item -> Annoted Item) -> a -> m (Annoted Item)

toAItemWithA f = liftM f . toitem

toAItem :: ItemConvertible a m => a -> m (Annoted Item)

toAItem = toAItemWithA emptyAnno

-- -------------------------- ItemType lifting ----------------------------

-- often we have the situation where we want to obtain a whole Item

-- or even an Annoted Item from an ItemType:

liftIT2I :: ItemTypeable a => a -> Item

liftIT2I t = mkItem t nullRange []

liftIT2AI :: ItemTypeable a => a -> Annoted Item

liftIT2AI = emptyAnno . liftIT2I

-- -------------------------- Combinators ----------------------------

fromC :: ItemConvertible a m => a -> m (Annoted Item)

fromC = fromAC . emptyAnno

fromAC :: ItemConvertible a m => Annoted a -> m (Annoted Item)

fromAC = annToAItem

fromL :: (ItemConvertible a m, ItemTypeable b) => b -> [a] -> m (Annoted Item)

fromL it l = do

l' <- listFromL l

let i = liftIT2I it

return $ emptyAnno i { items = l' }

fromAL :: (ItemConvertible a m, ItemTypeable b) => b -> [Annoted a] ->

m (Annoted Item)

fromAL it l = do

l' <- listFromAL l

let i = liftIT2I it

return $ emptyAnno i { items = l' }

-- -------------------------- standard items ----------------------------

rootItem :: Item

rootItem = liftIT2I "Basicspec"

mkItem :: ItemTypeable a => a -> Range -> [Annoted Item] -> Item

mkItem it = Item (toIT it) False

mkFlatItem :: ItemTypeable a => a -> Range -> Item

mkFlatItem it rg = Item (toIT it) True rg []

mkItemM :: (ItemTypeable a, Monad m) => a -> Range -> m [Annoted Item] ->

m Item

mkItemM it = liftM . mkItem it

mkItemMM :: (ItemTypeable a, Monad m) => a -> Range -> [m (Annoted Item)] ->

m Item

mkItemMM it rg = mkItemM it rg . sequence

mkFlatItemM :: (ItemTypeable a, Monad m) => a -> Range -> m Item

mkFlatItemM it rg = return $ mkFlatItem it rg

flattenItem :: Item -> Item

flattenItem x = x { isFlat = True }

addRange :: Range -> Item -> Item

addRange rg x = x { range = rg }