{-# 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 }