module PGF.CId (CId(..),
mkCId, wildCId,
readCId, showCId,
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
newtype CId = CId BS.ByteString deriving (Eq,Ord)
wildCId :: CId
wildCId = CId (BS.singleton '_')
mkCId :: String -> CId
mkCId s = CId (UTF8.fromString s)
utf8CId = CId
readCId :: String -> Maybe CId
readCId s = case [x | (x,cs) <- RP.readP_to_S pCId s, all isSpace cs] of
[x] -> Just x
_ -> Nothing
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
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