{-# LANGUAGE OverloadedStrings #-} module Main where import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Base64.Lazy as Base64 import Data.Maybe (fromMaybe) import qualified Language.Wasm.Lexer as Lexer import qualified Language.Wasm.Parser as Parser import qualified Language.Wasm.Binary as Binary import Options.Applicative import Data.Semigroup ((<>)) {- wasm compile INPUT -o output -f js -f binary wasm exec --script INPUT wasm validate INPUT -f binary -f text wasm link -} data CompileOutFormat = OutJS | OutBinary | OutHTML deriving (Eq) data ExecMod = Plain | Script deriving (Show, Eq) data Input = InpText | InpBinary deriving (Eq) instance Read CompileOutFormat where readsPrec _ "js" = [(OutJS, "")] readsPrec _ "binary" = [(OutBinary, "")] readsPrec _ "html" = [(OutHTML, "")] readsPrec _ _ = error "Unknown compilation output foramt" instance Show CompileOutFormat where show OutJS = "js" show OutBinary = "binary" show OutHTML = "html" instance Read Input where readsPrec _ "text" = [(InpText, "")] readsPrec _ "binary" = [(InpBinary, "")] readsPrec _ _ = error "Unknown validation input foramt" instance Show Input where show InpText = "text" show InpBinary = "binary" data WasmCommand = Compile { input :: String, output :: String, outFormat :: CompileOutFormat } | Exec { input :: String, mode :: ExecMod, inpFormat :: Input } | Validate { input :: String, inpFormat :: Input } deriving (Show, Eq) compileArgs = Compile <$> argument str (metavar "FILE") <*> strOption ( long "out" <> short 'o' <> metavar "FILE" <> help "Distination for compilation" ) <*> option auto ( long "format" <> short 'f' <> help "Output file format" <> showDefault <> value OutBinary ) execArgs = Exec <$> argument str (metavar "FILE") <*> flag Plain Script (long "script" <> help "Execute file in script mode") <*> option auto ( long "format" <> short 'f' <> help "Input file format" <> showDefault <> value InpText ) validateArgs = Validate <$> argument str (metavar "FILE") <*> option auto ( long "format" <> short 'f' <> help "Input file format" <> showDefault <> value InpText ) config :: Parser WasmCommand config = subparser ( command "compile" (info compileArgs (progDesc "Compile WebAssembly file from text representation")) <> command "exec" (info execArgs (progDesc "Compile WebAssembly file if needed and execute")) <> command "validate" (info validateArgs (progDesc "Validate WebAssembly file")) ) toBinary :: LBS.ByteString -> Either String LBS.ByteString toBinary content = do lexemes <- Lexer.scanner content mod <- Parser.parseModule lexemes return $ Binary.dumpModuleLazy mod compileAs :: (LBS.ByteString -> LBS.ByteString) -> String -> String -> IO () compileAs transform input output = do content <- LBS.readFile input case toBinary content of Right binary -> LBS.writeFile output $ transform binary Left reason -> putStrLn $ "Cannot complie module: " ++ reason binary :: LBS.ByteString -> LBS.ByteString binary = id js :: LBS.ByteString -> LBS.ByteString js binary = let asBase64 = Base64.encode binary in LBS.concat [ "const bytes = Uint8Array.from(atob('" <> asBase64 <> "'), c => c.charCodeAt(0));\n", "WebAssembly.instantiate(bytes, {}).then(res => console.log(res.instance))\n" ] html :: LBS.ByteString -> LBS.ByteString html binary = LBS.concat [ "\n" ] exec :: WasmCommand -> IO () exec (Compile inp out OutBinary) = compileAs binary inp out exec (Compile inp out OutJS) = compileAs js inp out exec (Compile inp out OutHTML) = compileAs html inp out exec command = putStrLn $ "command is not implemented yet: " ++ show command main :: IO () main = execParser opts >>= exec where opts = info (config <**> helper) (fullDesc <> progDesc "WebAssembly Toolkit" <> header "This tool can compile text representation to binary format, validate module in text or binary representation and so on.")