    {-# LANGUAGE Safe #-}
    {- | The Z-encoding

    This is the main name-encoding and decoding function.  It encodes any
    string into a string that is acceptable as a C name.  This is code was
    originally part of GHC and used right before emitting a symbol name
    into the compiled C or asm code. This library was created as this
    encoding is useful when working with GHC compiled code or generally
    when C-compatible name mangling is desired.

    -}
    module Text.Encoding.Z (
      zEncodeString,
      zDecodeString,
      UserString,
      EncodedString
    ) where

    import Data.Char
    import Numeric

    type UserString = String        -- ^ As the user typed it
    type EncodedString = String     -- ^ Encoded form

    -- | The basic encoding scheme is this:
    --
    --   * Tuples (,,,) are coded as Z3T
    --
    --   * Alphabetic characters (upper and lower) and digits
    --         all translate to themselves;
    --         except 'Z', which translates to 'ZZ'
    --         and    'z', which translates to 'zz'
    --   We need both so that we can preserve the variable/tycon distinction
    --
    --   * Most other printable characters translate to 'zx' or 'Zx' for some
    --         alphabetic character x
    --
    --   * The others translate as 'znnnU' where 'nnn' is the decimal number
    --         of the character
    --
    -- @
    --         Before          After
    --         --------------------------
    --         Trak            Trak
    --         foo_wib         foozuwib
    --         \>               zg
    --         \>1              zg1
    --         foo\#            foozh
    --         foo\#\#           foozhzh
    --         foo\#\#1          foozhzh1
    --         fooZ            fooZZ
    --         :+              ZCzp
    --         ()              Z0T     0-tuple
    --         (,,,,)          Z5T     5-tuple
    --         (\# \#)           Z1H     unboxed 1-tuple (note the space)
    --         (\#,,,,\#)        Z5H     unboxed 5-tuple
    --                 (NB: There is no Z1T nor Z0H.)
    -- @
    zEncodeString :: UserString -> EncodedString
    zEncodeString :: UserString -> UserString
    zEncodeString UserString
    cs = case UserString -> Maybe UserString
    maybe_tuple UserString
    cs of
                    Just UserString
    n  -> UserString
    n            -- Tuples go to Z2T etc
                    Maybe UserString
    Nothing -> UserString -> UserString
    go UserString
    cs
              where
                    go :: UserString -> UserString
    go []     = []
                    go (Char
    c:UserString
    cs) = Char -> UserString
    encode_digit_ch Char
    c UserString -> UserString -> UserString
    forall a. [a] -> [a] -> [a]
    ++ UserString -> UserString
    go' UserString
    cs
                    go' :: UserString -> UserString
    go' []     = []
                    go' (Char
    c:UserString
    cs) = Char -> UserString
    encode_ch Char
    c UserString -> UserString -> UserString
    forall a. [a] -> [a] -> [a]
    ++ UserString -> UserString
    go' UserString
    cs

    unencodedChar :: Char -> Bool   -- True for chars that don't need encoding
    unencodedChar :: Char -> Bool
    unencodedChar Char
    'Z' = Bool
    False
    unencodedChar Char
    'z' = Bool
    False
    unencodedChar Char
    c   =  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
    '0' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Char
    '9'

    -- If a digit is at the start of a symbol then we need to encode it.
    -- Otherwise package names like 9pH-0.1 give linker errors.
    encode_digit_ch :: Char -> EncodedString
    encode_digit_ch :: Char -> UserString
    encode_digit_ch Char
    c | 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' = Char -> UserString
    encode_as_unicode_char Char
    c
    encode_digit_ch Char
    c | Bool
    otherwise            = Char -> UserString
    encode_ch Char
    c

    encode_ch :: Char -> EncodedString
    encode_ch :: Char -> UserString
    encode_ch Char
    c | Char -> Bool
    unencodedChar Char
    c = [Char
    c]     -- Common case first

    -- Constructors
    encode_ch Char
    '('  = UserString
    "ZL"   -- Needed for things like (,), and (->)
    encode_ch Char
    ')'  = UserString
    "ZR"   -- For symmetry with (
    encode_ch Char
    '['  = UserString
    "ZM"
    encode_ch Char
    ']'  = UserString
    "ZN"
    encode_ch Char
    ':'  = UserString
    "ZC"
    encode_ch Char
    'Z'  = UserString
    "ZZ"

    -- Variables
    encode_ch Char
    'z'  = UserString
    "zz"
    encode_ch Char
    '&'  = UserString
    "za"
    encode_ch Char
    '|'  = UserString
    "zb"
    encode_ch Char
    '^'  = UserString
    "zc"
    encode_ch Char
    '$'  = UserString
    "zd"
    encode_ch Char
    '='  = UserString
    "ze"
    encode_ch Char
    '>'  = UserString
    "zg"
    encode_ch Char
    '#'  = UserString
    "zh"
    encode_ch Char
    '.'  = UserString
    "zi"
    encode_ch Char
    '<'  = UserString
    "zl"
    encode_ch Char
    '-'  = UserString
    "zm"
    encode_ch Char
    '!'  = UserString
    "zn"
    encode_ch Char
    '+'  = UserString
    "zp"
    encode_ch Char
    '\'' = UserString
    "zq"
    encode_ch Char
    '\\' = UserString
    "zr"
    encode_ch Char
    '/'  = UserString
    "zs"
    encode_ch Char
    '*'  = UserString
    "zt"
    encode_ch Char
    '_'  = UserString
    "zu"
    encode_ch Char
    '%'  = UserString
    "zv"
    encode_ch Char
    c    = Char -> UserString
    encode_as_unicode_char Char
    c

    encode_as_unicode_char :: Char -> EncodedString
    encode_as_unicode_char :: Char -> UserString
    encode_as_unicode_char Char
    c = Char
    'z' Char -> UserString -> UserString
    forall a. a -> [a] -> [a]
    : if Char -> Bool
    isDigit (UserString -> Char
    forall a. HasCallStack => [a] -> a
    head UserString
    hex_str) then UserString
    hex_str
                                                               else Char
    '0'Char -> UserString -> UserString
    forall a. a -> [a] -> [a]
    :UserString
    hex_str
      where hex_str :: UserString
    hex_str = Int -> UserString -> UserString
    forall a. Integral a => a -> UserString -> UserString
    showHex (Char -> Int
    ord Char
    c) UserString
    "U"
      -- ToDo: we could improve the encoding here in various ways.
      -- eg. strings of unicode characters come out as 'z1234Uz5678U', we
      -- could remove the 'U' in the middle (the 'z' works as a separator).

    -- | The inverse of 'zEncodeString'
    zDecodeString :: EncodedString -> UserString
    zDecodeString :: UserString -> UserString
    zDecodeString [] = []
    zDecodeString (Char
    'Z' : Char
    d : UserString
    rest)
      | Char -> Bool
    isDigit Char
    d = Char -> UserString -> UserString
    decode_tuple   Char
    d UserString
    rest
      | Bool
    otherwise = Char -> Char
    decode_upper   Char
    d Char -> UserString -> UserString
    forall a. a -> [a] -> [a]
    : UserString -> UserString
    zDecodeString UserString
    rest
    zDecodeString (Char
    'z' : Char
    d : UserString
    rest)
      | Char -> Bool
    isDigit Char
    d = Char -> UserString -> UserString
    decode_num_esc Char
    d UserString
    rest
      | Bool
    otherwise = Char -> Char
    decode_lower   Char
    d Char -> UserString -> UserString
    forall a. a -> [a] -> [a]
    : UserString -> UserString
    zDecodeString UserString
    rest
    zDecodeString (Char
    c   : UserString
    rest) = Char
    c Char -> UserString -> UserString
    forall a. a -> [a] -> [a]
    : UserString -> UserString
    zDecodeString UserString
    rest

    decode_upper, decode_lower :: Char -> Char

    decode_upper :: Char -> Char
    decode_upper Char
    'L' = Char
    '('
    decode_upper Char
    'R' = Char
    ')'
    decode_upper Char
    'M' = Char
    '['
    decode_upper Char
    'N' = Char
    ']'
    decode_upper Char
    'C' = Char
    ':'
    decode_upper Char
    'Z' = Char
    'Z'
    decode_upper Char
    ch  = {-pprTrace "decode_upper" (char ch)-} Char
    ch

    decode_lower :: Char -> Char
    decode_lower Char
    'z' = Char
    'z'
    decode_lower Char
    'a' = Char
    '&'
    decode_lower Char
    'b' = Char
    '|'
    decode_lower Char
    'c' = Char
    '^'
    decode_lower Char
    'd' = Char
    '$'
    decode_lower Char
    'e' = Char
    '='
    decode_lower Char
    'g' = Char
    '>'
    decode_lower Char
    'h' = Char
    '#'
    decode_lower Char
    'i' = Char
    '.'
    decode_lower Char
    'l' = Char
    '<'
    decode_lower Char
    'm' = Char
    '-'
    decode_lower Char
    'n' = Char
    '!'
    decode_lower Char
    'p' = Char
    '+'
    decode_lower Char
    'q' = Char
    '\''
    decode_lower Char
    'r' = Char
    '\\'
    decode_lower Char
    's' = Char
    '/'
    decode_lower Char
    't' = Char
    '*'
    decode_lower Char
    'u' = Char
    '_'
    decode_lower Char
    'v' = Char
    '%'
    decode_lower Char
    ch  = {-pprTrace "decode_lower" (char ch)-} Char
    ch

    -- Characters not having a specific code are coded as z224U (in hex)
    decode_num_esc :: Char -> EncodedString -> UserString
    decode_num_esc :: Char -> UserString -> UserString
    decode_num_esc Char
    d UserString
    rest
      = Int -> UserString -> UserString
    go (Char -> Int
    digitToInt Char
    d) UserString
    rest
      where
        go :: Int -> UserString -> UserString
    go Int
    n (Char
    c : UserString
    rest) | Char -> Bool
    isHexDigit Char
    c = Int -> UserString -> UserString
    go (Int
    16Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Char -> Int
    digitToInt Char
    c) UserString
    rest
        go Int
    n (Char
    'U' : UserString
    rest)           = Int -> Char
    chr Int
    n Char -> UserString -> UserString
    forall a. a -> [a] -> [a]
    : UserString -> UserString
    zDecodeString UserString
    rest
        go Int
    n UserString
    other = UserString -> UserString
    forall a. HasCallStack => UserString -> a
    error (UserString
    "decode_num_esc: " UserString -> UserString -> UserString
    forall a. [a] -> [a] -> [a]
    ++ Int -> UserString
    forall a. Show a => a -> UserString
    show Int
    n UserString -> UserString -> UserString
    forall a. [a] -> [a] -> [a]
    ++  Char
    ' 'Char -> UserString -> UserString
    forall a. a -> [a] -> [a]
    :UserString
    other)

    decode_tuple :: Char -> EncodedString -> UserString
    decode_tuple :: Char -> UserString -> UserString
    decode_tuple Char
    d UserString
    rest
      = Int -> UserString -> UserString
    go (Char -> Int
    digitToInt Char
    d) UserString
    rest
      where
            -- NB. recurse back to zDecodeString after decoding the tuple, because
            -- the tuple might be embedded in a longer name.
        go :: Int -> UserString -> UserString
    go Int
    n (Char
    c : UserString
    rest) | Char -> Bool
    isDigit Char
    c = Int -> UserString -> UserString
    go (Int
    10Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Char -> Int
    digitToInt Char
    c) UserString
    rest
        go Int
    0 (Char
    'T':UserString
    rest)     = UserString
    "()" UserString -> UserString -> UserString
    forall a. [a] -> [a] -> [a]
    ++ UserString -> UserString
    zDecodeString UserString
    rest
        go Int
    n (Char
    'T':UserString
    rest)     = Char
    '(' Char -> UserString -> UserString
    forall a. a -> [a] -> [a]
    : Int -> Char -> UserString
    forall a. Int -> a -> [a]
    replicate (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) Char
    ',' UserString -> UserString -> UserString
    forall a. [a] -> [a] -> [a]
    ++ UserString
    ")" UserString -> UserString -> UserString
    forall a. [a] -> [a] -> [a]
    ++ UserString -> UserString
    zDecodeString UserString
    rest
        go Int
    1 (Char
    'H':UserString
    rest)     = UserString
    "(# #)" UserString -> UserString -> UserString
    forall a. [a] -> [a] -> [a]
    ++ UserString -> UserString
    zDecodeString UserString
    rest
        go Int
    n (Char
    'H':UserString
    rest)     = Char
    '(' Char -> UserString -> UserString
    forall a. a -> [a] -> [a]
    : Char
    '#' Char -> UserString -> UserString
    forall a. a -> [a] -> [a]
    : Int -> Char -> UserString
    forall a. Int -> a -> [a]
    replicate (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) Char
    ',' UserString -> UserString -> UserString
    forall a. [a] -> [a] -> [a]
    ++ UserString
    "#)" UserString -> UserString -> UserString
    forall a. [a] -> [a] -> [a]
    ++ UserString -> UserString
    zDecodeString UserString
    rest
        go Int
    n UserString
    other = UserString -> UserString
    forall a. HasCallStack => UserString -> a
    error (UserString
    "decode_tuple: " UserString -> UserString -> UserString
    forall a. [a] -> [a] -> [a]
    ++ Int -> UserString
    forall a. Show a => a -> UserString
    show Int
    n UserString -> UserString -> UserString
    forall a. [a] -> [a] -> [a]
    ++ Char
    ' 'Char -> UserString -> UserString
    forall a. a -> [a] -> [a]
    :UserString
    other)

    {-
    Tuples are encoded as
            Z3T or Z3H
    for 3-tuples or unboxed 3-tuples respectively.  No other encoding starts
            Z<digit>

    * "(# #)" is the tycon for an unboxed 1-tuple (not 0-tuple)
      There are no unboxed 0-tuples.

    * "()" is the tycon for a boxed 0-tuple.
      There are no boxed 1-tuples.
    -}

    maybe_tuple :: UserString -> Maybe EncodedString

    maybe_tuple :: UserString -> Maybe UserString
    maybe_tuple UserString
    "(# #)" = UserString -> Maybe UserString
    forall a. a -> Maybe a
    Just(UserString
    "Z1H")
    maybe_tuple (Char
    '(' : Char
    '#' : UserString
    cs) = case Int -> UserString -> (Int, UserString)
    count_commas (Int
    0::Int) UserString
    cs of
                                     (Int
    n, Char
    '#' : Char
    ')' : UserString
    _) -> UserString -> Maybe UserString
    forall a. a -> Maybe a
    Just (Char
    'Z' Char -> UserString -> UserString
    forall a. a -> [a] -> [a]
    : Int -> UserString -> UserString
    forall a. Show a => a -> UserString -> UserString
    shows (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) UserString
    "H")
                                     (Int, UserString)
    _                  -> Maybe UserString
    forall a. Maybe a
    Nothing
    maybe_tuple UserString
    "()" = UserString -> Maybe UserString
    forall a. a -> Maybe a
    Just(UserString
    "Z0T")
    maybe_tuple (Char
    '(' : UserString
    cs)       = case Int -> UserString -> (Int, UserString)
    count_commas (Int
    0::Int) UserString
    cs of
                                     (Int
    n, Char
    ')' : UserString
    _) -> UserString -> Maybe UserString
    forall a. a -> Maybe a
    Just (Char
    'Z' Char -> UserString -> UserString
    forall a. a -> [a] -> [a]
    : Int -> UserString -> UserString
    forall a. Show a => a -> UserString -> UserString
    shows (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) UserString
    "T")
                                     (Int, UserString)
    _            -> Maybe UserString
    forall a. Maybe a
    Nothing
    maybe_tuple UserString
    _                = Maybe UserString
    forall a. Maybe a
    Nothing

    count_commas :: Int -> String -> (Int, String)
    count_commas :: Int -> UserString -> (Int, UserString)
    count_commas Int
    n (Char
    ',' : UserString
    cs) = Int -> UserString -> (Int, UserString)
    count_commas (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) UserString
    cs
    count_commas Int
    n UserString
    cs         = (Int
    n,UserString
    cs)