content: {-# LANGUAGE DeriveDataTypeable #-}
  {- |
  Module      :  ./CommonLogic/Sign.hs
  Description :  Signature for common logic
  Copyright   :  (c) Karl Luc, DFKI Bremen 2010
  License     :  GPLv2 or higher, see LICENSE.txt
  
  Maintainer  :  kluc@informatik.uni-bremen.de
  Stability   :  experimental
  Portability :  portable
  
  Definition of signatures for common logic
  -}
  
  module CommonLogic.Sign
      (Sign (..)
      , pretty                        -- pretty printing
      , allItems                      -- union of all signature-fields
      , emptySig                      -- empty signature
      , isSubSigOf                    -- sub signature of signature
      , sigDiff                       -- Difference of Signatures
      , unite                         -- union of signatures
      , uniteL                        -- union of a list ofsignatures
      , sigUnion                      -- Union for Logic.Logic
      , sigUnionL                     -- union of a list ofsignatures
      , isSeqMark                     -- is an Id a sequence marker?
      ) where
  
  import qualified Data.Set as Set
  import Common.Id
  import Common.Result
  import Common.Doc
  import Common.DocUtils
  
  import Data.Data
  import Data.List (isPrefixOf)
  
  -- | Datatype for common logic Signatures
  
  data Sign = Sign { discourseNames :: Set.Set Id
                   , nondiscourseNames :: Set.Set Id
                   , sequenceMarkers :: Set.Set Id
                   } deriving (Eq, Ord, Show, Typeable)
  
  instance Pretty Sign where
      pretty = printSign
  
  -- | union of all signature-fields
  allItems :: Sign -> Set.Set Id
  allItems s = Set.unions $ map (\ f -> f s) [ discourseNames
                                            , nondiscourseNames
                                            , sequenceMarkers
                                            ]
  
  -- | The empty signature
  emptySig :: Sign
  emptySig = Sign { discourseNames = Set.empty
                  , nondiscourseNames = Set.empty
                  , sequenceMarkers = Set.empty
                  }
  
  -- | pretty printing for Signatures
  printSign :: Sign -> Doc
  printSign s =
    vsep [ text "%{"
         , text "discourseNames: "
            <+> sepByCommas (map pretty $ Set.toList $ discourseNames s)
         , text "nondiscourseNames: "
            <+> sepByCommas (map pretty $ Set.toList $ nondiscourseNames s)
         , text "sequenceMarkers: "
            <+> sepByCommas (map pretty $ Set.toList $ sequenceMarkers s)
         , text "}%"]
  
  -- | Determines if sig1 is subsignature of sig2
  isSubSigOf :: Sign -> Sign -> Bool
  isSubSigOf sig1 sig2 =
    Set.isSubsetOf (discourseNames sig1) (discourseNames sig2)
    && Set.isSubsetOf (nondiscourseNames sig1) (nondiscourseNames sig2)
    && Set.isSubsetOf (sequenceMarkers sig1) (sequenceMarkers sig2)
  
  -- | difference of Signatures
  sigDiff :: Sign -> Sign -> Sign
  sigDiff sig1 sig2 = Sign {
    discourseNames = Set.difference (discourseNames sig1) (discourseNames sig2),
    nondiscourseNames = Set.difference (nondiscourseNames sig1) (nondiscourseNames sig2),
    sequenceMarkers = Set.difference (sequenceMarkers sig1) (sequenceMarkers sig2)
  }
  
  -- | Unite Signatures
  sigUnion :: Sign -> Sign -> Result Sign
  sigUnion s1 = Result [Diag Debug "All fine sigUnion" nullRange]
        . Just . unite s1
  
  -- | Unite Signature in a list
  sigUnionL :: [Sign] -> Result Sign
  sigUnionL (sig : sigL) = sigUnion sig (uniteL sigL)
  sigUnionL [] = return emptySig
  
  -- | Union of two signatures. Behaves like Set.union, i.e. is fast with @bigsig `union` smallsig@.
  unite :: Sign -> Sign -> Sign
  unite sig1 sig2 = Sign
    { discourseNames = discourseNames sig1 `Set.union` discourseNames sig2
    , nondiscourseNames = nondiscourseNames sig1 `Set.union` nondiscourseNames sig2
    , sequenceMarkers = sequenceMarkers sig1 `Set.union` sequenceMarkers sig2
    }
  
  -- | Union of a list of signatures.
  uniteL :: [Sign] -> Sign
  uniteL = foldr unite emptySig
  
  isSeqMark :: Id -> Bool
  isSeqMark = isStringSeqMark . tokStr . idToSimpleId
  
  -- | Checks whether a String is a sequence marker
  isStringSeqMark :: String -> Bool
  isStringSeqMark s = "..." `isPrefixOf` s
  