module CS.JsonDotNet ( genCsForAPI
, classCsForAPI
, classCsForAPIWith
, apiCsForAPI
, apiCsForAPIWith
, enumCsForAPI
, enumCsForAPIWith
, converterCsForAPI
, converterCsForAPIWith
, assemblyInfoCsForAPI
, assemblyInfoCsForAPIWith
, csprojForAPI
, csprojForAPIWith
, GenerateCsConfig(..)
, def
) where
import Prelude hiding (concat, lines, unlines)
import Control.Arrow
import Control.Lens hiding ((<.>))
import Data.ByteString (ByteString)
import Data.ByteString.Char8 as BC (unpack)
import Data.Char (toUpper, toLower)
import Data.List (intercalate, concat)
import Data.Maybe (fromJust)
import Data.Monoid ((<>))
import Data.Proxy
import Data.Text as T (Text, unpack, pack)
import Data.Time.Clock (UTCTime(..), getCurrentTime)
import Data.Time.Calendar (toGregorian)
import Data.UUID.Types (toString)
import Data.UUID.V4 as UUID (nextRandom)
import Language.Haskell.Exts
import Servant.Foreign
import System.Directory (createDirectoryIfMissing)
import System.FilePath ((</>), (<.>))
import Text.Heredoc
import CS.Common (CSharp, getEndpoints)
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]
}
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)
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)
retType :: Req Text -> String
retType = T.unpack . fromJust . view reqReturnType
uri :: Req Text -> String
uri req = T.unpack $ segmentsToText $ req^..reqUrl.path.traverse
where
segmentsToText :: [Segment f] -> Text
segmentsToText = foldr segToText ""
segToText :: Segment f -> Text -> Text
segToText (Segment (Static s)) ss
= "/" <> s^._PathSegment <> ss
segToText (Segment (Cap s)) ss
= "/{" <> prefix <> s^.argName._PathSegment <> "}" <> ss
prefix = "_"
methodType :: Req Text -> String
methodType = capitalize . BC.unpack . view reqMethod
where
capitalize :: String -> String
capitalize (c:cs) = toUpper c:map toLower cs
methodName :: Req Text -> String
methodName = T.unpack . view (reqFuncName.camelCaseL)
paramDecl :: Req Text -> String
paramDecl = intercalate ", " . map help . paramInfos True
where
help :: (String, String) -> String
help (t, n) = t<>" "<>(prefix<>n)
prefix = "_"
paramArg :: Req Text -> String
paramArg = intercalate ", " . map help . paramInfos False
where
help :: (String, String) -> String
help (_, n) = prefix<>n
prefix = "_"
paramInfos :: Bool -> Req Text -> [(String, String)]
paramInfos b req = foldr (<>) mempty
$ map ($ req) [ captures
, rqBody
, queryparams'
]
where
queryparams' = map (help b) . queryparams
where
help True = convToNullable *** (<>" = null")
help False = convToNullable *** id
convToNullable "int" = "int?"
convToNullable "string" = "string"
convToNullable "DateTime" = "DateTime?"
convToNullable t = "Nullable<"<>t<>">"
queryparams :: Req Text -> [(String, String)]
queryparams req = map ((T.unpack . view argType
&&&
T.unpack . unPathSegment . view argName)
. view queryArgName)
$ req^..reqUrl.queryStr.traverse
captures :: Req Text -> [(String, String)]
captures req = map ((T.unpack . view argType &&& T.unpack . view argPath)
. captureArg)
. filter isCapture
$ req^.reqUrl.path
rqBody :: Req Text -> [(String, String)]
rqBody req = maybe [] (pure . (T.unpack &&& const jsonReqBodyName))
$ req^.reqBody
where
jsonReqBodyName = "obj"
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 servantcsharp */
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
return [heredoc|/* generated by servantcsharp */
using Newtonsoft.Json;
using System.Collections.Generic;
using System.Diagnostics;
using System.Linq;
using System.Net.Http;
using System.Net.Http.Headers;
using System.Text;
using System.Threading.Tasks;
#region type alias
$forall (n, t) <- uas
using ${n} = ${showCSharpOriginalType t};
#endregion
namespace ${namespace conf}
{
class ServantClient : HttpClient
{
public ServantClient()
{
this.DefaultRequestHeaders.Accept.Add(new MediaTypeWithQualityHeaderValue("application/json"));
}
}
public class API
{
#region fields
private string server;
#endregion
#region properties
#endregion
#region Constructor
public API(string _server)
{
this.server = _server;
}
#endregion
#region APIs
$forall ep <- getEndpoints api
$if retType ep /= "void"
public async Task<${retType ep}> ${methodName ep}Async(${paramDecl ep})
$else
public async Task ${methodName ep}Async(${paramDecl ep})
{
var client = new ServantClient();
var queryparams = new List<string> {
$forall (_, qp) <- queryparams ep
_${qp}.HasValue ? $"_${qp}={_${qp}.Value}" : null,
}.Where(e => !string.IsNullOrEmpty(e));
var qp= queryparams.Count() > 0 ? $"?{string.Join("&", queryparams)}" : "";
$if requestBodyExists ep
#if DEBUG
var jsonObj = JsonConvert.SerializeObject(_obj, Formatting.Indented);
#else
var jsonObj = JsonConvert.SerializeObject(_obj);
#endif
$if requestBodyExists ep
var res = await client.${methodType ep}Async($"{server}${uri ep}{qp}", new StringContent(jsonObj, Encoding.UTF8, "application/json"));
$else
var res = await client.${methodType ep}Async($"{server}${uri ep}{qp}");
Debug.WriteLine($">>> {res.RequestMessage}");
$if requestBodyExists ep
Debug.WriteLine($"-----");
Debug.WriteLine(jsonObj);
Debug.WriteLine($"-----");
Debug.WriteLine($"<<< {(int)res.StatusCode} {res.ReasonPhrase}");
var content = await res.Content.ReadAsStringAsync();
Debug.WriteLine($"<<< {content}");
$if retType ep /= "void"
return JsonConvert.DeserializeObject<${retType ep}>(content);
$else
JsonConvert.DeserializeObject(content);
}
public ${retType ep} ${methodName ep}(${paramDecl ep})
{
$if retType ep /= "void"
Task<${retType ep}> t = ${methodName ep}Async(${paramArg ep});
return t.GetAwaiter().GetResult();
$else
Task t = ${methodName ep}Async(${paramArg ep});
t.GetAwaiter().GetResult();
}
#endregion
}
}
|]
defEnumTemplate conf = do
es <- enumTypes conf
return [heredoc|/* generated by servantcsharp */
namespace ${namespace conf}
{
$forall (name, cs) <- es
#region ${name}
public enum ${name}
{
$forall c <- cs
${c},
}
#endregion
}
|]
defConvTemplate conf = do
return [heredoc|/* generated by servantcsharp */
using Newtonsoft.Json;
using System;
namespace ${namespace conf}
{
public class DayConverter : JsonConverter
{
public override bool CanConvert(Type objectType)
{
return objectType == typeof(DateTime);
}
public override object ReadJson(JsonReader reader, Type objectType, object existingValue, JsonSerializer serializer)
{
return DateTime.Parse((string)reader.Value);
}
public override void WriteJson(JsonWriter writer, object value, JsonSerializer serializer)
{
DateTime d = (DateTime)value;
writer.WriteValue(d.ToString("yyyy-MM-dd"));
}
}
}
|]
assemblyInfoCsForAPI :: IO String
assemblyInfoCsForAPI = assemblyInfoCsForAPIWith def
assemblyInfoCsForAPIWith :: GenerateCsConfig -> IO String
assemblyInfoCsForAPIWith conf = (assemblyinfotemplate conf) conf
defAssemblyInfoTemplate :: GenerateCsConfig -> IO String
defAssemblyInfoTemplate conf = do
(year, _, _) <- fmap (toGregorian . utctDay) getCurrentTime
guid <- maybe (toString <$> UUID.nextRandom) return $ guid conf
return [heredoc|
using System.Reflection;
using System.Runtime.CompilerServices;
using System.Runtime.InteropServices;
[assembly: AssemblyTitle("${namespace conf}")]
[assembly: AssemblyDescription("")]
[assembly: AssemblyConfiguration("")]
[assembly: AssemblyCompany("")]
[assembly: AssemblyProduct("${namespace conf}")]
[assembly: AssemblyCopyright("Copyright © ${show year}")]
[assembly: AssemblyTrademark("")]
[assembly: AssemblyCulture("")]
[assembly: ComVisible(false)]
[assembly: Guid("${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
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>
<OutputType>Library</OutputType>
<AppDesignerFolder>Properties</AppDesignerFolder>
<RootNamespace>${namespace conf}</RootNamespace>
<AssemblyName>${namespace conf}</AssemblyName>
<TargetFrameworkVersion>v4.5.2</TargetFrameworkVersion>
<FileAlignment>512</FileAlignment>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<DebugSymbols>true</DebugSymbols>
<DebugType>full</DebugType>
<Optimize>false</Optimize>
<OutputPath>bin\Debug\</OutputPath>
<DefineConstants>DEBUG;TRACE</DefineConstants>
<ErrorReport>prompt</ErrorReport>
<WarningLevel>4</WarningLevel>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<DebugType>pdbonly</DebugType>
<Optimize>true</Optimize>
<OutputPath>bin\Release\</OutputPath>
<DefineConstants>TRACE</DefineConstants>
<ErrorReport>prompt</ErrorReport>
<WarningLevel>4</WarningLevel>
</PropertyGroup>
<ItemGroup>
<Reference Include="Newtonsoft.Json, Version=4.5.0.0, Culture=neutral, PublicKeyToken=30ad4fe6b2a6aeed, processorArchitecture=MSIL" />
<Reference Include="System" />
<Reference Include="System.Core" />
<Reference Include="System.Xml.Linq" />
<Reference Include="System.Data.DataSetExtensions" />
<Reference Include="Microsoft.CSharp" />
<Reference Include="System.Data" />
<Reference Include="System.Net.Http" />
<Reference Include="System.Xml" />
</ItemGroup>
<ItemGroup>
<Compile Include="${apiCsName conf}" />
<Compile Include="${converterCsName conf}" />
<Compile Include="${classCsName conf}" />
<Compile Include="${enumCsName conf}" />
<Compile Include="Properties\AssemblyInfo.cs" />
</ItemGroup>
<Import Project="$(MSBuildToolsPath)\Microsoft.CSharp.targets" />
<!-- To modify your build process, add your task inside one of the targets below and uncomment it.
Other similar extension points exist, see Microsoft.Common.targets.
<Target Name="BeforeBuild">
</Target>
<Target Name="AfterBuild">
</Target>
-->
</Project>|]