1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
{-# LANGUAGE OverloadedStrings, FlexibleInstances, LambdaCase #-}
import qualified Data.Text.Lazy as LText
import Text.EDE
import Text.EDE.Filters
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.Text (Text)
import qualified Data.Map as Map
import qualified Data.Set as Set
import System.Directory
import System.FilePath
import Data.Time.Clock
import Control.Monad.Writer
import Definitions
import Language
instance Unquote [Field]
instance Unquote [Char]
instance Quote [Char]
instance Unquote DataDef
instance Unquote Type
main :: IO ()
main = do
dataSwift <- eitherParseFile "templates/data.swift.ede"
dataJava <- eitherParseFile "templates/data.java.ede"
jsonJava <- eitherParseFile "templates/json.java.ede"
dataHpp <- eitherParseFile "templates/data.hpp.ede"
dataHpp2 <- eitherParseFile "templates/data.hpp2.ede"
dataCpp <- eitherParseFile "templates/data.cpp.ede"
dataCs <- eitherParseFile "templates/data.cs.ede"
dataHs <- eitherParseFile "templates/data.hs.ede"
dataPs <- eitherParseFile "templates/data.purs.ede"
let generate mod@(ModuleDef name imports def) = do
dt <- getCurrentTime
let env = fromPairs
[ "dataAndType" .= def
, "definitions" .= [a | a@DataDef{} <- def ]
, "moduleName" .= name
, "dateTime" .= dt
, "imports" .= imports
, "usedTypes" .= collectTypes aliasMap mod
, "usedCSTypes" .= (Set.fromList $ Map.elems $ Map.fromList [ (csType name aliasMap t,t) | t <- Set.toList $ collectTypes aliasMap mod])
]
aliasMap = Map.fromList [(n,t) | TypeAlias n t <- def]
mylib :: HashMap Text Term
mylib = HashMap.fromList
[ "hasFieldNames" @: hasFieldNames
, "parens" @: parens
, "constType" @: constType
, "hsType" @: hsType aliasMap
, "psType" @: psType aliasMap
, "cppType" @: cppType aliasMap
, "csType" @: csType name aliasMap
, "typeEnum" @: typeEnum aliasMap
, "javaType" @: javaType aliasMap
, "swiftType" @: swiftType aliasMap
, "hasEnumConstructor" @: hasEnumConstructor
]
writeFileIfDiffer fname txt = doesFileExist fname >>= \case
False -> writeFile fname txt
True -> do
oldTxt <- readFile fname
case (lines oldTxt, lines txt) of
(_ : oldTime : old, _ : newTime : new) | old == new -> return () -- NOTE: timestamp is always in the second line
_ -> writeFile fname txt
-- Haskell
either error (\x -> writeFileIfDiffer ("out/" ++ name ++ ".hs") $ LText.unpack x) $ dataHs >>= (\t -> eitherRenderWith mylib t env)
-- Purescript
either error (\x -> writeFileIfDiffer ("out/" ++ name ++ ".purs") $ LText.unpack x) $ dataPs >>= (\t -> eitherRenderWith mylib t env)
-- C++
either error (\x -> writeFileIfDiffer ("out/" ++ name ++ "2.hpp") $ LText.unpack x) $ dataHpp2 >>= (\t -> eitherRenderWith mylib t env)
either error (\x -> writeFileIfDiffer ("out/" ++ name ++ ".hpp") $ LText.unpack x) $ dataHpp >>= (\t -> eitherRenderWith mylib t env)
either error (\x -> writeFileIfDiffer ("out/" ++ name ++ ".cpp") $ LText.unpack x) $ dataCpp >>= (\t -> eitherRenderWith mylib t env)
-- Java
let toPath a = flip map a $ \case
'.' -> '/'
c -> c
forM_ [a | a@DataDef{} <- def {-TODO-}] $ \d -> do
let env = fromPairs
[ "def" .= d
, "moduleName" .= name
, "dateTime" .= dt
, "imports" .= imports
]
fname = "out/java/" ++ toPath name ++ "/" ++ dataName d ++ ".java"
dir = takeDirectory fname
createDirectoryIfMissing True dir
either error (\x -> writeFileIfDiffer fname $ LText.unpack x) $ dataJava >>= (\t -> eitherRenderWith mylib t env)
either error (\x -> writeFileIfDiffer ("out/java/" ++ toPath name ++ "/JSON.java") $ LText.unpack x) $ jsonJava >>= (\t -> eitherRenderWith mylib t env)
-- C#
either error (\x -> writeFileIfDiffer ("out/" ++ name ++ ".cs") $ LText.unpack x) $ dataCs >>= (\t -> eitherRenderWith mylib t env)
-- Swift
either error (\x -> writeFileIfDiffer ("out/" ++ name ++ ".swift") $ LText.unpack x) $ dataSwift >>= (\t -> eitherRenderWith mylib t env)
mapM_ generate $ execWriter modules
|