content: {- |
  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")]
  