mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-07 02:02:51 -06:00
96 lines
2.4 KiB
Haskell
96 lines
2.4 KiB
Haskell
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
|