Item.hs

{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances #-}
{- |
Module      :  $Header$
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
  { getName :: String
  , attrList :: [(String, String)]
  , getText :: Maybe Doc }

-- flat items (isFlat=True) are intended for output as xml-attributes
-- but this is not yet used
data Item = Item { itemType :: ItemType
                 , isFlat :: Bool
                 , range :: Range
                 , items :: [Annoted Item]
                 }

hasValue :: ItemType -> Bool
hasValue (IT _ attrs md) = isJust md || not (null attrs)

instance GetRange Item where
    getRange = 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 = 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 }