{-# LANGUAGE DeriveDataTypeable #-}
{- |
Module      :  ./QVTR/Sign.hs
Description :  QVTR signature and sentences
Copyright   :  (c) Daniel Calegari Universidad de la Republica, Uruguay 2013
License     :  GPLv2 or higher, see LICENSE.txt
Maintainer  :  dcalegar@fing.edu.uy
Stability   :  provisional
Portability :  portable
-}

module QVTR.Sign where

import QVTR.As
import QVTR.Print ()

import qualified CSMOF.Sign as CSMOF
import CSMOF.Print ()

import Common.Doc
import Common.DocUtils
import Common.Id

import Data.Data
import qualified Data.Map as Map


data RuleDef = RuleDef { name :: String
                       , top :: Bool
                       , parameters :: [CSMOF.TypeClass]
                       } deriving (Show, Eq, Ord, Typeable, Data)

instance Pretty RuleDef where
  pretty (RuleDef nam to pars) =
    let t = text $ if to
            then "top relation"
            else "relation"
    in t <+> text nam <> lparen
    <> foldr ((<+>) . pretty) empty pars
    <> rparen


data Sign = Sign { sourceSign :: CSMOF.Sign
                 , targetSign :: CSMOF.Sign
                 , nonTopRelations :: Map.Map String RuleDef
                 , topRelations :: Map.Map String RuleDef
                 , keyDefs :: [(String, String)]
                 } deriving (Show, Eq, Ord, Typeable, Data)

instance GetRange Sign where
  getRange _ = nullRange
  rangeSpan _ = []

instance Pretty Sign where
  pretty (Sign souS tarS nonRel topRel keyD) =
    text "-- Source Metamodel"
    $++$
    pretty souS
    $++$
    text "-- Target Metamodel"
    $++$
    pretty tarS
    $++$
    text "-- Model Transformation"
    $++$
    text "Definition of Relations"
    $+$
    Map.fold (($+$) . pretty) empty topRel
    $+$
    Map.fold (($+$) . pretty) empty nonRel
    $++$
    text "Definition of Keys"
    $+$
    foldr (($+$) . pretty) empty keyD

emptySign :: Sign
emptySign = Sign { sourceSign = CSMOF.emptySign
                 , targetSign = CSMOF.emptySign
                 , nonTopRelations = Map.empty
                 , topRelations = Map.empty
                 , keyDefs = []
                 }


data Sen = KeyConstr { keyConst :: Key }
         | QVTSen { rule :: RelationSen }
         deriving (Show, Eq, Ord, Typeable, Data)

instance GetRange Sen where
  getRange _ = nullRange
  rangeSpan _ = []

instance Pretty Sen where
  pretty (KeyConstr con) = pretty con
  pretty (QVTSen rel) = pretty rel


data RelationSen = RelationSen { ruleDef :: RuleDef
                               , varSet :: [RelVar]
                               , parSet :: [RelVar]
                               , sourcePattern :: Pattern
                               , targetPattern :: Pattern
                               , whenClause :: Maybe WhenWhere
                               , whereClause :: Maybe WhenWhere
                               } deriving (Show, Eq, Ord, Typeable, Data)

instance GetRange RelationSen where
  getRange _ = nullRange
  rangeSpan _ = []

instance Pretty RelationSen where
  pretty (RelationSen rD vS pS souP tarP whenC whereC) =
    pretty rD
    $++$
    text "Variables" <> colon <+> foldr ((<+>) . pretty) empty vS
    $++$
    text "Parameters" <> colon <+> foldr ((<+>) . pretty) empty pS
    $++$
    pretty souP
    $++$
    pretty tarP
    $++$
    (case whenC of
      Nothing -> text "When" <+> lbrace $+$ rbrace
      Just w -> text "When" <+> lbrace $+$ pretty w $+$ rbrace)
    $++$
    (case whereC of
      Nothing -> text "Where" <+> lbrace $+$ rbrace
      Just w -> text "Where" <+> lbrace $+$ pretty w $+$ rbrace)


data Pattern = Pattern { patVarSet :: [RelVar]
                       , patRels :: [(CSMOF.PropertyT, RelVar, RelVar)]
                       , patPreds :: [(String, String, OCL)]
                       } deriving (Show, Eq, Ord, Typeable, Data)

instance GetRange Pattern where
  getRange _ = nullRange
  rangeSpan _ = []

instance Pretty Pattern where
  pretty (Pattern patVS patRel patPre) =
    text "Pattern" <+> lbrace
    $+$
    space <+> space <+> text "Variables" <> colon <+> foldr ((<+>) . pretty) empty patVS
    $+$
    space <+> space <+> text "Relations" <> colon <+> foldr (($+$) . pretty) empty patRel
    $+$
    space <+> space <+> text "Predicates" <> colon <+> foldr (($+$) . pretty) empty patPre
    $+$
    rbrace
