diff --git a/servant-csharp.cabal b/servant-csharp.cabal --- a/servant-csharp.cabal +++ b/servant-csharp.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: servant-csharp -version: 0.0.4.0 +version: 0.0.5.0 synopsis: Generate servant client library for C# description: Generate servant client library for C# homepage: https://github.com/cutsea110/servant-csharp.git diff --git a/src/CS.hs b/src/CS.hs --- a/src/CS.hs +++ b/src/CS.hs @@ -1,4 +1,6 @@ -module CS ( apiCsForAPI +module CS ( classCsForAPI + , classCsForAPIWith + , apiCsForAPI , apiCsForAPIWith , enumCsForAPI , enumCsForAPIWith diff --git a/src/CS/JsonDotNet.hs b/src/CS/JsonDotNet.hs --- a/src/CS/JsonDotNet.hs +++ b/src/CS/JsonDotNet.hs @@ -4,7 +4,9 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -module CS.JsonDotNet ( apiCsForAPI +module CS.JsonDotNet ( classCsForAPI + , classCsForAPIWith + , apiCsForAPI , apiCsForAPIWith , enumCsForAPI , enumCsForAPIWith @@ -34,6 +36,7 @@ data GenerateCsConfig = GenerateCsConfig { namespace :: String + , classtemplate :: GenerateCsConfig -> IO String , apitemplate :: forall api. (HasForeign CSharp Text api, GenerateList Text (Foreign Text api)) @@ -47,6 +50,7 @@ def :: GenerateCsConfig def = GenerateCsConfig { namespace = "ServantClientAPI" + , classtemplate = defClassTemplate , apitemplate = defAPITemplate , enumtemplate = defEnumTemplate , convtemplate = defConvTemplate @@ -54,6 +58,88 @@ } -------------------------------------------------------------------------- +isDatatypeDecl :: Decl -> Bool +isDatatypeDecl (DataDecl _ DataType _ _ _ [qcon] _) = True +isDatatypeDecl _ = False + +data FieldType = TInt + | TString + | TDay + | TUTCTime + | TEnum String + | TGeneral String + | TNewtype String FieldType + | TList FieldType + | TNullable FieldType + +instance Show FieldType where + show TInt = "int" + show TString = "string" + show TDay = "DateTime" + show TUTCTime = "DateTime" + show (TEnum s) = s + show (TGeneral s) = s + show (TNewtype s _) = s + show (TList t) = "List<"<>show t<>">" + show (TNullable TInt) = "int?" + show (TNullable TString) = "string" + show (TNullable TDay) = "DateTime?" + show (TNullable TUTCTime) = "DateTime?" + show (TNullable (TEnum t)) = show (TEnum t)<>"?" + show (TNullable (TNewtype s TString)) = s + show (TNullable (TNewtype s _)) = "Nullable<"<>s<>">" + show (TNullable t) = "Nullable<"<>show t<>">" + +showCSharpOriginalType :: FieldType -> String +showCSharpOriginalType TInt = "System.Int64" +showCSharpOriginalType TString = "System.String" +showCSharpOriginalType _ = error "don't support this type." + +classTypes :: GenerateCsConfig -> IO [(String, [(String, FieldType)])] +classTypes conf = do + enums <- fmap (map fst) $ enumTypes conf + aliases <- usingAliases conf + classTypesFromFiles enums aliases (sources conf) + where + classTypesFromFiles :: [String] -> [(String, FieldType)] -> [FilePath] + -> IO [(String, [(String, FieldType)])] + classTypesFromFiles enums aliases hss + = return . concat =<< mapM (classTypesFromFile enums aliases) hss + + classTypesFromFile :: [String] -> [(String, FieldType)] -> FilePath + -> IO [(String, [(String, FieldType)])] + classTypesFromFile enums aliases hs = do + ParseOk (Module _ _ _ _ _ _ decls) <- parseFile hs + let xs = filter isDatatypeDecl decls + return $ map toClass xs + where + toClass (DataDecl _ _ _ _ _ [qcon] _) + = toClass' qcon + toClass' (QualConDecl _ _ _ (RecDecl (Ident name) fs)) + = (name, map field fs) + field ((Ident fname):[], ts) + = (fname, toType ts) + toType :: Type -> FieldType + toType (TyCon (UnQual (Ident t))) + = case t of + "String" -> TString + "Text" -> TString + "Int" -> TInt + "Integer" -> TInt + "Day" -> TDay + "UTCTime" -> TUTCTime + _ -> if t `elem` enums + then TEnum t + else maybe (TGeneral t) (TNewtype t) + $ lookup t aliases + toType (TyApp (TyCon (UnQual (Ident "Maybe"))) t) + = case toType t of + TList t -> TList t + t -> TNullable t + toType (TyList t) = TList (toType t) + toType _ = error "don't support this Type" + +-------------------------------------------------------------------------- isEnumLikeDataDecl :: Decl -> Bool isEnumLikeDataDecl (DataDecl _ DataType _ _ _ xs _) = all isEnumLikeConDecl xs @@ -63,50 +149,66 @@ isEnumLikeConDecl (QualConDecl _ _ _ (ConDecl _ [])) = True isEnumLikeConDecl _ = False -enumTypesFromFiles :: [FilePath] -> IO [(String, [String])] -enumTypesFromFiles hss - = return . concat =<< mapM enumTypesFromFile hss - -enumTypesFromFile :: FilePath -> IO [(String, [String])] -enumTypesFromFile hs = do - ParseOk (Module _ _ _ _ _ _ decls) <- parseFile hs - let xs = filter isEnumLikeDataDecl decls - return $ map toTuple xs +enumTypes :: GenerateCsConfig -> IO [(String, [String])] +enumTypes = enumTypesFromFiles . sources where - conName :: QualConDecl -> String - conName (QualConDecl _ _ _ (ConDecl (Ident name) [])) = name - conName _ = error "invalid enum type" - toTuple (DataDecl _ _ _ (Ident name) _ xs _) - = (name, map conName xs) + enumTypesFromFiles :: [FilePath] -> IO [(String, [String])] + enumTypesFromFiles hss + = return . concat =<< mapM enumTypesFromFile hss + enumTypesFromFile :: FilePath -> IO [(String, [String])] + enumTypesFromFile hs = do + ParseOk (Module _ _ _ _ _ _ decls) <- parseFile hs + let xs = filter isEnumLikeDataDecl decls + return $ map toTuple xs + where + conName :: QualConDecl -> String + conName (QualConDecl _ _ _ (ConDecl (Ident name) [])) = name + conName _ = error "invalid enum type" + toTuple (DataDecl _ _ _ (Ident name) _ xs _) + = (name, map conName xs) + -------------------------------------------------------------------------- -- | TODO : more typeable isNewtypeDecl :: Decl -> Bool isNewtypeDecl (DataDecl _ NewType _ _ _ _ _) = True isNewtypeDecl _ = False -origType :: QualConDecl -> String -origType (QualConDecl _ _ _ (RecDecl _ [(_, TyCon (UnQual (Ident t)))])) - = case t of - "String" -> "System.String" - "Text" -> "System.String" - "Int" -> "System.Int64" - "Integer" -> "System.Int64" - t -> error "don't supported type. "<>t +isTypeDecl :: Decl -> Bool +isTypeDecl (TypeDecl _ _ _ _) = True +isTypeDecl _ = False -usingAliasesFromFiles :: [FilePath] -> IO [(String, String)] -usingAliasesFromFiles hss - = return . concat =<< mapM usingAliasesFromFile hss +origType :: QualConDecl -> FieldType +origType (QualConDecl _ _ _ (RecDecl _ [(_, tycon)])) + = origType' tycon -usingAliasesFromFile :: FilePath -> IO [(String, String)] -usingAliasesFromFile hs = do - ParseOk (Module _ _ _ _ _ _ decls) <- parseFile hs - let xs = filter isNewtypeDecl decls - return $ map toTuple xs +origType' :: Type -> FieldType +origType' (TyCon (UnQual (Ident t))) + = case t of + "String" -> TString + "Text" -> TString + "Int" -> TInt + "Integer" -> TInt + t -> error ("don't supported type. "<>t) + +usingAliases :: GenerateCsConfig -> IO [(String, FieldType)] +usingAliases = usingAliasesFromFiles . sources where - toTuple (DataDecl _ NewType _ (Ident name) _ [qcon] _) - = (name, origType qcon) + usingAliasesFromFiles :: [FilePath] -> IO [(String, FieldType)] + usingAliasesFromFiles hss + = return . concat =<< mapM usingAliasesFromFile hss + usingAliasesFromFile :: FilePath -> IO [(String, FieldType)] + usingAliasesFromFile hs = do + ParseOk (Module _ _ _ _ _ _ decls) <- parseFile hs + let xs = filter (\d -> isNewtypeDecl d || isTypeDecl d) decls + return $ map toTuple xs + where + toTuple (DataDecl _ NewType _ (Ident name) _ [qcon] _) + = (name, origType qcon) + toTuple (TypeDecl _ (Ident name) _ tycon) + = (name, origType' tycon) + -------------------------------------------------------------------------- retType :: Req Text -> String retType = T.unpack . fromJust . view reqReturnType @@ -185,6 +287,12 @@ requestBodyExists :: Req Text -> Bool requestBodyExists = not . null . rqBody +classCsForAPI :: IO String +classCsForAPI = classCsForAPIWith def + +classCsForAPIWith :: GenerateCsConfig -> IO String +classCsForAPIWith conf = (classtemplate conf) conf + apiCsForAPI :: (HasForeign CSharp Text api, GenerateList Text (Foreign Text api)) => Proxy api -> IO String @@ -207,11 +315,57 @@ converterCsForAPIWith :: GenerateCsConfig -> IO String converterCsForAPIWith conf = (convtemplate conf) conf +defClassTemplate :: GenerateCsConfig -> IO String +defClassTemplate conf = do + uas <- usingAliases conf + classes <- classTypes conf + return [heredoc| +using Newtonsoft.Json; +using Newtonsoft.Converters; +using System; +using System.Collections.Generic; + +#region type alias +$forall (n, t) <- uas + using ${n} = ${showCSharpOriginalType t}; +#endregion + +namespace ${namespace conf} +{ + $forall (name, fields) <- classes + #region ${name} + [JsonObject("${name}")] + public class ${name} + { + $forall (fname, ftype) <- fields + $case ftype + $of TDay + [JsonProperty(PropertyName = "${fname}")] + [JsonConverter(typeof(DayConverter))] + $of TNullable TDay + [JsonProperty(PropertyName = "${fname}")] + [JsonConverter(typeof(DayConverter))] + $of TEnum _ + [JsonProperty(PropertyName = "${fname}")] + [JsonConverter(typeof(StringEnumConverter))] + $of TNullable (TEnum _) + [JsonProperty(PropertyName = "${fname}")] + [JsonConverter(typeof(StringEnumConverter))] + $of TList (TEnum _) + [JsonProperty(PropertyName = "${fname}", ItemConverterType = typeof(StringEnumConverter))] + $of _ + [JsonProperty(PropertyName = "${fname}")] + public ${show ftype} ${fname} { get; set; } + } + #endregion +} +|] + defAPITemplate :: (HasForeign CSharp Text api, GenerateList Text (Foreign Text api)) => GenerateCsConfig -> Proxy api -> IO String defAPITemplate conf api = do - usingAliases <- usingAliasesFromFiles $ sources conf + uas <- usingAliases conf return [heredoc|/* generated by servant-csharp */ using Newtonsoft.Json; using System.Collections.Generic; @@ -223,8 +377,8 @@ using System.Threading.Tasks; #region type alias -$forall (n, t) <- usingAliases - using ${n} = ${t}; +$forall (n, t) <- uas + using ${n} = ${showCSharpOriginalType t}; #endregion namespace ${namespace conf} @@ -304,7 +458,7 @@ |] defEnumTemplate conf = do - es <- enumTypesFromFiles $ sources conf + es <- enumTypes conf return [heredoc|/* generated by servant-csharp */ namespace ${namespace conf} { @@ -320,7 +474,7 @@ |] defConvTemplate conf = do - return [heredoc| + return [heredoc|/* generated by servant-csharp */ using Newtonsoft.Json; using System;