module GF.Infra.Ident (
ModuleName(..), moduleNameS,
Ident, ident2utf8, showIdent, prefixIdent,
identS, identC, identW,
identV, identA, identAV,
argIdent, isArgIdent, getArgIndex,
varStr, varX, isWildIdent, varIndex,
RawIdent, rawIdentS, rawIdentC, ident2raw, prefixRawIdent,
isPrefixOf, showRawIdent
) where
import qualified Data.ByteString.UTF8 as UTF8
import qualified Data.ByteString.Char8 as BS(append,isPrefixOf)
import Data.Char(isDigit)
import PGF.Internal(Binary(..))
import GF.Text.Pretty
newtype ModuleName = MN Ident deriving (Eq,Ord)
moduleNameS = MN . identS
instance Show ModuleName where showsPrec d (MN m) = showsPrec d m
instance Pretty ModuleName where pp (MN m) = pp m
data Ident =
IC !RawIdent
| IW
| IV !RawIdent !Int
| IA !RawIdent !Int
| IAV !RawIdent !Int !Int
deriving (Eq, Ord, Show, Read)
newtype RawIdent = Id { rawId2utf8 :: UTF8.ByteString }
deriving (Eq, Ord, Show, Read)
pack = UTF8.fromString
unpack = UTF8.toString
rawIdentS = Id . pack
rawIdentC = Id
showRawIdent = unpack . rawId2utf8
prefixRawIdent (Id x) (Id y) = Id (BS.append x y)
isPrefixOf (Id x) (Id y) = BS.isPrefixOf x y
instance Binary RawIdent where
put = put . rawId2utf8
get = fmap rawIdentC get
ident2utf8 :: Ident -> UTF8.ByteString
ident2utf8 i = case i of
IC (Id s) -> s
IV (Id s) n -> BS.append s (pack ('_':show n))
IA (Id s) j -> BS.append s (pack ('_':show j))
IAV (Id s) b j -> BS.append s (pack ('_':show b ++ '_':show j))
IW -> pack "_"
ident2raw = Id . ident2utf8
showIdent :: Ident -> String
showIdent i = unpack $! ident2utf8 i
instance Pretty Ident where pp = pp . showIdent
identS :: String -> Ident
identS = identC . rawIdentS
identC :: RawIdent -> Ident
identW :: Ident
prefixIdent :: String -> Ident -> Ident
prefixIdent pref = identC . Id . BS.append (pack pref) . ident2utf8
identV :: RawIdent -> Int -> Ident
identA :: RawIdent -> Int -> Ident
identAV:: RawIdent -> Int -> Int -> Ident
(identC, identV, identA, identAV, identW) =
(IC, IV, IA, IAV, IW)
argIdent :: Int -> Ident -> Int -> Ident
argIdent 0 (IC c) i = identA c i
argIdent b (IC c) i = identAV c b i
isArgIdent IA{} = True
isArgIdent IAV{} = True
isArgIdent _ = False
getArgIndex (IA _ i) = Just i
getArgIndex (IAV _ _ i) = Just i
getArgIndex (IC (Id bs))
| isDigit c =
(Just . read . reverse . takeWhile isDigit) s
where s@(c:_) = reverse (unpack bs)
getArgIndex x = Nothing
varStr :: Ident
varStr = identA (rawIdentS "str") 0
varX :: Int -> Ident
varX = identV (rawIdentS "x")
isWildIdent :: Ident -> Bool
isWildIdent x = case x of
IW -> True
IC s | s == wild -> True
_ -> False
wild = Id (pack "_")
varIndex :: Ident -> Int
varIndex (IV _ n) = n
varIndex _ = 1