{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances #-} {- | Module : ./Common/Item.hs Description : positions, simple and mixfix identifiers Copyright : (c) Christian Maeder and Ewaryst Schulz and Uni Bremen 2009 License : GPLv2 or higher, see LICENSE.txt Maintainer : Ewaryst.Schulz@dfki.de Stability : experimental Portability : non-portable (MPTC) This module provides the item datatype for an abstract logic independent representation of basic specs. -} module Common.Item where import Common.Id import Common.AS_Annotation import Common.Doc import Data.Maybe import Control.Monad -- element name, attributes and optional text data ItemType = IT { ItemType -> String getName :: String , ItemType -> [(String, String)] attrList :: [(String, String)] , ItemType -> Maybe Doc getText :: Maybe Doc } {- flat items (isFlat=True) are intended for output as xml-attributes but this is not yet used -} data Item = Item { Item -> ItemType itemType :: ItemType , Item -> Bool isFlat :: Bool , Item -> Range range :: Range , Item -> [Annoted Item] items :: [Annoted Item] } hasValue :: ItemType -> Bool hasValue :: ItemType -> Bool hasValue (IT _ attrs :: [(String, String)] attrs md :: Maybe Doc md) = Maybe Doc -> Bool forall a. Maybe a -> Bool isJust Maybe Doc md Bool -> Bool -> Bool || Bool -> Bool not ([(String, String)] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [(String, String)] attrs) instance GetRange Item where getRange :: Item -> Range getRange = Item -> Range range {- In the following we use these abbreviations: I = Item AI = Annoted Item IT = ItemType or ItemTypeable -} {- 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 :: ItemType -> ItemType toIT = ItemType -> ItemType forall a. a -> a id -- intelligent ItemType generation instance ItemTypeable String where toIT :: String -> ItemType toIT s :: String s = String -> [(String, String)] -> Maybe Doc -> ItemType IT String s [] Maybe Doc forall a. Maybe a Nothing instance ItemTypeable (String, Doc) where toIT :: (String, Doc) -> ItemType toIT (s :: String s, s' :: Doc s') = String -> [(String, String)] -> Maybe Doc -> ItemType IT String s [] (Maybe Doc -> ItemType) -> Maybe Doc -> ItemType forall a b. (a -> b) -> a -> b $ Doc -> Maybe Doc forall a. a -> Maybe a Just Doc s' instance ItemTypeable (String, String, String) where toIT :: (String, String, String) -> ItemType toIT (s :: String s, s' :: String s', s'' :: String s'') = String -> [(String, String)] -> Maybe Doc -> ItemType IT String s [(String s', String s'')] Maybe Doc forall a. Maybe a Nothing class Monad m => ItemConvertible a m where toitem :: a -> m Item -- -------------------------- Sublist creation ---------------------------- listFromAL :: ItemConvertible a m => [Annoted a] -> m [Annoted Item] listFromAL :: [Annoted a] -> m [Annoted Item] listFromAL = (Annoted a -> m (Annoted Item)) -> [Annoted a] -> m [Annoted Item] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) mapM Annoted a -> m (Annoted Item) forall a (m :: * -> *). ItemConvertible a m => Annoted a -> m (Annoted Item) annToAItem listFromLWithA :: ItemConvertible a m => (Item -> Annoted Item) -> [a] -> m [Annoted Item] listFromLWithA :: (Item -> Annoted Item) -> [a] -> m [Annoted Item] listFromLWithA f :: Item -> Annoted Item f = (a -> m (Annoted Item)) -> [a] -> m [Annoted Item] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) mapM ((Item -> Annoted Item) -> a -> m (Annoted Item) forall a (m :: * -> *). ItemConvertible a m => (Item -> Annoted Item) -> a -> m (Annoted Item) toAItemWithA Item -> Annoted Item f) listFromL :: ItemConvertible a m => [a] -> m [Annoted Item] listFromL :: [a] -> m [Annoted Item] listFromL = (a -> m (Annoted Item)) -> [a] -> m [Annoted Item] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) mapM a -> m (Annoted Item) forall a (m :: * -> *). ItemConvertible a m => a -> m (Annoted Item) toAItem annToAItem :: ItemConvertible a m => Annoted a -> m (Annoted Item) annToAItem :: Annoted a -> m (Annoted Item) annToAItem v :: Annoted a v = (Item -> Annoted Item) -> m Item -> m (Annoted Item) forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r liftM (Item -> Annoted a -> Annoted Item forall b a. b -> Annoted a -> Annoted b `replaceAnnoted` Annoted a v) (a -> m Item forall a (m :: * -> *). ItemConvertible a m => a -> m Item toitem (a -> m Item) -> a -> m Item forall a b. (a -> b) -> a -> b $ Annoted a -> a forall a. Annoted a -> a item Annoted a v) toAItemWithA :: ItemConvertible a m => (Item -> Annoted Item) -> a -> m (Annoted Item) toAItemWithA :: (Item -> Annoted Item) -> a -> m (Annoted Item) toAItemWithA f :: Item -> Annoted Item f = (Item -> Annoted Item) -> m Item -> m (Annoted Item) forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r liftM Item -> Annoted Item f (m Item -> m (Annoted Item)) -> (a -> m Item) -> a -> m (Annoted Item) forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> m Item forall a (m :: * -> *). ItemConvertible a m => a -> m Item toitem toAItem :: ItemConvertible a m => a -> m (Annoted Item) toAItem :: a -> m (Annoted Item) toAItem = (Item -> Annoted Item) -> a -> m (Annoted Item) forall a (m :: * -> *). ItemConvertible a m => (Item -> Annoted Item) -> a -> m (Annoted Item) toAItemWithA Item -> Annoted Item forall a. a -> Annoted a 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 :: a -> Item liftIT2I t :: a t = a -> Range -> [Annoted Item] -> Item forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item mkItem a t Range nullRange [] liftIT2AI :: ItemTypeable a => a -> Annoted Item liftIT2AI :: a -> Annoted Item liftIT2AI = Item -> Annoted Item forall a. a -> Annoted a emptyAnno (Item -> Annoted Item) -> (a -> Item) -> a -> Annoted Item forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> Item forall a. ItemTypeable a => a -> Item liftIT2I -- -------------------------- Combinators ---------------------------- fromC :: ItemConvertible a m => a -> m (Annoted Item) fromC :: a -> m (Annoted Item) fromC = Annoted a -> m (Annoted Item) forall a (m :: * -> *). ItemConvertible a m => Annoted a -> m (Annoted Item) fromAC (Annoted a -> m (Annoted Item)) -> (a -> Annoted a) -> a -> m (Annoted Item) forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> Annoted a forall a. a -> Annoted a emptyAnno fromAC :: ItemConvertible a m => Annoted a -> m (Annoted Item) fromAC :: Annoted a -> m (Annoted Item) fromAC = Annoted a -> m (Annoted Item) forall a (m :: * -> *). ItemConvertible a m => Annoted a -> m (Annoted Item) annToAItem fromL :: (ItemConvertible a m, ItemTypeable b) => b -> [a] -> m (Annoted Item) fromL :: b -> [a] -> m (Annoted Item) fromL it :: b it l :: [a] l = do [Annoted Item] l' <- [a] -> m [Annoted Item] forall a (m :: * -> *). ItemConvertible a m => [a] -> m [Annoted Item] listFromL [a] l let i :: Item i = b -> Item forall a. ItemTypeable a => a -> Item liftIT2I b it Annoted Item -> m (Annoted Item) forall (m :: * -> *) a. Monad m => a -> m a return (Annoted Item -> m (Annoted Item)) -> Annoted Item -> m (Annoted Item) forall a b. (a -> b) -> a -> b $ Item -> Annoted Item forall a. a -> Annoted a emptyAnno Item i { items :: [Annoted Item] items = [Annoted Item] l' } fromAL :: (ItemConvertible a m, ItemTypeable b) => b -> [Annoted a] -> m (Annoted Item) fromAL :: b -> [Annoted a] -> m (Annoted Item) fromAL it :: b it l :: [Annoted a] l = do [Annoted Item] l' <- [Annoted a] -> m [Annoted Item] forall a (m :: * -> *). ItemConvertible a m => [Annoted a] -> m [Annoted Item] listFromAL [Annoted a] l let i :: Item i = b -> Item forall a. ItemTypeable a => a -> Item liftIT2I b it Annoted Item -> m (Annoted Item) forall (m :: * -> *) a. Monad m => a -> m a return (Annoted Item -> m (Annoted Item)) -> Annoted Item -> m (Annoted Item) forall a b. (a -> b) -> a -> b $ Item -> Annoted Item forall a. a -> Annoted a emptyAnno Item i { items :: [Annoted Item] items = [Annoted Item] l' } -- -------------------------- standard items ---------------------------- rootItem :: Item rootItem :: Item rootItem = String -> Item forall a. ItemTypeable a => a -> Item liftIT2I "Basicspec" mkItem :: ItemTypeable a => a -> Range -> [Annoted Item] -> Item mkItem :: a -> Range -> [Annoted Item] -> Item mkItem it :: a it = ItemType -> Bool -> Range -> [Annoted Item] -> Item Item (a -> ItemType forall a. ItemTypeable a => a -> ItemType toIT a it) Bool False mkFlatItem :: ItemTypeable a => a -> Range -> Item mkFlatItem :: a -> Range -> Item mkFlatItem it :: a it rg :: Range rg = ItemType -> Bool -> Range -> [Annoted Item] -> Item Item (a -> ItemType forall a. ItemTypeable a => a -> ItemType toIT a it) Bool True Range rg [] mkItemM :: (ItemTypeable a, Monad m) => a -> Range -> m [Annoted Item] -> m Item mkItemM :: a -> Range -> m [Annoted Item] -> m Item mkItemM it :: a it = ([Annoted Item] -> Item) -> m [Annoted Item] -> m Item forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r liftM (([Annoted Item] -> Item) -> m [Annoted Item] -> m Item) -> (Range -> [Annoted Item] -> Item) -> Range -> m [Annoted Item] -> m Item forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> Range -> [Annoted Item] -> Item forall a. ItemTypeable a => a -> Range -> [Annoted Item] -> Item mkItem a it mkItemMM :: (ItemTypeable a, Monad m) => a -> Range -> [m (Annoted Item)] -> m Item mkItemMM :: a -> Range -> [m (Annoted Item)] -> m Item mkItemMM it :: a it rg :: Range rg = a -> Range -> m [Annoted Item] -> m Item forall a (m :: * -> *). (ItemTypeable a, Monad m) => a -> Range -> m [Annoted Item] -> m Item mkItemM a it Range rg (m [Annoted Item] -> m Item) -> ([m (Annoted Item)] -> m [Annoted Item]) -> [m (Annoted Item)] -> m Item forall b c a. (b -> c) -> (a -> b) -> a -> c . [m (Annoted Item)] -> m [Annoted Item] forall (t :: * -> *) (m :: * -> *) a. (Traversable t, Monad m) => t (m a) -> m (t a) sequence mkFlatItemM :: (ItemTypeable a, Monad m) => a -> Range -> m Item mkFlatItemM :: a -> Range -> m Item mkFlatItemM it :: a it rg :: Range rg = Item -> m Item forall (m :: * -> *) a. Monad m => a -> m a return (Item -> m Item) -> Item -> m Item forall a b. (a -> b) -> a -> b $ a -> Range -> Item forall a. ItemTypeable a => a -> Range -> Item mkFlatItem a it Range rg flattenItem :: Item -> Item flattenItem :: Item -> Item flattenItem x :: Item x = Item x { isFlat :: Bool isFlat = Bool True } addRange :: Range -> Item -> Item addRange :: Range -> Item -> Item addRange rg :: Range rg x :: Item x = Item x { range :: Range range = Range rg }