{-# LANGUAGE DeriveDataTypeable #-}
{- |
Module      :  ./CspCASL/SymbItems.hs
Description :  syntactic csp-casl symbols
Copyright   :  (c) Christian Maeder, DFKI GmbH 2011
License     :  GPLv2 or higher, see LICENSE.txt
Maintainer  :  Christian.Maeder@dfki.de
Stability   :  provisional
Portability :  portable

-}

module CspCASL.SymbItems where

import CspCASL.AS_CspCASL_Process
import CspCASL.CspCASL_Keywords
import CspCASL.Print_CspCASL
import CspCASL.Parse_CspCASL_Process

import CASL.AS_Basic_CASL
import CASL.SymbolParser
import CASL.ToDoc

import Common.AnnoState
import Common.Doc hiding (braces)
import Common.DocUtils
import Common.Id
import Common.Keywords
import Common.Lexer
import Common.Parsec
import Common.Token

import Text.ParserCombinators.Parsec

import Control.Monad
import Data.Data

import qualified Data.Set as Set

data CspSymbItems = CspSymbItems CspSymbKind [CspSymb]
  deriving (Show, Eq, Ord, Typeable, Data)

data CspSymbMapItems = CspSymbMapItems CspSymbKind [CspSymbMap]
  deriving (Show, Eq, Ord, Typeable, Data)

data CspSymbKind = CaslKind SYMB_KIND | ProcessKind | ChannelKind
  deriving (Show, Eq, Ord, Typeable, Data)

data CspSymb = CspSymb Id (Maybe CspType)
  deriving (Show, Eq, Ord, Typeable, Data)

-- for channels with sorts we may re-use A_type that is ambiguous
data CspType = CaslType TYPE | ProcType ProcProfile
  deriving (Show, Eq, Ord, Typeable, Data)

data CspSymbMap = CspSymbMap CspSymb (Maybe CspSymb)
  deriving (Show, Eq, Ord, Typeable, Data)

pluralCspSympKind :: CspSymbKind -> [a] -> Doc
pluralCspSympKind k l = case k of
    CaslKind c -> case c of
      Implicit -> empty
      _ -> keyword $ pluralS_symb_list c l
    ProcessKind -> keyword processS
    ChannelKind -> keyword $ channelS ++ appendS l

instance Pretty CspSymbKind where
  pretty k = pluralCspSympKind k [()]

instance Pretty CspType where
  pretty t = case t of
    CaslType c -> colon <> pretty c
    ProcType p -> printProcProfile p

instance Pretty CspSymb where
  pretty (CspSymb i ms) = pretty i <+> pretty ms

instance Pretty CspSymbMap where
  pretty (CspSymbMap s ms) = pretty s <+> case ms of
    Nothing -> empty
    Just t -> mapsto <+> pretty t

instance Pretty CspSymbItems where
  pretty (CspSymbItems k l) = pluralCspSympKind k l <+> ppWithCommas l

instance Pretty CspSymbMapItems where
  pretty (CspSymbMapItems k l) = pluralCspSympKind k l <+> ppWithCommas l

commAlpha :: AParser st CommAlpha
commAlpha = fmap Set.fromList $ single commType <|> bracedList

-- | parsing a possibly qualified identifier
cspSymb :: AParser st CspSymb
cspSymb =
    do i <- parseCspId
       do
         _ <- colonST
         t <- fmap CaslType (opOrPredType cspKeywords) <|>
            fmap (ProcType . ProcProfile []) commAlpha
         return $ CspSymb i $ Just t
        <|> do
         ts <- parenList cspSortId
         colonT
         cs <- commAlpha
         return $ CspSymb i $ Just $ ProcType $ ProcProfile ts cs
        <|> return (CspSymb i Nothing)

-- | parsing one symbol or a mapping of one to second symbol
cspSymbMap :: AParser st CspSymbMap
cspSymbMap = liftM2 CspSymbMap cspSymb $ optionMaybe
  $ asKey mapsTo >> optional cspSymbKind >> cspSymb

-- | parse a kind keyword
cspSymbKind :: AParser st CspSymbKind
cspSymbKind =
  fmap (const ChannelKind) (pluralKeyword channelS)
  <|> fmap (const ProcessKind) (asKey processS)
  <|> fmap (CaslKind . fst) symbKind

-- | parse a comma separated list of symbols
cspSymbs :: AParser st [CspSymb]
cspSymbs =
    do s <- cspSymb
       do
         _ <- commaT `followedWith` parseCspId
         is <- cspSymbs
         return $ s : is
        <|> return [s]

{- | Parse a possible kinded list of comma separated CspCASL symbols.
     The argument is a list of keywords to avoid as identifiers. -}
cspSymbItems :: AParser st CspSymbItems
cspSymbItems = fmap (CspSymbItems $ CaslKind Implicit) cspSymbs <|> do
    k <- cspSymbKind
    fmap (CspSymbItems k) cspSymbs

-- | parse a comma separated list of symbols
cspSymbMaps :: AParser st [CspSymbMap]
cspSymbMaps =
    do s <- cspSymbMap
       do
         _ <- commaT `followedWith` parseCspId
         is <- cspSymbMaps
         return $ s : is
        <|> return [s]

-- | parse a possible kinded list of CspCASL symbol mappings
cspSymbMapItems :: AParser st CspSymbMapItems
cspSymbMapItems = fmap (CspSymbMapItems $ CaslKind Implicit) cspSymbMaps
  <|> do
    k <- cspSymbKind
    fmap (CspSymbMapItems k) cspSymbMaps
