{- |
Module      :  ./Maude/Meta/HasLabels.hs
Description :  Accessing the Labels of Maude data types
Copyright   :  (c) Martin Kuehl, Uni Bremen 2008-2009
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  mkhl@informatik.uni-bremen.de
Stability   :  experimental
Portability :  portable

Accessing the Labels of Maude data types.

Defines a type class 'HasLabels' that lets us access the 'Label's of
Maude data types as 'SymbolSet's.

Consider importing "Maude.Meta" instead of this module.
-}

module Maude.Meta.HasLabels (
    -- * The HasLabels type class
    HasLabels (..)
) where

import Maude.AS_Maude
import Maude.Symbol
import Maude.Meta.AsSymbol
import Maude.Meta.HasName

import Data.Set (Set)
import qualified Data.Set as Set

-- * The HasLabels  type class

-- | Represents something that contains a 'Set' of 'Label's (as 'Symbol's).
class HasLabels a where
    -- | Extract the 'Label's contained in the input.
    getLabels :: a -> SymbolSet
    -- | Map the 'Label's contained in the input.
    mapLabels :: SymbolMap -> a -> a

-- * Predefined instances

instance (HasLabels a) => HasLabels [a] where
    getLabels :: [a] -> SymbolSet
getLabels = [SymbolSet] -> SymbolSet
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([SymbolSet] -> SymbolSet)
-> ([a] -> [SymbolSet]) -> [a] -> SymbolSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> SymbolSet) -> [a] -> [SymbolSet]
forall a b. (a -> b) -> [a] -> [b]
map a -> SymbolSet
forall a. HasLabels a => a -> SymbolSet
getLabels
    mapLabels :: SymbolMap -> [a] -> [a]
mapLabels = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> a) -> [a] -> [a])
-> (SymbolMap -> a -> a) -> SymbolMap -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolMap -> a -> a
forall a. HasLabels a => SymbolMap -> a -> a
mapLabels

instance (HasLabels a, HasLabels b) => HasLabels (a, b) where
    getLabels :: (a, b) -> SymbolSet
getLabels (a :: a
a, b :: b
b) = SymbolSet -> SymbolSet -> SymbolSet
forall a. Ord a => Set a -> Set a -> Set a
Set.union (a -> SymbolSet
forall a. HasLabels a => a -> SymbolSet
getLabels a
a) (b -> SymbolSet
forall a. HasLabels a => a -> SymbolSet
getLabels b
b)
    mapLabels :: SymbolMap -> (a, b) -> (a, b)
mapLabels mp :: SymbolMap
mp (a :: a
a, b :: b
b) = (SymbolMap -> a -> a
forall a. HasLabels a => SymbolMap -> a -> a
mapLabels SymbolMap
mp a
a, SymbolMap -> b -> b
forall a. HasLabels a => SymbolMap -> a -> a
mapLabels SymbolMap
mp b
b)

instance (HasLabels a, HasLabels b, HasLabels c) => HasLabels (a, b, c) where
    getLabels :: (a, b, c) -> SymbolSet
getLabels (a :: a
a, b :: b
b, c :: c
c) = SymbolSet -> SymbolSet -> SymbolSet
forall a. Ord a => Set a -> Set a -> Set a
Set.union (a -> SymbolSet
forall a. HasLabels a => a -> SymbolSet
getLabels a
a) ((b, c) -> SymbolSet
forall a. HasLabels a => a -> SymbolSet
getLabels (b
b, c
c))
    mapLabels :: SymbolMap -> (a, b, c) -> (a, b, c)
mapLabels mp :: SymbolMap
mp (a :: a
a, b :: b
b, c :: c
c) = (SymbolMap -> a -> a
forall a. HasLabels a => SymbolMap -> a -> a
mapLabels SymbolMap
mp a
a, SymbolMap -> b -> b
forall a. HasLabels a => SymbolMap -> a -> a
mapLabels SymbolMap
mp b
b, SymbolMap -> c -> c
forall a. HasLabels a => SymbolMap -> a -> a
mapLabels SymbolMap
mp c
c)

instance (Ord a, HasLabels a) => HasLabels (Set a) where
    getLabels :: Set a -> SymbolSet
getLabels = (a -> SymbolSet -> SymbolSet) -> SymbolSet -> Set a -> SymbolSet
forall a b. (a -> b -> b) -> b -> Set a -> b
Set.fold (SymbolSet -> SymbolSet -> SymbolSet
forall a. Ord a => Set a -> Set a -> Set a
Set.union (SymbolSet -> SymbolSet -> SymbolSet)
-> (a -> SymbolSet) -> a -> SymbolSet -> SymbolSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SymbolSet
forall a. HasLabels a => a -> SymbolSet
getLabels) SymbolSet
forall a. Set a
Set.empty
    mapLabels :: SymbolMap -> Set a -> Set a
mapLabels = (a -> a) -> Set a -> Set a
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map ((a -> a) -> Set a -> Set a)
-> (SymbolMap -> a -> a) -> SymbolMap -> Set a -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolMap -> a -> a
forall a. HasLabels a => SymbolMap -> a -> a
mapLabels

instance HasLabels StmntAttr where
    getLabels :: StmntAttr -> SymbolSet
getLabels = StmntAttr -> SymbolSet
forall a. AsSymbol a => a -> SymbolSet
asSymbolSet
    mapLabels :: SymbolMap -> StmntAttr -> StmntAttr
mapLabels = (Symbol -> StmntAttr) -> SymbolMap -> StmntAttr -> StmntAttr
forall a. AsSymbol a => (Symbol -> a) -> SymbolMap -> a -> a
mapAsSymbol ((Symbol -> StmntAttr) -> SymbolMap -> StmntAttr -> StmntAttr)
-> (Symbol -> StmntAttr) -> SymbolMap -> StmntAttr -> StmntAttr
forall a b. (a -> b) -> a -> b
$ Qid -> StmntAttr
Label (Qid -> StmntAttr) -> (Symbol -> Qid) -> Symbol -> StmntAttr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Qid
forall a. HasName a => a -> Qid
getName

instance HasLabels Membership where
    getLabels :: Membership -> SymbolSet
getLabels (Mb _ _ _ as :: [StmntAttr]
as) = [StmntAttr] -> SymbolSet
forall a. HasLabels a => a -> SymbolSet
getLabels [StmntAttr]
as
    mapLabels :: SymbolMap -> Membership -> Membership
mapLabels mp :: SymbolMap
mp (Mb ts :: Term
ts ss :: Sort
ss cs :: [Condition]
cs as :: [StmntAttr]
as) = Term -> Sort -> [Condition] -> [StmntAttr] -> Membership
Mb Term
ts Sort
ss [Condition]
cs (SymbolMap -> [StmntAttr] -> [StmntAttr]
forall a. HasLabels a => SymbolMap -> a -> a
mapLabels SymbolMap
mp [StmntAttr]
as)

instance HasLabels Equation where
    getLabels :: Equation -> SymbolSet
getLabels (Eq _ _ _ as :: [StmntAttr]
as) = [StmntAttr] -> SymbolSet
forall a. HasLabels a => a -> SymbolSet
getLabels [StmntAttr]
as
    mapLabels :: SymbolMap -> Equation -> Equation
mapLabels mp :: SymbolMap
mp (Eq t1 :: Term
t1 t2 :: Term
t2 cs :: [Condition]
cs as :: [StmntAttr]
as) = Term -> Term -> [Condition] -> [StmntAttr] -> Equation
Eq Term
t1 Term
t2 [Condition]
cs (SymbolMap -> [StmntAttr] -> [StmntAttr]
forall a. HasLabels a => SymbolMap -> a -> a
mapLabels SymbolMap
mp [StmntAttr]
as)

instance HasLabels Rule where
    getLabels :: Rule -> SymbolSet
getLabels (Rl _ _ _ as :: [StmntAttr]
as) = [StmntAttr] -> SymbolSet
forall a. HasLabels a => a -> SymbolSet
getLabels [StmntAttr]
as
    mapLabels :: SymbolMap -> Rule -> Rule
mapLabels mp :: SymbolMap
mp (Rl t1 :: Term
t1 t2 :: Term
t2 cs :: [Condition]
cs as :: [StmntAttr]
as) = Term -> Term -> [Condition] -> [StmntAttr] -> Rule
Rl Term
t1 Term
t2 [Condition]
cs (SymbolMap -> [StmntAttr] -> [StmntAttr]
forall a. HasLabels a => SymbolMap -> a -> a
mapLabels SymbolMap
mp [StmntAttr]
as)