git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Update tests
5264394Andy Arvanitis
app/Main.hs+33−12
@@ -9,7 +9,7 @@ import Data.Aeson
9import Data.Aeson.Types
9import Data.Aeson.Types
10import Data.Char
10import Data.Char
11import Data.FileEmbed (embedFile)
11import Data.FileEmbed (embedFile)
12−import Data.List (delete)
12+import Data.List (delete, isPrefixOf, partition)
13import Data.Maybe
13import Data.Maybe
14import Data.Monoid ((<>))
14import Data.Monoid ((<>))
15import Data.Version
15import Data.Version
@@ -55,14 +55,16 @@ main = do
55 if null args
55 if null args
56 then return ()
56 then return ()
57 else do
57 else do
58+ let (opts, files) = partition (isPrefixOf "--") args
59+ opts' = (map . map) toLower opts
58− if head args == "tests"
60+ if "--tests" `elem` opts'
59 then runTests
61 then runTests
60 else do
62 else do
61− mapM (generateCode False) args
63+ mapM (generateCode opts') files
62 return ()
64 return ()
63
65
64−generateCode :: Bool -> FilePath -> IO ()
66+generateCode :: [String] -> FilePath -> IO ()
65−generateCode someOpt jsonFile = do
67+generateCode opts jsonFile = do
66 jsonModTime <- getModificationTime jsonFile
68 jsonModTime <- getModificationTime jsonFile
67 let filepath = takeDirectory jsonFile
69 let filepath = takeDirectory jsonFile
68 dirparts = splitDirectories $ filepath
70 dirparts = splitDirectories $ filepath
@@ -74,11 +76,11 @@ generateCode someOpt jsonFile = do
74 then do
76 then do
75 modTime <- getModificationTime possInterfaceFilename
77 modTime <- getModificationTime possInterfaceFilename
76 when (modTime < jsonModTime) $
78 when (modTime < jsonModTime) $
77− transpile someOpt jsonFile
79+ transpile opts jsonFile
78− else transpile someOpt jsonFile
80+ else transpile opts jsonFile
79
81
80−transpile :: Bool -> FilePath -> IO ()
82+transpile :: [String] -> FilePath -> IO ()
81−transpile _ jsonFile = do
83+transpile opts jsonFile = do
82 jsonText <- T.readFile jsonFile
84 jsonText <- T.readFile jsonFile
83 let module' = jsonToModule $ parseJson jsonText
85 let module' = jsonToModule $ parseJson jsonText
84 ((interface, foreigns, asts, implHeader, implFooter), _) <- runSupplyT 5 (moduleToCpp module' Nothing)
86 ((interface, foreigns, asts, implHeader, implFooter), _) <- runSupplyT 5 (moduleToCpp module' Nothing)
@@ -91,13 +93,18 @@ transpile _ jsonFile = do
91 implPath = outpath </> implFileName mn
93 implPath = outpath </> implFileName mn
92 putStrLn interfacePath
94 putStrLn interfacePath
93 createDirectoryIfMissing True outpath
95 createDirectoryIfMissing True outpath
94− T.writeFile interfacePath interface
96+ T.writeFile interfacePath $ conv interface
95 putStrLn implPath
97 putStrLn implPath
96− T.writeFile implPath (implHeader <> implementation <> implFooter)
98+ T.writeFile implPath $ conv (implHeader <> implementation <> implFooter)
97 let runtime = baseOutpath </> "purescript.h"
99 let runtime = baseOutpath </> "purescript.h"
98 runtimeExists <- doesFileExist runtime
100 runtimeExists <- doesFileExist runtime
99 when (not runtimeExists) $ do
101 when (not runtimeExists) $ do
100− T.writeFile runtime $ T.decodeUtf8 $(embedFile "runtime/purescript.h")
102+ T.writeFile runtime . conv $ T.decodeUtf8 $(embedFile "runtime/purescript.h")
103+ where
104+ conv :: Text -> Text
105+ conv
106+ | "--ucns" `elem` opts = toUCNs . toDollars
107+ | otherwise = id
101
108
102outdir :: FilePath
109outdir :: FilePath
103outdir = "src"
110outdir = "src"
@@ -114,3 +121,17 @@ escape = T.concatMap go
114 go :: Char -> Text
121 go :: Char -> Text
115 go c = T.pack $ printf "0x%04x," (ord c)
122 go c = T.pack $ printf "0x%04x," (ord c)
116
123
124+
125+toUCNs :: Text -> Text
126+toUCNs = T.pack . concatMap toUCN . T.unpack
127+
128+toUCN :: Char -> String
129+toUCN c | isAscii c = [c]
130+toUCN c = printf "\\U%08x" $ ord c
131+
132+toDollars :: Text -> Text
133+toDollars = T.map toDollar
134+
135+toDollar :: Char -> Char
136+toDollar '_' = '$'
137+toDollar c = c