{- |
Module      :  ./Haskell/TranslateId.hs
Description :  create legal Haskell identifiers
Copyright   :  (c) C.Maeder, Uni Bremen 2003 - 2004
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  Christian.Maeder@dfki.de
Stability   :  experimental
Portability :  portable

Translation of identifiers to Haskell.
-}

module Haskell.TranslateId (IdCase (..), translateIdWithType) where

import Common.Id
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Char

-- | Converts an identifier to a valid lower or upper case Haskell name
translateIdWithType :: IdCase -> Id -> String
translateIdWithType ty i =
  let s = translateId i ""
      c = if null s then error "translateIdWithTyper" else head s
  in case ty of
     UpperId ->
         if isLower c || c == '_' || isDigit c
            then "A__" ++ s else s
     LowerId ->
         if isUpper c || c == '_' || isDigit c || s `Set.member` lowerCaseList
            then "a__" ++ s else s

-- reserved Haskell keywords
lowerCaseList :: Set.Set String
lowerCaseList = Set.fromList [
                 "case", "class", "data", "default", "deriving", "do", "else",
                 "if", "import", "in", "infix", "infixl", "infixr", "instance",
                 "let", "module", "newtype", "of", "then", "type", "where"]

-- | Letter case indicator
data IdCase = UpperId | LowerId

-- | Converts an identifier to a valid Haskell name
translateId :: Id -> ShowS
translateId (Id tlist idlist _) =
    showSepList id translateToken tlist . translateCompound idlist

-- | Translate a 'Token' according to the 'symbolMapping'.
translateToken :: Token -> ShowS
translateToken t = let str = tokStr t in showString $
    if isPlace t then "_2"
    else if all isDigit str && not (isSingle str) then '_' : str
    else if head str == '\'' then
         "_3" ++ concatMap (('_' :) . show . ord) (tail str) ++ "_X"
    else concatMap symbolMapping str

-- | Translate a compound list
translateCompound :: [Id] -> ShowS
-- [      ,      ]
translateCompound ids = noShow (null ids) $ showString "_F"
             . showSepList (showString "_K") translateId ids
             . showString "_J"

{- | Converts characters to parts of Haskell identifiers
thereby translating special ones -}
symbolMapping :: Char -> String
symbolMapping c = Map.findWithDefault [c] c $ Map.fromList
{- avoid compound symbols and keep map injective
Special / reserved -}
   [('_' , "_1"),    -- \95
    ('{' , "_b"),    -- \123
    ('}' , "_r"),    -- \125
    ('[' , "_s"),    -- \91
    (']' , "_q"),    -- \93
    ('.' , "_d"),    -- \46
    ('\'', "_p"),
-- Symbols
    ('+' , "_P"),    -- \43
    ('-' , "_M"),    -- \45
    ('*' , "_T"),    -- \42
    ('/' , "_S"),    -- \47
    ('\\', "_B"),    -- \92
    ('&' , "_A"),    -- \38
    ('=' , "_E"),    -- \61
    ('<' , "_L"),    -- \60
    ('>' , "_G"),    -- \62
    ('!' , "_R"),    -- \33
    ('?' , "_Q"),    -- \63
    (':' , "_C"),    -- \58
    ('$' , "_D"),    -- \36
    ('@' , "_O"),    -- \64
    ('#' , "_H"),    -- \35
    ('^' , "_V"),    -- \94
    ('|' , "_I"),    -- \124
    ('~' , "_N"),    -- \126
    ('\161', "_e"),
    ('\162', "_c"),
    ('\163', "_l"),
    ('\167', "_f"),
    ('\169', "_a"),
    ('\172', "_n"),
    ('\176', "_h"),
    ('\177', "_k"),
    ('\178', "_w"),
    ('\179', "_t"),
    ('\181', "_y"),
    ('\182', "_j"),
    ('\183', "_i"),
    ('\185', "_o"),
    ('\191', "_u"),
    ('\215', "_m"),
    ('\247', "_g")]
