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
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 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 [heredoc|${outdir conf'}/${namespace conf'}/Properties|]
classCsForAPIWith conf' >>= writeFile [heredoc|${outdir conf'}/${namespace conf'}${classCsName conf'}|]
apiCsForAPIWith conf' api >>= writeFile [heredoc|${outdir conf'}/${namespace conf'}${apiCsName conf'}|]
enumCsForAPIWith conf' >>= writeFile [heredoc|${outdir conf'}/${namespace conf'}${enumCsName conf'}|]
converterCsForAPIWith conf' >>= writeFile [heredoc|${outdir conf'}/${namespace conf'}${converterCsName conf'}|]
assemblyInfoCsForAPIWith conf' >>= writeFile [heredoc|${outdir conf'}/${namespace conf'}/Properties/AssemblyInfo.cs|]
csprojForAPIWith conf' >>= writeFile [heredoc|${outdir conf'}/${namespace conf'}/${namespace conf'}.cs|]
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>|]