module H.Dump where
import H.Common
import Hydrogen.Parsing hiding (parse, token)
import Hydrogen.Syntax.Parser
import Hydrogen.Syntax.Types
import Hydrogen.Data
import qualified Hydrogen.MultiMap as MultiMap
main :: Tool
main _ args = do
let (options, switches, files) = getOpts args [
'1' ~: switch "tokens"
, '2' ~: switch "layout"
, '3' ~: switch "values"
, '4' ~: switch "program"
, 's' ~: optarg "spaces"
, 'c' ~: optarg "comments"
, 'O' ~: optarg "opening-braces"
, 'C' ~: optarg "closing-braces"
, 'i' ~: optarg "indent-token"
, 'S' ~: optarg "special"
, 'X' ~: optarg "special-syntax"
, 'F' ~: optarg "fold-specials"
]
tokenizerConfig = foldl setConfig default_ (MultiMap.toList' options)
where
setConfig b = \case
("spaces", x) -> b { cfgSpaces = x }
("special", x) -> b { cfgSpecialCharacters = x }
("comments", x) -> b { cfgComments = x }
("fold-specials", x) -> b { cfgFoldSpecials = x }
("opening-braces", x) -> b { cfgOpeningBraces = x }
("closing-braces", x) -> b { cfgClosingBraces = x }
("special-syntax", x) -> b { cfgSpecialSemantics = x }
_ -> b
layoutConfig = foldl setConfig default_ (MultiMap.toList' options)
where
setConfig b = \case
("indent-token", x) -> b { cfgIndentToken = x }
_ -> b
layoutConfig' = layoutConfig {
cfgValueTokens = readValue
, cfgBlockTransformer = \case
Block Grouping "" [] -> Value (mkValue ()) ""
x -> x
}
report = concatMap showMessage . nub
where
showMessage (pos, message) = printf "%4d%4d %s\n"
(sourceLine pos) (sourceColumn pos) message
func
| switches ? "tokens"
= either report showTokens . parseTokens tokenizerConfig "-"
| switches ? "layout"
= either report showLayout . parse' tokenizerConfig layoutConfig "-"
| switches ? "values"
= either report showLayout . parse' tokenizerConfig layoutConfig' "-"
| switches ? "program"
= either report showLayout . parse' tokenizerConfig layoutConfig' "-"
| otherwise
= const "Need -1, -2, -3, or -4"
showTokens = concatMap showToken
showToken (pos, token) = printf "%4d%4d %s\n"
(sourceLine pos) (sourceColumn pos) (show token)
showLayout = concat . showPOPs "" []
showPOPs indent backlog = \case
(pos, pop) : ps -> case pop of
Token t k x -> printf "%4d%4d %s%s %s %s\n"
(sourceLine pos) (sourceColumn pos) indent (show t) k x
: showPOPs indent backlog ps
Block t x pops -> printf "%4d%4d %s%s %s\n"
(sourceLine pos) (sourceColumn pos) indent (show t) x
: showPOPs (" " ++ indent) (ps : backlog) pops
Value v s -> printf "%4d%4d %s%s (%s)\n"
(sourceLine pos) (sourceColumn pos) indent (show v) s
: showPOPs indent backlog ps
[] | null backlog -> []
| otherwise -> showPOPs (drop 2 indent) (tail backlog) (head backlog)
onFiles (putStr . func) files