SymbolNaming.hs

module GI.SymbolNaming
    ( qualify
    , qualifyWithSuffix
    , ucFirst
    , lcFirst
    , lowerName
    , upperName
    , upperNameWithSuffix
    , noName
    , escapeReserved
    , classConstraint
    , hyphensToCamelCase
    , underscoresToCamelCase
    ) where

import Data.Char (toLower, toUpper)
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (Monoid, (<>))
#else
import Data.Monoid ((<>))
#endif
import Data.Text (Text)
import qualified Data.Text as T
import Data.String (IsString)

import GI.API
import GI.Code
import GI.Config (Config(modName))
import GI.Util (split)

classConstraint :: (Monoid a, IsString a) => a -> a
classConstraint n = n <> "K"

ucFirst (x:xs) = toUpper x : xs
ucFirst "" = error "ucFirst: empty string"

lcFirst (x:xs) = toLower x : xs
lcFirst "" = error "lcFirst: empty string"

lowerName :: Name -> CodeGen String
lowerName (Name _ s) = return $ concat . rename $ split '_' s
    where
      rename [w] = [lcFirst w]
      rename (w:ws) = lcFirst w : map ucFirst' ws
      rename [] = error "rename: empty list"

      ucFirst' "" = "_"
      ucFirst' x = ucFirst x

upperNameWithSuffix :: String -> Name -> CodeGen String
upperNameWithSuffix suffix (Name ns s) = do
          prefix <- qualifyWithSuffix suffix ns
          return $ prefix ++ uppered
    where uppered = concatMap ucFirst' $ split '_' $ sanitize s
          -- Move leading underscores to the end (for example in
          -- GObject::_Value_Data_Union -> GObject::Value_Data_Union_)
          sanitize ('_':xs) = sanitize xs ++ "_"
          sanitize xs = xs

          ucFirst' "" = "_"
          ucFirst' x = ucFirst x

upperName :: Name -> CodeGen String
upperName = upperNameWithSuffix "."

-- | Return a qualified prefix for the given namespace. In case the
-- namespace corresponds to the current module the empty string is
-- returned, otherwise the namespace ++ suffix is returned. Suffix is
-- typically just ".", see `qualify` below.
qualifyWithSuffix :: String -> String -> CodeGen String
qualifyWithSuffix suffix ns = do
     cfg <- config
     if modName cfg == Just ns then
         return ""
     else do
       loadDependency ns -- Make sure that the given namespace is listed
                         -- as a dependency of this module.
       return $ ucFirst ns ++ suffix

-- | Return the qualified namespace (ns ++ "." or "", depending on
-- whether ns is the current namespace).
qualify :: String -> CodeGen String
qualify = qualifyWithSuffix "."

-- | Save a bit of typing for optional arguments in the case that we
-- want to pass Nothing.
noName :: String -> CodeGen ()
noName name' = group $ do
                 line $ "no" ++ name' ++ " :: Maybe " ++ name'
                 line $ "no" ++ name' ++ " = Nothing"

-- | For a string of the form "one-sample-string" return "OneSampleString"
hyphensToCamelCase :: String -> String
hyphensToCamelCase str = concatMap ucFirst $ split '-' str

-- | Similarly, turn a name separated_by_underscores into CamelCase.
underscoresToCamelCase :: String -> String
underscoresToCamelCase str = concatMap ucFirst $ split '_' str

escapeReserved :: Text -> String
escapeReserved "type" = "type_"
escapeReserved "in" = "in_"
escapeReserved "data" = "data_"
escapeReserved "instance" = "instance_"
escapeReserved "where" = "where_"
escapeReserved "module" = "module_"
-- Reserved because we generate code that uses these names.
escapeReserved "result" = "result_"
escapeReserved "return" = "return_"
escapeReserved "show" = "show_"
escapeReserved "fromEnum" = "fromEnum_"
escapeReserved "toEnum" = "toEnum_"
escapeReserved "undefined" = "undefined_"
escapeReserved "error" = "error_"
escapeReserved "map" = "map_"
escapeReserved "length" = "length_"
escapeReserved "mapM" = "mapM__"
escapeReserved "mapM_" = "mapM___"
escapeReserved "fromIntegral" = "fromIntegral_"
escapeReserved "realToFrac" = "realToFrac_"
escapeReserved "peek" = "peek_"
escapeReserved "poke" = "poke_"
escapeReserved "sizeOf" = "sizeOf_"
escapeReserved "when" = "when_"
escapeReserved "default" = "default_"
escapeReserved s
    | "set_" `T.isPrefixOf` s = T.unpack s <> "_"
    | "get_" `T.isPrefixOf` s = T.unpack s <> "_"
    | otherwise = T.unpack s