Cli.hs

{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Rib.Cli
  ( CliConfig (..),
    cliParser,
    Verbosity (..),

    -- * Parser helpers
    directoryReader,
    watchOption,
    serveOption,

    -- * Internal
    hostPortParser,
  )
where

import Development.Shake (Verbosity (..))
import Options.Applicative
import Relude
import Relude.Extra.Tuple
import System.FilePath
import qualified Text.Megaparsec as M
import qualified Text.Megaparsec.Char as M

-- Rib's CLI configuration
--
-- Can be retrieved using `Rib.Shake.getCliConfig` in the `Development.Shake.Action` monad.
data CliConfig
  = CliConfig
      { -- | Whether to rebuild all sources in Shake.
        rebuildAll :: Bool,
        -- | Whether to monitor `inputDir` for changes and re-generate
        watch :: Bool,
        -- | Whether to run a HTTP server on `outputDir`
        serve :: Maybe (Text, Int),
        -- | Shake's verbosity level.
        --
        -- Setting this to `Silent` will affect Rib's own logging as well.
        verbosity :: Verbosity,
        -- | Directory from which source content will be read.
        inputDir :: FilePath,
        -- | The path where static files will be generated.  Rib's server uses this
        -- directory when serving files.
        outputDir :: FilePath,
        -- | Path to shake's database directory.
        shakeDbDir :: FilePath,
        -- | List of relative paths to ignore when watching the source directory
        watchIgnore :: [FilePath]
      }
  deriving (Show, Eq, Generic, Typeable)

cliParser :: FilePath -> FilePath -> Parser CliConfig
cliParser inputDirDefault outputDirDefault = do
  rebuildAll <-
    switch
      ( long "rebuild-all"
          <> help "Rebuild all sources"
      )
  watch <- watchOption
  serve <- serveOption
  verbosity <-
    fmap
      (bool Verbose Silent)
      ( switch
          ( long "quiet"
              <> help "Log nothing"
          )
      )
  ~(inputDir, shakeDbDir) <-
    fmap (toSnd shakeDbDirFrom) $
      option
        directoryReader
        ( long "input-dir"
            <> metavar "INPUTDIR"
            <> value inputDirDefault
            <> help ("Directory containing the source files (" <> "default: " <> inputDirDefault <> ")")
        )
  outputDir <-
    option
      directoryReader
      ( long "output-dir"
          <> metavar "OUTPUTDIR"
          <> value outputDirDefault
          <> help ("Directory where files will be generated (" <> "default: " <> outputDirDefault <> ")")
      )
  ~(watchIgnore) <- pure builtinWatchIgnores
  pure CliConfig {..}

watchOption :: Parser Bool
watchOption =
  switch
    ( long "watch"
        <> short 'w'
        <> help "Watch for changes and regenerate"
    )

serveOption :: Parser (Maybe (Text, Int))
serveOption =
  optional
    ( option
        (megaparsecReader hostPortParser)
        ( long "serve"
            <> short 's'
            <> metavar "[HOST]:PORT"
            <> help "Run a HTTP server on the generated directory"
        )
    )
    <|> ( fmap (bool Nothing $ Just (defaultHost, 8080)) $
            switch (short 'S' <> help ("Like `-s " <> toString defaultHost <> ":8080`"))
        )

builtinWatchIgnores :: [FilePath]
builtinWatchIgnores =
  [ ".shake",
    ".git"
  ]

shakeDbDirFrom :: FilePath -> FilePath
shakeDbDirFrom inputDir =
  -- Keep shake database directory under the src directory instead of the
  -- (default) current working directory, which may not always be a project
  -- root (as in the case of neuron).
  inputDir </> ".shake"

-- | Like `str` but adds a trailing slash if there isn't one.
directoryReader :: ReadM FilePath
directoryReader = fmap addTrailingPathSeparator str

megaparsecReader :: M.Parsec Void Text a -> ReadM a
megaparsecReader p =
  eitherReader (first M.errorBundlePretty . M.parse p "<optparse-input>" . toText)

hostPortParser :: M.Parsec Void Text (Text, Int)
hostPortParser = do
  host <-
    optional $
      M.string "localhost"
        <|> M.try parseIP
  void $ M.char ':'
  port <- parseNumRange 1 65535
  pure (fromMaybe defaultHost host, port)
  where
    readNum = maybe (fail "Not a number") pure . readMaybe
    parseIP :: M.Parsec Void Text Text
    parseIP = do
      a <- parseNumRange 0 255 <* M.char '.'
      b <- parseNumRange 0 255 <* M.char '.'
      c <- parseNumRange 0 255 <* M.char '.'
      d <- parseNumRange 0 255
      pure $ toText $ intercalate "." $ show <$> [a, b, c, d]
    parseNumRange :: Int -> Int -> M.Parsec Void Text Int
    parseNumRange a b = do
      n <- readNum =<< M.some M.digitChar
      if a <= n && n <= b
        then pure n
        else fail $ "Number not in range: " <> show a <> "-" <> show b

defaultHost :: Text
defaultHost = "127.0.0.1"