content: module PGF.CId (CId(..), 
                  mkCId, wildCId,
                  readCId, showCId,
                  
                  -- utils
                  utf8CId, pCId, pIdent, ppCId) where
  
  import Control.Monad
  import qualified Data.ByteString.Char8 as BS
  import qualified Data.ByteString.UTF8 as UTF8
  import Data.Char
  import qualified Text.ParserCombinators.ReadP as RP
  import qualified Text.PrettyPrint as PP
  
  
  -- | An abstract data type that represents
  -- identifiers for functions and categories in PGF.
  newtype CId = CId BS.ByteString deriving (Eq,Ord)
  
  wildCId :: CId
  wildCId = CId (BS.singleton '_')
  
  -- | Creates a new identifier from 'String'
  mkCId :: String -> CId
  mkCId s = CId (UTF8.fromString s)
  
  -- | Creates an identifier from a UTF-8-encoded 'ByteString'
  utf8CId = CId
  
  -- | Reads an identifier from 'String'. The function returns 'Nothing' if the string is not valid identifier.
  readCId :: String -> Maybe CId
  readCId s = case [x | (x,cs) <- RP.readP_to_S pCId s, all isSpace cs] of
                [x] -> Just x
                _   -> Nothing
  
  -- | Renders the identifier as 'String'
  showCId :: CId -> String
  showCId (CId x) = 
    let raw = UTF8.toString x
    in if isIdent raw
         then raw
         else "'" ++ concatMap escape raw ++ "'"
    where
      isIdent []     = False
      isIdent (c:cs) = isIdentFirst c && all isIdentRest cs
  
      escape '\'' = "\\\'"
      escape '\\' = "\\\\"
      escape c    = [c]
  
  instance Show CId where
      showsPrec _ = showString . showCId
  
  instance Read CId where
      readsPrec _ = RP.readP_to_S pCId
  
  pCId :: RP.ReadP CId
  pCId = do s <- pIdent
            if s == "_"
              then RP.pfail
              else return (mkCId s)
  
  pIdent :: RP.ReadP String
  pIdent = 
    liftM2 (:) (RP.satisfy isIdentFirst) (RP.munch isIdentRest)
    `mplus`
    do RP.char '\''
       cs <- RP.many1 insideChar
       RP.char '\''
       return cs
  --  where
  insideChar = RP.readS_to_P $ \s ->
    case s of
      []             -> []
      ('\\':'\\':cs) -> [('\\',cs)]
      ('\\':'\'':cs) -> [('\'',cs)]
      ('\\':cs)      -> []
      ('\'':cs)      -> []
      (c:cs)         -> [(c,cs)]
  
  isIdentFirst c =
    (c == '_') ||
    (c >= 'a' && c <= 'z') ||
    (c >= 'A' && c <= 'Z') ||
    (c >= '\192' && c <= '\255' && c /= '\247' && c /= '\215')
  isIdentRest c = 
    (c == '_') ||
    (c == '\'') ||
    (c >= '0' && c <= '9') ||
    (c >= 'a' && c <= 'z') ||
    (c >= 'A' && c <= 'Z') ||
    (c >= '\192' && c <= '\255' && c /= '\247' && c /= '\215')
  
  ppCId :: CId -> PP.Doc
  ppCId = PP.text . showCId
  