diff --git a/help/dump.txt b/help/dump.txt --- a/help/dump.txt +++ b/help/dump.txt @@ -2,13 +2,50 @@ dump the output of different parsing stages. -One of the following switches must be specified: +One of the following switches must be specified as : - -T --tokens Print a list of parsed tokens - -L --layout Print the layout tree - -D --data Read a hydrogen data document + -1 --tokens Print a list of parsed tokens + -2 --layout Print the layout tree + -3 --values --layout + identifies built-in datatypes +Options: + + -s --spaces Which characters to identify as space. + Defaults to " " (the space character only) + + -c --comments The character sequence that starts single-line comments. + Defaults to ";;" + + -O --opening-braces + The characters which make up opening braces. + Defaults to "([{" + + -C --closing-braces + The characters which make up closing braces. + Defaults to ")]}" + + -S --special Characters that are regarded special (i.e. tokens + in their own right). + Defaults to ",;" + + -X --special-syntax + For which characters special layout rules should + be enabled. This will just enable/disable some + special parsing rules for "{" and the --special + characters. + Defaults to "{;" + + -i --indent-token + What indents should be translated to. + Defaults to ";;" + + -F --fold-specials + Which of the --special characters should be folded + (i.e. eliminate consecutive tokens) + Defaults to ";" + Examples: h dump -T file.hy cat file.hy | h dump -L + diff --git a/help/help.txt b/help/help.txt --- a/help/help.txt +++ b/help/help.txt @@ -2,6 +2,7 @@ Available commands are: - dump, help + dump, help, init, run -Use `hy help ` for further information. +`h help ` shows further information for a given command. + diff --git a/help/init.txt b/help/init.txt new file mode 100644 --- /dev/null +++ b/help/init.txt diff --git a/help/run.txt b/help/run.txt new file mode 100644 --- /dev/null +++ b/help/run.txt diff --git a/hydrogen-cli.cabal b/hydrogen-cli.cabal --- a/hydrogen-cli.cabal +++ b/hydrogen-cli.cabal @@ -1,5 +1,5 @@ name: hydrogen-cli -version: 0.11 +version: 0.12 homepage: https://scravy.de/hydrogen-cli/ synopsis: Hydrogen Data license: MIT @@ -19,13 +19,17 @@ executable h main-is: h.hs other-modules: Paths_hydrogen_cli + , H.Common , H.Dump , H.Init + , H.Run build-depends: base ==4.7.* - , hydrogen-cli-args ==0.11 - , hydrogen-parsing ==0.11 - , hydrogen-prelude ==0.11 - , hydrogen-syntax ==0.11 + , hydrogen-cli-args ==0.12 + , hydrogen-data ==0.12 + , hydrogen-multimap ==0.1 + , hydrogen-parsing ==0.12 + , hydrogen-prelude ==0.12 + , hydrogen-syntax ==0.12 hs-source-dirs: src ghc-options: -Wall default-language: Haskell2010 diff --git a/src/H/Common.hs b/src/H/Common.hs new file mode 100644 --- /dev/null +++ b/src/H/Common.hs @@ -0,0 +1,29 @@ +module H.Common ( + module Hydrogen.Prelude + , module Hydrogen.CliArgs + , Tool + , LogLevel (..) + , getOpts + , onFiles + , (>+>) + , (<+<) + ) where + +import Hydrogen.Prelude hiding (log) +import Hydrogen.CliArgs hiding (getOpts) +import Hydrogen.Parsing + +type Tool = (LogLevel -> String -> IO ()) -> [String] -> IO () + +data LogLevel = WARN | INFO | FINE | FINER | FINEST + deriving (Eq, Ord, Enum, Show, Read, Generic, Typeable) + +onFiles :: (String -> IO ()) -> [String] -> IO () +onFiles f = \case + [] -> getContents >>= f + fs -> mapM_ (readFile >=> f) fs + +getOpts :: [String] -> [Option] -> OptArgs +getOpts = flip getOpts' + + diff --git a/src/H/Dump.hs b/src/H/Dump.hs --- a/src/H/Dump.hs +++ b/src/H/Dump.hs @@ -5,26 +5,67 @@ 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 (_, switches, files) = getOpts args [ - 'T' ~: switch "tokens" - , 'L' ~: switch "layout" - , 'P' ~: switch "parse" + 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" ] - report = concatMap showMessage + 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 . tokenize "-" - | switches ? "layout" = either report showLayout . parse "-" - | switches ? "parse" = either report showLayout . parse "-" - | otherwise = const "Need -T, -L, or -P" + | 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" @@ -39,6 +80,10 @@ 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) diff --git a/src/H/Init.hs b/src/H/Init.hs --- a/src/H/Init.hs +++ b/src/H/Init.hs @@ -8,4 +8,6 @@ let (_options, _switches, _files) = getOpts args [ ] + + return () diff --git a/src/H/Run.hs b/src/H/Run.hs new file mode 100644 --- /dev/null +++ b/src/H/Run.hs @@ -0,0 +1,12 @@ +module H.Run where + +import H.Common + +main :: Tool +main _ args = do + + let (_options, _switches, _files) = getOpts args [ + ] + + return () + diff --git a/src/h.hs b/src/h.hs --- a/src/h.hs +++ b/src/h.hs @@ -9,6 +9,7 @@ import qualified H.Dump as Dump import qualified H.Init as Init +import qualified H.Run as Run showVersion :: IO () @@ -63,10 +64,11 @@ "help" -> showHelp topic - "escape" -> mapM_ (putStrLn . escapeFileName) (drop 1 args) - "unescape" -> mapM_ (maybe (return ()) putStrLn . unescapeFileName) (drop 1 args) + "escape" -> mapM_ (putStrLn . escapeFileName) (drop 1 args) + "unescape" -> mapM_ (maybe (return ()) putStrLn . unescapeFileName) (drop 1 args) - "dump" -> run Dump.main - "init" -> run Init.main + "dump" -> run Dump.main + "init" -> run Init.main + "run" -> run Run.main cmd -> unknownCommand cmd