module Commands.Html.Options where import CommonOptions import Juvix.Compiler.Backend.Html.Data.Options hiding (HtmlOptions) data HtmlOptions = HtmlOptions { _htmlNonRecursive :: Bool, _htmlOnlySource :: Bool, _htmlOnlyCode :: Bool, _htmlTheme :: Theme, _htmlOutputDir :: AppPath Dir, _htmlInputFile :: AppPath File, _htmlNoFooter :: Bool, _htmlNoPath :: Bool, _htmlAssetsPrefix :: Text, _htmlUrlPrefix :: Text, _htmlIdPrefix :: Text, _htmlOpen :: Bool } deriving stock (Data) makeLenses ''HtmlOptions parseHtml :: Parser HtmlOptions parseHtml = do _htmlNonRecursive <- switch ( long "non-recursive" <> help "Do not process imported modules recursively" ) _htmlOnlySource <- switch ( long "only-source" <> help "Generate only Html for the source code with syntax highlighting" ) _htmlOnlyCode <- switch ( long "only-code" <> help "If --only-source is enabled, only generate the code without the header and footer" ) _htmlTheme <- option (eitherReader parseTheme) ( long "theme" <> metavar "THEME" <> value Ayu <> showDefault <> help ("Theme for syntax highlighting. " <> availableStr) <> completeWith (map show allThemes) ) _htmlOutputDir <- parseGenericOutputDir ( value "html" <> showDefault <> help "Html output directory" <> action "directory" ) _htmlNoFooter <- switch ( long "no-footer" <> help "Remove HTML Juvix footer" ) _htmlNoPath <- switch ( long "no-path" <> help "Remove the path from all hyperlinks" ) _htmlAssetsPrefix <- strOption ( value "" <> long "prefix-assets" <> showDefault <> help "Prefix used for assets's source path" ) _htmlUrlPrefix <- strOption ( value "" <> long "prefix-url" <> showDefault <> help "Prefix used for inner Juvix hyperlinks" ) _htmlIdPrefix <- strOption ( value "" <> long "prefix-id" <> showDefault <> help "Prefix used for HTML element IDs" ) _htmlOpen <- switch ( long "open" <> help "Open the documentation after generating it" ) _htmlInputFile <- parseInputJuvixFile pure HtmlOptions {..} where allThemes :: [Theme] allThemes = allElements availableStr :: String availableStr = dotSep [ showCategory (light, filter ((== light) . themeLight) allThemes) | light <- allElements ] where showCategory :: (ThemeLight, [Theme]) -> String showCategory (light, ts) = show light <> " themes: " <> commaSep (map show ts) commaSep = intercalate ", " dotSep = intercalate ". " parseTheme :: String -> Either String Theme parseTheme s = case lookup (map toLower s) themes of Just t -> return t Nothing -> Left $ "unrecognised theme: " <> s where themes :: [(String, Theme)] themes = [(show theme, theme) | theme <- allThemes]