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 (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
'_')

-- | Creates a new identifier from 'String'
mkCId :: String -> CId
mkCId :: String -> CId
mkCId String
s = ByteString -> CId
CId (String -> ByteString
UTF8.fromString String
s)

-- | Creates an identifier from a UTF-8-encoded 'ByteString'
utf8CId :: ByteString -> CId
utf8CId = ByteString -> CId
CId

-- | Reads an identifier from 'String'. The function returns 'Nothing' if the string is not valid identifier.
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

-- | Renders the identifier as 'String'
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
--  where
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