diff --git a/hs-bindgen/src/HsBindgen/Hs/AST/Name.hs b/hs-bindgen/src/HsBindgen/Hs/AST/Name.hs index b3b0ec1..439610b 100644 --- a/hs-bindgen/src/HsBindgen/Hs/AST/Name.hs +++ b/hs-bindgen/src/HsBindgen/Hs/AST/Name.hs @@ -6,8 +6,10 @@ module HsBindgen.Hs.AST.Name ( , toHsName ) where +import Data.Char qualified as Char import Data.String import Data.Text (Text) +import Data.Text qualified as T import HsBindgen.C.AST (CName(..)) @@ -39,9 +41,38 @@ newtype HsName (ns :: Namespace) = HsName { getHsName :: Text } class ToHsName (ns :: Namespace) where toHsName :: CName -> HsName ns --- | (Wrong) catch-all instance +-- TODO -- --- TODO: --- We need to properly implement this. -instance ToHsName ns where - toHsName = HsName . getCName \ No newline at end of file +-- The following instances just adjust the case of the first letter of the name +-- as required, according to the target namespace. We will add a context and +-- options as well as consider edge cases in future commits. + +instance ToHsName NsVar where + toHsName = toHsName' Char.toLower + +instance ToHsName NsConstr where + toHsName = toHsName' Char.toUpper + +instance ToHsName NsTypeVar where + toHsName = toHsName' Char.toLower + +instance ToHsName NsTypeConstr where + toHsName = toHsName' Char.toUpper + +instance ToHsName NsTypeClass where + toHsName = toHsName' Char.toUpper + +instance ToHsName NsModuleName where + toHsName = toHsName' Char.toUpper + +toHsName' :: + (Char -> Char) -- ^ case conversion for first character + -> CName + -> HsName ns +toHsName' f = HsName . aux . getCName + where + aux :: Text -> Text + aux t = case T.uncons t of + Just (c, t') + | Char.isLetter c -> T.cons (f c) t' + _otherwise -> t