-- |Combinators for @optparse-applicative@.
module Ribosome.Host.Optparse where

import Exon (exon)
import Log (Severity, parseSeverity)
import Options.Applicative (ReadM, readerError)
import Options.Applicative.Types (readerAsk)
import Path (Abs, Dir, File, Path, SomeBase (Abs, Rel), parseSomeDir, parseSomeFile, (</>))

-- |Convert a path to absolute, using the first argument as base dir for relative paths.
somePath ::
  Path Abs Dir ->
  SomeBase t ->
  Path Abs t
somePath :: forall t. Path Abs Dir -> SomeBase t -> Path Abs t
somePath Path Abs Dir
cwd = \case
  Abs Path Abs t
p ->
    Path Abs t
p
  Rel Path Rel t
p ->
    Path Abs Dir
cwd Path Abs Dir -> Path Rel t -> Path Abs t
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel t
p

-- |A logging severity option for @optparse-applicative@.
severityOption :: ReadM Severity
severityOption :: ReadM Severity
severityOption = do
  String
raw <- ReadM String
readerAsk
  ReadM Severity
-> (Severity -> ReadM Severity) -> Maybe Severity -> ReadM Severity
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ReadM Severity
forall a. String -> ReadM a
readerError [exon|invalid log level: #{raw}|]) Severity -> ReadM Severity
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Severity
parseSeverity (String -> Text
forall a. ToText a => a -> Text
toText String
raw))

-- |Parse a path from a string in 'ReadM'.
readPath ::
  String ->
  (String -> Either e (SomeBase t)) ->
  Path Abs Dir ->
  String ->
  ReadM (Path Abs t)
readPath :: forall e t.
String
-> (String -> Either e (SomeBase t))
-> Path Abs Dir
-> String
-> ReadM (Path Abs t)
readPath String
pathType String -> Either e (SomeBase t)
parse Path Abs Dir
cwd String
raw =
  (e -> ReadM (Path Abs t))
-> (SomeBase t -> ReadM (Path Abs t))
-> Either e (SomeBase t)
-> ReadM (Path Abs t)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ReadM (Path Abs t) -> e -> ReadM (Path Abs t)
forall a b. a -> b -> a
const (String -> ReadM (Path Abs t)
forall a. String -> ReadM a
readerError [exon|not a valid #{pathType} path: #{raw}|])) (Path Abs t -> ReadM (Path Abs t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs t -> ReadM (Path Abs t))
-> (SomeBase t -> Path Abs t) -> SomeBase t -> ReadM (Path Abs t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> SomeBase t -> Path Abs t
forall t. Path Abs Dir -> SomeBase t -> Path Abs t
somePath Path Abs Dir
cwd) (String -> Either e (SomeBase t)
parse String
raw)

-- |A path option for @optparse-applicative@.
pathOption ::
  String ->
  (String -> Either e (SomeBase t)) ->
  Path Abs Dir ->
  ReadM (Path Abs t)
pathOption :: forall e t.
String
-> (String -> Either e (SomeBase t))
-> Path Abs Dir
-> ReadM (Path Abs t)
pathOption String
pathType String -> Either e (SomeBase t)
parse Path Abs Dir
cwd = do
  String
raw <- ReadM String
readerAsk
  String
-> (String -> Either e (SomeBase t))
-> Path Abs Dir
-> String
-> ReadM (Path Abs t)
forall e t.
String
-> (String -> Either e (SomeBase t))
-> Path Abs Dir
-> String
-> ReadM (Path Abs t)
readPath String
pathType String -> Either e (SomeBase t)
parse Path Abs Dir
cwd String
raw

-- |A directory path option for @optparse-applicative@.
dirPathOption ::
  Path Abs Dir ->
  ReadM (Path Abs Dir)
dirPathOption :: Path Abs Dir -> ReadM (Path Abs Dir)
dirPathOption =
  String
-> (String -> Either SomeException (SomeBase Dir))
-> Path Abs Dir
-> ReadM (Path Abs Dir)
forall e t.
String
-> (String -> Either e (SomeBase t))
-> Path Abs Dir
-> ReadM (Path Abs t)
pathOption String
"directory" String -> Either SomeException (SomeBase Dir)
forall (m :: * -> *). MonadThrow m => String -> m (SomeBase Dir)
parseSomeDir

-- |A file path option for @optparse-applicative@.
filePathOption ::
  Path Abs Dir ->
  ReadM (Path Abs File)
filePathOption :: Path Abs Dir -> ReadM (Path Abs File)
filePathOption =
  String
-> (String -> Either SomeException (SomeBase File))
-> Path Abs Dir
-> ReadM (Path Abs File)
forall e t.
String
-> (String -> Either e (SomeBase t))
-> Path Abs Dir
-> ReadM (Path Abs t)
pathOption String
"file" String -> Either SomeException (SomeBase File)
forall (m :: * -> *). MonadThrow m => String -> m (SomeBase File)
parseSomeFile