servant-csharp 0.0.7.1 → 0.0.8.0

raw patch · 6 files changed

+368/−337 lines, 6 filesdep +aesondep +mtldep +servant-swaggerPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: aeson, mtl, servant-swagger, swagger2, unordered-containers

API changes (from Hackage documentation)

Files

• servant-csharp.cabal +11/−2
• src/CS.hs +1/−14
• src/CS/JsonDotNet.hs +246/−321
• src/CS/JsonDotNet/Base.hs +46/−0
• src/CS/JsonDotNet/Internal.hs +4/−0
• src/CS/JsonDotNet/Internal/Types.hs +60/−0

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                servant-csharp-version:             0.0.7.1+version:             0.0.8.0 synopsis:            Generate servant client library for C# description:         Generate servant client library for C# homepage:            https://github.com/cutsea110/servant-csharp.git@@ -20,15 +20,20 @@   exposed-modules:     CS                      , CS.Common                      , CS.JsonDotNet+                     , CS.JsonDotNet.Base+                     , CS.JsonDotNet.Internal+                     , CS.JsonDotNet.Internal.Types   -- other-modules:          other-extensions:    OverloadedStrings                      , ScopedTypeVariables                      , MultiParamTypeClasses                      , FlexibleContexts                      , FlexibleInstances+                     , TupleSections                      , TypeSynonymInstances                      , QuasiQuotes-  build-depends:       base >=4.8 && <4.9+  build-depends:       aeson >= 0.11.1.4+                     , base >=4.8 && <4.9                      , bytestring >=0.10 && <0.11                      , directory >=1.2 && <1.3                      , filepath >=1.4 && <1.5@@ -36,10 +41,14 @@                      , heredocs >=0.1 && <0.2                      , http-types >=0.9 && <0.10                      , lens >=4.13 && <4.14+                     , mtl >= 2.2.1                      , servant >= 0.6.1                      , servant-foreign >=0.7 && <0.8+                     , servant-swagger >= 1.0.3+                     , swagger2 >= 2.0.2                      , text >=1.2 && <1.3                      , time >=1.5 && <1.6+                     , unordered-containers >= 0.2.7.0                      , uuid >=1.3 && <1.4                      , uuid-types >=1.0 && <1.1   hs-source-dirs:      src

@@ -1,17 +1,4 @@-module CS ( genCsForAPI--          , classCsForAPI-          , classCsForAPIWith-          , apiCsForAPI-          , apiCsForAPIWith-          , enumCsForAPI-          , enumCsForAPIWith-          , converterCsForAPI-          , converterCsForAPIWith-          , assemblyInfoCsForAPI-          , assemblyInfoCsForAPIWith-          , csprojForAPI-          , csprojForAPIWith+module CS ( generateCsForAPI            , GenerateCsConfig(..)           , def

@@ -1,255 +1,91 @@ {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}-module CS.JsonDotNet ( genCsForAPI+{-# LANGUAGE TupleSections #-}+module CS.JsonDotNet ( GenerateCsConfig(..)+                     , def -                     , classCsForAPI-                     , classCsForAPIWith-                     , apiCsForAPI-                     , apiCsForAPIWith-                     , enumCsForAPI-                     , enumCsForAPIWith-                     , converterCsForAPI-                     , converterCsForAPIWith-                     , assemblyInfoCsForAPI-                     , assemblyInfoCsForAPIWith-                     , csprojForAPI-                     , csprojForAPIWith+                     , generateCsForAPI -                     , GenerateCsConfig(..)-                     , def+                     , apiCsFrom+                     , enumCs+                     , classCs+                     , converterCs+                     , assemblyInfoCs+                     , projectCsproj                      ) where -import Prelude hiding (concat, lines, unlines)-import Control.Arrow++import Control.Arrow ((***), (&&&)) import Control.Lens hiding ((<.>))+import Control.Monad.Trans+import Control.Monad.Identity+import Data.Aeson import Data.ByteString (ByteString) import Data.ByteString.Char8 as BC (unpack) import Data.Char (toUpper, toLower)-import Data.List (intercalate, concat)+import qualified Data.HashMap.Lazy as M+import Data.List (intercalate) import Data.Maybe (fromJust) import Data.Monoid ((<>)) import Data.Proxy-import Data.Text as T (Text, unpack, pack)+import Data.Swagger hiding (namespace)+import Data.Text as T (Text, unpack) import Data.Time.Clock (UTCTime(..), getCurrentTime) import Data.Time.Calendar (toGregorian)-import Data.UUID.Types (toString)+import System.Directory (createDirectoryIfMissing)+import System.FilePath ((</>),(<.>))+import Data.UUID.Types (toString, UUID) import Data.UUID.V4 as UUID (nextRandom)-import Language.Haskell.Exts import Servant.Foreign-import System.Directory (createDirectoryIfMissing)-import System.FilePath ((</>), (<.>))+import Servant.Swagger import Text.Heredoc  import CS.Common (CSharp, getEndpoints)+import CS.JsonDotNet.Internal+import CS.JsonDotNet.Base  data GenerateCsConfig     = GenerateCsConfig { namespace :: String-                       , outdir :: String                        , classCsName :: String                        , apiCsName :: String                        , enumCsName :: String                        , converterCsName :: String-                       , classtemplate :: GenerateCsConfig -> IO String-                       , apitemplate ::  forall api.-                                         (HasForeign CSharp Text api,-                                          GenerateList Text (Foreign Text api))-                                         => GenerateCsConfig-                                     -> Proxy api-                                     -> IO String-                       , enumtemplate :: GenerateCsConfig -> IO String-                       , convertertemplate :: GenerateCsConfig -> IO String-                       , assemblyinfotemplate :: GenerateCsConfig -> IO String-                       , csprojtemplate :: GenerateCsConfig -> IO String-                       , guid :: Maybe String-                       , sources :: [FilePath]+                       , guid :: Maybe UUID                        }  def :: GenerateCsConfig def = GenerateCsConfig { namespace = "ServantClientAPI"-                       , outdir = "gen"                        , classCsName = "Classes.cs"                        , apiCsName = "API.cs"                        , enumCsName = "Enum.cs"                        , converterCsName = "JsonConverter.cs"-                       , classtemplate = defClassTemplate-                       , apitemplate = defAPITemplate-                       , enumtemplate = defEnumTemplate-                       , convertertemplate = defConvTemplate-                       , assemblyinfotemplate = defAssemblyInfoTemplate-                       , csprojtemplate = defCsprojTemplate                        , guid = Nothing-                       , sources = []                        } -genCsForAPI :: (HasForeign CSharp Text api,-             GenerateList Text (Foreign Text api)) =>-            GenerateCsConfig -> Proxy api -> IO ()-genCsForAPI conf api = do-  guid' <- maybe (toString <$> UUID.nextRandom) return $ guid conf-  let conf' = conf { guid = Just guid' }-  createDirectoryIfMissing True $ outdir conf' </> namespace conf' </> "Properties"-  classCsForAPIWith conf' >>= writeFile (outdir conf' </> namespace conf' </> classCsName conf')-  apiCsForAPIWith conf' api >>= writeFile (outdir conf' </> namespace conf' </> apiCsName conf')-  enumCsForAPIWith conf' >>= writeFile (outdir conf' </> namespace conf' </> enumCsName conf')-  converterCsForAPIWith conf' >>= writeFile (outdir conf' </> namespace conf' </> converterCsName conf')-  assemblyInfoCsForAPIWith conf' >>= writeFile (outdir conf' </> namespace conf' </> "Properties" </> "AssemblyInfo.cs")-  csprojForAPIWith conf' >>= writeFile (outdir conf' </> namespace conf' </> namespace conf' <.> "csproj")- ---------------------------------------------------------------------------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-isEnumLikeDataDecl _ = False--isEnumLikeConDecl :: QualConDecl -> Bool-isEnumLikeConDecl (QualConDecl _ _ _ (ConDecl _ [])) = True-isEnumLikeConDecl _ = False--enumTypes :: GenerateCsConfig -> IO [(String, [String])]-enumTypes = enumTypesFromFiles . sources-    where-      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--isTypeDecl :: Decl -> Bool-isTypeDecl (TypeDecl _ _ _ _) = True-isTypeDecl _ = False--origType :: QualConDecl -> FieldType-origType (QualConDecl _ _ _ (RecDecl _ [(_, tycon)]))-    = origType' tycon--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-      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)+-- | generate C# project+generateCsForAPI :: (HasSwagger api, HasForeign CSharp Text api,+                     GenerateList Text (Foreign Text api)) =>+                    GenerateCsConfig -> Proxy api -> IO ()+generateCsForAPI conf api = do+  let outDir = "gen" </> namespace conf+      swagger = toSwagger api+  writeFile (outDir </> "AssemblyInfo.cs") =<< assemblyInfoCs conf+  writeFile (outDir </> namespace conf <.> "csproj") =<< projectCsproj conf+  writeFile (outDir </> classCsName conf)+                $ runSwagger (classCs conf) swagger+  writeFile (outDir </> enumCsName conf)+                $ runSwagger enumCs swagger+  writeFile (outDir </> converterCsName conf)+                $ runSwagger (converterCs conf) swagger+  writeFile (outDir </> apiCsName conf)+                $ runSwagger (apiCsFrom conf api) swagger  -------------------------------------------------------------------------- retType :: Req Text -> String@@ -329,85 +165,11 @@ 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-apiCsForAPI = apiCsForAPIWith def--apiCsForAPIWith :: (HasForeign CSharp Text api,-                 GenerateList Text (Foreign Text api)) =>-                GenerateCsConfig -> Proxy api -> IO String-apiCsForAPIWith conf api = (apitemplate conf) conf api--enumCsForAPI :: IO String-enumCsForAPI = enumCsForAPIWith def--enumCsForAPIWith :: GenerateCsConfig -> IO String-enumCsForAPIWith conf = (enumtemplate conf) conf--converterCsForAPI :: IO String-converterCsForAPI = converterCsForAPIWith def--converterCsForAPIWith :: GenerateCsConfig -> IO String-converterCsForAPIWith conf = (convertertemplate conf) conf--defClassTemplate :: GenerateCsConfig -> IO String-defClassTemplate conf = do-  uas <- usingAliases conf-  classes <- classTypes conf-  return [heredoc|/* generated by servant-csharp */-using Newtonsoft.Json;-using Newtonsoft.Json.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-  uas <- usingAliases conf+apiCsFrom :: (Monad m, HasForeign CSharp Text api,+              GenerateList Text (Foreign Text api)) =>+             GenerateCsConfig -> Proxy api -> SwagT m String+apiCsFrom conf api = do+  uas <- prims   return [heredoc|/* generated by servant-csharp */ using Newtonsoft.Json; using System.Collections.Generic;@@ -420,7 +182,7 @@  #region type alias $forall (n, t) <- uas-  using ${n} = ${showCSharpOriginalType t};+  using ${T.unpack n} = ${showCSharpOriginalType t}; #endregion  namespace ${namespace conf}@@ -499,29 +261,206 @@ } |] -defEnumTemplate conf = do-  es <- enumTypes conf+--------------------------------------------------------------------------++defs :: Monad m => SwagT m [(Text, Schema)]+defs = mkSwag (M.toList . _swaggerDefinitions)++pathitems :: Monad m => SwagT m [(FilePath, PathItem)]+pathitems = mkSwag (M.toList . _swaggerPaths)++convProperty :: Monad m => ParamName -> Referenced Schema -> Bool+             -> SwagT m (ParamName, FieldType)+convProperty pname rs req+    = if req+      then convProp pname rs+      else do+        (n, f) <- convProp pname rs+        return (n, FNullable f)+    where+      convProp :: Monad m+                  => ParamName+                      -> Referenced Schema+                      -> SwagT m (ParamName, FieldType)+      convProp n (Ref (Reference s)) = convRef n s+      convProp n (Inline s) = convert (n, s)++convRef :: Monad m+           => ParamName -> Text -> SwagT m (ParamName, FieldType)+convRef pname tname = do+  fs <- enums <> prims <> models+  case lookup tname fs of+    Just ftype -> return $ (pname, conv ftype)+    Nothing -> error $ T.unpack $ "not found " <> pname+  where+    conv :: FieldType -> FieldType+    conv f | isFEnum f = FRefEnum tname+           | isFPrim f = FRefPrim tname f+           | isFObj  f = FRefObject tname+  +convObject :: Monad m => (Text, Schema) -> SwagT m (Text, FieldType)+convObject (name, s) = do+  return . (name,) . FObject name =<< fields+    where+      fields :: Monad m => SwagT m [(ParamName, FieldType)]+      fields = mapM (\(p, s) -> (convProperty p s (isReq p))) props+      props :: [(ParamName, Referenced Schema)]+      props = M.toList (_schemaProperties s)+      isReq :: ParamName -> Bool+      isReq pname = pname `elem` reqs+      reqs :: [ParamName]+      reqs = _schemaRequired s++convert :: Monad m => (Text, Schema) -> SwagT m (Text, FieldType)+convert (name, s) = do+  if not $ null enums'+  then return $ (name, FEnum name enums')+  else case type' of+         SwaggerString -> maybe (return (name, FString))+                                convByFormat+                                format'+         SwaggerInteger -> return (name, FInteger)+         SwaggerNumber -> return (name, FNumber)+         SwaggerBoolean -> return (name, FBool)+         SwaggerArray -> maybe (error "fail to convert SwaggerArray")+                               convByItemType+                               items'+         SwaggerNull -> error "convert don't support SwaggerNull yet"+         SwaggerObject -> convObject (name, s)+    where+      param' = _schemaParamSchema s+      items' = _paramSchemaItems param'+      type' = _paramSchemaType param'+      enums' = maybe [] id $ _paramSchemaEnum param'+      format' = _paramSchemaFormat param'+      convByFormat :: Monad m => Text -> SwagT m (Text, FieldType)+      convByFormat "date" = return (name, FDay)+      convByFormat "yyyy-mm-ddThh:MM:ssZ" = return (name, FUTCTime)+      convByItemType :: Monad m+                        => SwaggerItems Schema -> SwagT m (Text, FieldType)+      convByItemType (SwaggerItemsObject (Ref (Reference s))) = do+                      (n, t) <- convRef name s+                      return (n, FList t)+      convByItemType (SwaggerItemsPrimitive _ _)+          = error "don't support SwaggerItemsPrimitive yet"+      convByItemType (SwaggerItemsArray _)+          = error "don't support SwaggerItemsArray yet"++enums :: Monad m => SwagT m [(Text, FieldType)]+enums = filterM (return.isFEnum.snd) =<< mapM convert =<< defs++prims :: Monad m => SwagT m [(Text, FieldType)]+prims = filterM (return.isFPrim.snd) =<< mapM convert =<< defs++models :: Monad m => SwagT m [(Text, FieldType)]+models = filterM (return.isFObj.snd) =<< mapM convert =<< defs+enumCs :: Monad m => SwagT m String+enumCs = do+  es <- mapM (return.snd) =<< enums   return [heredoc|/* generated by servant-csharp */-namespace ${namespace conf}+namespace ServantClientBook {-    $forall (name, cs) <- es-      #region ${name}-      public enum ${name}+    $forall FEnum name cs <- es+      #region ${T.unpack name}+      public enum ${T.unpack name}       {-          $forall c <- cs-            ${c},+          $forall String c <- cs+            ${T.unpack c},       }       #endregion } |] -defConvTemplate conf = do+showCSharpOriginalType :: FieldType -> String+showCSharpOriginalType FInteger = "System.Int64"+showCSharpOriginalType FNumber = "System.Double"+showCSharpOriginalType FString = "System.String"+showCSharpOriginalType FDay = "System.DateTime"+showCSharpOriginalType FUTCTime = "System.DateTime"+showCSharpOriginalType _ = error "don't support this type."++show' :: FieldType -> String+show' FInteger = "int"+show' FNumber = "double"+show' FString = "string"+show' FBool = "bool"+show' FDay = "DateTime"+show' FUTCTime = "DateTime"+show' (FEnum name _) = T.unpack name+show' (FObject name _) = T.unpack name+show' (FList t) = "List<" <> show' t <> ">"+show' (FNullable t) = case nullable t of+                        CVal -> show' t <> "?"+                        CRef -> show' t+                        CSt  -> "Nullable<" <> show' t <> ">"+show' (FRefObject name) = T.unpack name+show' (FRefEnum name) = T.unpack name+show' (FRefPrim name _) = T.unpack name++converterType :: FieldType -> ConverterType+converterType FDay = DayConv+converterType (FRefPrim _ FDay) = DayConv+converterType (FEnum _ _) = EnumConv+converterType (FRefEnum _) = EnumConv+converterType (FNullable t) = converterType t+converterType (FList t) = case converterType t of+                            DayConv -> ItemConv DayConv+                            EnumConv -> ItemConv EnumConv+                            t' -> t'+converterType _ = NoConv+++classCs :: Monad m => GenerateCsConfig -> SwagT m String+classCs conf = do+  ps <- prims+  ms <- models   return [heredoc|/* generated by servant-csharp */ using Newtonsoft.Json;+using Newtonsoft.Json.Converters; using System;+using System.Collections.Generic; +#region type alias+$forall (n, t) <- ps+  using ${T.unpack n} = ${showCSharpOriginalType t};+#endregion+ namespace ${namespace conf} {+    $forall (_, FObject name' fields) <- ms+      $let name = T.unpack name'+        #region ${name}+        [JsonObject("${name}")]+        public class ${name}+        {+            $forall (fname', ftype) <- fields+              $let fname = T.unpack fname'+                $case converterType ftype+                  $of DayConv+                    [JsonProperty(PropertyName = "${fname}")]+                    [JsonConverter(typeof(DayConverter))]+                  $of ItemConv DayConv+                    [JsonProperty(PropertyName = "${fname}", ItemConverterType = typeof(DayConverter))]+                  $of EnumConv+                    [JsonProperty(PropertyName = "${fname}")]+                    [JsonConverter(typeof(StringEnumConverter))]+                  $of ItemConv EnumConv+                    [JsonProperty(PropertyName = "${fname}", ItemConverterType = typeof(StringEnumConverter))]+                  $of _+                    [JsonProperty(PropertyName = "${fname}")]+                public ${show' ftype} ${fname} { get; set; }+        }+        #endregion+}+|]++converterCs :: Monad m => GenerateCsConfig -> SwagT m String+converterCs conf = return [heredoc|/* generated by servant-csharp */+using Newtonsoft.Json;+using System;++namespace ${namespace conf}+{     public class DayConverter : JsonConverter     {         public override bool CanConvert(Type objectType)@@ -543,18 +482,10 @@ } |] -----------------------------------------------------------------------------assemblyInfoCsForAPI :: IO String-assemblyInfoCsForAPI = assemblyInfoCsForAPIWith def--assemblyInfoCsForAPIWith :: GenerateCsConfig -> IO String-assemblyInfoCsForAPIWith conf = (assemblyinfotemplate conf) conf--defAssemblyInfoTemplate :: GenerateCsConfig -> IO String-defAssemblyInfoTemplate conf = do+assemblyInfoCs :: GenerateCsConfig -> IO String+assemblyInfoCs conf = do   (year, _, _) <- fmap (toGregorian . utctDay) getCurrentTime-  guid <- maybe (toString <$> UUID.nextRandom) return $ guid conf+  guid' <- maybe UUID.nextRandom return $ guid conf   return [heredoc| using System.Reflection; using System.Runtime.CompilerServices;@@ -571,31 +502,25 @@  [assembly: ComVisible(false)] -[assembly: Guid("${guid}")]+[assembly: Guid("${toString guid'}")]  // [assembly: AssemblyVersion("1.0.*")] [assembly: AssemblyVersion("1.0.0.0")] [assembly: AssemblyFileVersion("1.0.0.0")] |] -----------------------------------------------------------------------------csprojForAPI :: IO String-csprojForAPI = csprojForAPIWith def--csprojForAPIWith :: GenerateCsConfig -> IO String-csprojForAPIWith conf = (csprojtemplate conf) conf--defCsprojTemplate :: GenerateCsConfig -> IO String-defCsprojTemplate conf = do-  guid <- maybe ((map toUpper . toString) <$> UUID.nextRandom) return $ guid conf+projectCsproj :: GenerateCsConfig -> IO String+projectCsproj conf = do+  guid' <- maybe ((map toUpper . toString) <$> UUID.nextRandom)+                 (return . toString)+                 $ guid conf   return [heredoc|<?xml version="1.0" encoding="utf-8"?> <Project ToolsVersion="14.0" DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">   <Import Project="$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props" Condition="Exists('$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props')" />   <PropertyGroup>     <Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>     <Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>-    <ProjectGuid>{${guid}}</ProjectGuid>+    <ProjectGuid>{${guid'}}</ProjectGuid>     <OutputType>Library</OutputType>     <AppDesignerFolder>Properties</AppDesignerFolder>     <RootNamespace>${namespace conf}</RootNamespace>

@@ -0,0 +1,46 @@+{-# LANGUAGE FlexibleInstances #-}+module CS.JsonDotNet.Base where++import Control.Monad.Trans+import Control.Monad.Identity+import Data.Proxy+import Data.Swagger hiding (namespace)+import Servant.Swagger++type Swag = SwagT Identity++runSwagger :: Swag a -> Swagger -> a+runSwagger f = runIdentity . runSwagT f++mkSwag :: Monad m => (Swagger -> a) -> SwagT m a+mkSwag f = SwagT (return . f)++generateFrom :: HasSwagger api => Swag a -> Proxy api -> a+f `generateFrom` api = runSwagger f (toSwagger api)++newtype SwagT m a = SwagT { runSwagT :: Swagger -> m a }+instance Monad m => Functor (SwagT m) where+    fmap f x = SwagT $ \sw -> return . f =<< runSwagT x sw+instance Monad m => Applicative (SwagT m) where+    pure x = SwagT $ \sw -> return x+    f <*> g = SwagT $ \sw -> do+                f' <- runSwagT f sw+                g' <- runSwagT g sw+                return (f' g')+instance Monad m => Monad (SwagT m) where+    f >>= k = SwagT $ \sw ->+              runSwagT f sw >>= \f' ->+              runSwagT (k f') sw++instance Monad m => Monoid (SwagT m [a]) where+    mempty = SwagT $ \sw -> return mempty+    x `mappend` y = SwagT $ \sw -> do+                      x' <- runSwagT x sw+                      y' <- runSwagT y sw+                      return $ x' `mappend` y'++instance MonadTrans SwagT where+    lift m = SwagT $ \sw -> m++instance MonadIO m => MonadIO (SwagT m) where+    liftIO x = SwagT $ \sw -> liftIO x

@@ -0,0 +1,4 @@+module CS.JsonDotNet.Internal ( module CS.JsonDotNet.Internal.Types+                              ) where++import CS.JsonDotNet.Internal.Types

@@ -0,0 +1,60 @@+module CS.JsonDotNet.Internal.Types where++import Data.Aeson+import Data.Text++data FieldType = FInteger+               | FNumber+               | FString+               | FBool+               | FDay+               | FUTCTime+               | FEnum Text [Value]+               | FObject Text [(Text, FieldType)]+               | FList FieldType+               | FNullable FieldType++               | FRefObject Text+               | FRefEnum Text+               | FRefPrim Text FieldType+                 deriving Show++isFEnum :: FieldType -> Bool+isFEnum (FEnum _ _) = True+isFEnum _ = False++isFPrim :: FieldType -> Bool+isFPrim FString = True+isFPrim FInteger = True+isFPrim FNumber = True+isFPrim FBool = True+isFPrim FDay = True+isFPrim FUTCTime = True+isFPrim _ = False++isFObj :: FieldType -> Bool+isFObj (FObject _ _) = True+isFObj _ = False++data CCate = CVal | CRef | CSt deriving Show++nullable :: FieldType -> CCate+nullable FInteger = CVal+nullable FNumber = CVal+nullable FString = CRef+nullable FBool = CVal+nullable FDay = CVal+nullable FUTCTime = CVal+nullable (FEnum _ _) = CSt+nullable (FObject _ _) = CSt+nullable (FList _) = CRef+nullable (FNullable _) = CRef+nullable (FRefObject _) = CVal+nullable (FRefEnum _) = CVal+nullable (FRefPrim _ t) = nullable t++data ConverterType = NoConv+                   | DayConv+                   | EnumConv+                   | ItemConv ConverterType+                     deriving Show