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 (CId -> CId -> Bool
(CId -> CId -> Bool) -> (CId -> CId -> Bool) -> Eq CId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CId -> CId -> Bool
$c/= :: CId -> CId -> Bool
== :: CId -> CId -> Bool
$c== :: CId -> CId -> Bool
Eq,Eq CId
Eq CId
-> (CId -> CId -> Ordering)
-> (CId -> CId -> Bool)
-> (CId -> CId -> Bool)
-> (CId -> CId -> Bool)
-> (CId -> CId -> Bool)
-> (CId -> CId -> CId)
-> (CId -> CId -> CId)
-> Ord CId
CId -> CId -> Bool
CId -> CId -> Ordering
CId -> CId -> CId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CId -> CId -> CId
$cmin :: CId -> CId -> CId
max :: CId -> CId -> CId
$cmax :: CId -> CId -> CId
>= :: CId -> CId -> Bool
$c>= :: CId -> CId -> Bool
> :: CId -> CId -> Bool
$c> :: CId -> CId -> Bool
<= :: CId -> CId -> Bool
$c<= :: CId -> CId -> Bool
< :: CId -> CId -> Bool
$c< :: CId -> CId -> Bool
compare :: CId -> CId -> Ordering
$ccompare :: CId -> CId -> Ordering
$cp1Ord :: Eq CId
Ord)
wildCId :: CId
wildCId :: CId
wildCId = ByteString -> CId
CId (Char -> ByteString
BS.singleton Char
'_')
mkCId :: String -> CId
mkCId :: String -> CId
mkCId String
s = ByteString -> CId
CId (String -> ByteString
UTF8.fromString String
s)
utf8CId :: ByteString -> CId
utf8CId = ByteString -> CId
CId
readCId :: String -> Maybe CId
readCId :: String -> Maybe CId
readCId String
s = case [CId
x | (CId
x,String
cs) <- ReadP CId -> ReadS CId
forall a. ReadP a -> ReadS a
RP.readP_to_S ReadP CId
pCId String
s, (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace String
cs] of
[CId
x] -> CId -> Maybe CId
forall a. a -> Maybe a
Just CId
x
[CId]
_ -> Maybe CId
forall a. Maybe a
Nothing
showCId :: CId -> String
showCId :: CId -> String
showCId (CId ByteString
x) =
let raw :: String
raw = ByteString -> String
UTF8.toString ByteString
x
in if String -> Bool
isIdent String
raw
then String
raw
else String
"'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
escape String
raw String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"
where
isIdent :: String -> Bool
isIdent [] = Bool
False
isIdent (Char
c:String
cs) = Char -> Bool
isIdentFirst Char
c Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isIdentRest String
cs
escape :: Char -> String
escape Char
'\'' = String
"\\\'"
escape Char
'\\' = String
"\\\\"
escape Char
c = [Char
c]
instance Show CId where
showsPrec :: Int -> CId -> String -> String
showsPrec Int
_ = String -> String -> String
showString (String -> String -> String)
-> (CId -> String) -> CId -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CId -> String
showCId
instance Read CId where
readsPrec :: Int -> ReadS CId
readsPrec Int
_ = ReadP CId -> ReadS CId
forall a. ReadP a -> ReadS a
RP.readP_to_S ReadP CId
pCId
pCId :: RP.ReadP CId
pCId :: ReadP CId
pCId = do String
s <- ReadP String
pIdent
if String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"_"
then ReadP CId
forall a. ReadP a
RP.pfail
else CId -> ReadP CId
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> CId
mkCId String
s)
pIdent :: RP.ReadP String
pIdent :: ReadP String
pIdent =
(Char -> String -> String)
-> ReadP Char -> ReadP String -> ReadP String
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) ((Char -> Bool) -> ReadP Char
RP.satisfy Char -> Bool
isIdentFirst) ((Char -> Bool) -> ReadP String
RP.munch Char -> Bool
isIdentRest)
ReadP String -> ReadP String -> ReadP String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
do Char -> ReadP Char
RP.char Char
'\''
String
cs <- ReadP Char -> ReadP String
forall a. ReadP a -> ReadP [a]
RP.many1 ReadP Char
insideChar
Char -> ReadP Char
RP.char Char
'\''
String -> ReadP String
forall (m :: * -> *) a. Monad m => a -> m a
return String
cs
insideChar :: ReadP Char
insideChar = ReadS Char -> ReadP Char
forall a. ReadS a -> ReadP a
RP.readS_to_P (ReadS Char -> ReadP Char) -> ReadS Char -> ReadP Char
forall a b. (a -> b) -> a -> b
$ \String
s ->
case String
s of
[] -> []
(Char
'\\':Char
'\\':String
cs) -> [(Char
'\\',String
cs)]
(Char
'\\':Char
'\'':String
cs) -> [(Char
'\'',String
cs)]
(Char
'\\':String
cs) -> []
(Char
'\'':String
cs) -> []
(Char
c:String
cs) -> [(Char
c,String
cs)]
isIdentFirst :: Char -> Bool
isIdentFirst Char
c =
(Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') Bool -> Bool -> Bool
||
(Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z') Bool -> Bool -> Bool
||
(Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z') Bool -> Bool -> Bool
||
(Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\192' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\255' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\247' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\215')
isIdentRest :: Char -> Bool
isIdentRest Char
c =
(Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') Bool -> Bool -> Bool
||
(Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'') Bool -> Bool -> Bool
||
(Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9') Bool -> Bool -> Bool
||
(Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z') Bool -> Bool -> Bool
||
(Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z') Bool -> Bool -> Bool
||
(Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\192' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\255' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\247' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\215')
ppCId :: CId -> PP.Doc
ppCId :: CId -> Doc
ppCId = String -> Doc
PP.text (String -> Doc) -> (CId -> String) -> CId -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CId -> String
showCId