Add more modes to test-program
Herbert Valerio Riedel
5 years ago
| 46 | 46 | hPutStrLn stderr "unexpected arguments passed to yaml2event sub-command" |
| 47 | 47 | exitFailure |
| 48 | 48 | |
| 49 | ("yaml2event0":args') | |
| 50 | | null args' -> cmdYaml2Event0 | |
| 51 | | otherwise -> do | |
| 52 | hPutStrLn stderr "unexpected arguments passed to yaml2event0 sub-command" | |
| 53 | exitFailure | |
| 54 | ||
| 49 | 55 | ("yaml2token":args') |
| 50 | 56 | | null args' -> cmdYaml2Token |
| 51 | 57 | | otherwise -> do |
| 52 | 58 | hPutStrLn stderr "unexpected arguments passed to yaml2token sub-command" |
| 53 | 59 | exitFailure |
| 54 | 60 | |
| 61 | ("yaml2token0":args') | |
| 62 | | null args' -> cmdYaml2Token0 | |
| 63 | | otherwise -> do | |
| 64 | hPutStrLn stderr "unexpected arguments passed to yaml2token0 sub-command" | |
| 65 | exitFailure | |
| 66 | ||
| 55 | 67 | ("yaml2json":args') |
| 56 | 68 | | null args' -> cmdYaml2Json |
| 57 | 69 | | otherwise -> do |
| 58 | 70 | hPutStrLn stderr "unexpected arguments passed to yaml2json sub-command" |
| 71 | exitFailure | |
| 72 | ||
| 73 | ("yaml2yaml":args') | |
| 74 | | null args' -> cmdYaml2Yaml | |
| 75 | | otherwise -> do | |
| 76 | hPutStrLn stderr "unexpected arguments passed to yaml2yaml sub-command" | |
| 77 | exitFailure | |
| 78 | ||
| 79 | ("yaml2yaml-":args') | |
| 80 | | null args' -> cmdYaml2Yaml' | |
| 81 | | otherwise -> do | |
| 82 | hPutStrLn stderr "unexpected arguments passed to yaml2yaml- sub-command" | |
| 59 | 83 | exitFailure |
| 60 | 84 | |
| 61 | 85 | ("run-tml":args') -> cmdRunTml args' |
| 67 | 91 | hPutStrLn stderr "" |
| 68 | 92 | hPutStrLn stderr "Commands:" |
| 69 | 93 | hPutStrLn stderr "" |
| 94 | hPutStrLn stderr " yaml2token reads YAML stream from STDIN and dumps tokens to STDOUT" | |
| 95 | hPutStrLn stderr " yaml2token0 reads YAML stream from STDIN and prints count of tokens to STDOUT" | |
| 70 | 96 | hPutStrLn stderr " yaml2event reads YAML stream from STDIN and dumps events to STDOUT" |
| 97 | hPutStrLn stderr " yaml2event0 reads YAML stream from STDIN and prints count of events to STDOUT" | |
| 71 | 98 | hPutStrLn stderr " yaml2json reads YAML stream from STDIN and dumps JSON to STDOUT" |
| 99 | hPutStrLn stderr " yaml2yaml reads YAML stream from STDIN and dumps YAML to STDOUT (non-streaming version)" | |
| 100 | hPutStrLn stderr " yaml2yaml- reads YAML stream from STDIN and dumps YAML to STDOUT (streaming version)" | |
| 72 | 101 | hPutStrLn stderr " run-tml run/validate YAML-specific .tml file(s)" |
| 73 | 102 | hPutStrLn stderr " testml-compiler emulate testml-compiler" |
| 74 | 103 | |
| 87 | 116 | hPutStrLn stdout $ printf "<stdin>:%d:%d: %-15s| %s" tLine tLineChar (show tCode) tText' |
| 88 | 117 | hPutStrLn stdout "" |
| 89 | 118 | hFlush stdout |
| 119 | ||
| 120 | cmdYaml2Token0 :: IO () | |
| 121 | cmdYaml2Token0 = do | |
| 122 | inYamlDat <- BS.L.getContents | |
| 123 | print (length (YT.tokenize inYamlDat False)) | |
| 124 | ||
| 125 | cmdYaml2Yaml :: IO () | |
| 126 | cmdYaml2Yaml = do | |
| 127 | inYamlDat <- BS.L.getContents | |
| 128 | case (sequence $ parseEvents inYamlDat) of | |
| 129 | Left (ofs,msg) -> do | |
| 130 | case msg of | |
| 131 | "" -> hPutStrLn stderr ("parsing error near byte offset " ++ show ofs) | |
| 132 | _ -> hPutStrLn stderr ("parsing error near byte offset " ++ show ofs ++ " (" ++ msg ++ ")") | |
| 133 | exitFailure | |
| 134 | Right events -> do | |
| 135 | BS.L.hPutStr stdout (writeEvents YT.UTF8 events) | |
| 136 | hFlush stdout | |
| 137 | ||
| 138 | -- lazy streaming version | |
| 139 | cmdYaml2Yaml' :: IO () | |
| 140 | cmdYaml2Yaml' = do | |
| 141 | inYamlDat <- BS.L.getContents | |
| 142 | BS.L.hPutStr stdout $ writeEvents YT.UTF8 $ parseEvents' inYamlDat | |
| 143 | hFlush stdout | |
| 144 | where | |
| 145 | parseEvents' = map (either (\(ofs,msg) -> error ("parsing error near byte offset " ++ show ofs ++ " (" ++ msg ++ ")")) id) . parseEvents | |
| 90 | 146 | |
| 91 | 147 | cmdYaml2Event :: IO () |
| 92 | 148 | cmdYaml2Event = do |
| 100 | 156 | Right event -> do |
| 101 | 157 | hPutStrLn stdout (ev2str event) |
| 102 | 158 | hFlush stdout |
| 159 | ||
| 160 | ||
| 161 | cmdYaml2Event0 :: IO () | |
| 162 | cmdYaml2Event0 = do | |
| 163 | inYamlDat <- BS.L.getContents | |
| 164 | print (length (parseEvents' inYamlDat)) | |
| 165 | where | |
| 166 | parseEvents' = map (either (\(ofs,msg) -> error ("parsing error near byte offset " ++ show ofs ++ " (" ++ msg ++ ")")) id) . parseEvents | |
| 103 | 167 | |
| 104 | 168 | -- | 'J.Value' look-alike |
| 105 | 169 | data Value' = Object' (Map Text Value') |