-- |Combinators for @optparse-applicative@.
module Hix.Optparse where

import Data.Aeson (Value, eitherDecodeFileStrict', eitherDecodeStrict')
import Exon (exon)
import Options.Applicative (ReadM, readerError)
import Options.Applicative.Types (readerAsk)
import Path (Abs, Dir, File, Path, Rel, parseAbsFile, parseRelDir, parseRelFile, toFilePath)
import qualified Text.Show as Show

-- |An absolute file path option for @optparse-applicative@.
absFileOption :: ReadM (Path Abs File)
absFileOption :: ReadM (Path Abs File)
absFileOption = do
  String
raw <- ReadM String
readerAsk
  forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> Either a b -> m b
leftA (forall a b. a -> b -> a
const (forall a. String -> ReadM a
readerError [exon|not a valid absolute file path: #{raw}|])) (forall (m :: * -> *). MonadThrow m => String -> m (Path Abs File)
parseAbsFile String
raw)

-- |A relative file path option for @optparse-applicative@.
relFileOption :: ReadM (Path Rel File)
relFileOption :: ReadM (Path Rel File)
relFileOption = do
  String
raw <- ReadM String
readerAsk
  forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> Either a b -> m b
leftA (forall a b. a -> b -> a
const (forall a. String -> ReadM a
readerError [exon|not a valid relative file path: #{raw}|])) (forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile String
raw)

-- |A relative dir path option for @optparse-applicative@.
relDirOption :: ReadM (Path Rel Dir)
relDirOption :: ReadM (Path Rel Dir)
relDirOption = do
  String
raw <- ReadM String
readerAsk
  forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> Either a b -> m b
leftA (forall a b. a -> b -> a
const (forall a. String -> ReadM a
readerError [exon|not a valid relative dir path: #{raw}|])) (forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parseRelDir String
raw)

newtype JsonConfig =
  JsonConfig { JsonConfig -> IO (Either String Value)
unJsonConfig :: IO (Either String Value) }
  deriving stock (forall x. Rep JsonConfig x -> JsonConfig
forall x. JsonConfig -> Rep JsonConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JsonConfig x -> JsonConfig
$cfrom :: forall x. JsonConfig -> Rep JsonConfig x
Generic)

instance Show JsonConfig where
  show :: JsonConfig -> String
show (JsonConfig IO (Either String Value)
_) = String
"JsonConfig"

jsonOption ::
  ReadM JsonConfig
jsonOption :: ReadM JsonConfig
jsonOption = do
  String
raw <- ReadM String
readerAsk
  pure $ IO (Either String Value) -> JsonConfig
JsonConfig forall a b. (a -> b) -> a -> b
$ case forall (m :: * -> *). MonadThrow m => String -> m (Path Abs File)
parseAbsFile String
raw of
    Just Path Abs File
f -> forall a. FromJSON a => String -> IO (Either String a)
eitherDecodeFileStrict' (forall b t. Path b t -> String
toFilePath Path Abs File
f)
    Maybe (Path Abs File)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict' (forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 String
raw))