juvix/app/Commands/Html/Options.hs

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 <- parseInputFile FileExtJuvix
  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]