-- |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, parseAbsDir, 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
  (SomeException -> ReadM (Path Abs File))
-> Either SomeException (Path Abs File) -> ReadM (Path Abs File)
forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> Either a b -> m b
leftA (ReadM (Path Abs File) -> SomeException -> ReadM (Path Abs File)
forall a b. a -> b -> a
const (String -> ReadM (Path Abs File)
forall a. String -> ReadM a
readerError [exon|not a valid absolute file path: #{raw}|])) (String -> Either SomeException (Path Abs File)
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
  (SomeException -> ReadM (Path Rel File))
-> Either SomeException (Path Rel File) -> ReadM (Path Rel File)
forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> Either a b -> m b
leftA (ReadM (Path Rel File) -> SomeException -> ReadM (Path Rel File)
forall a b. a -> b -> a
const (String -> ReadM (Path Rel File)
forall a. String -> ReadM a
readerError [exon|not a valid relative file path: #{raw}|])) (String -> Either SomeException (Path Rel File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile String
raw)

-- |A relative dir path option for @optparse-applicative@.
absDirOption :: ReadM (Path Abs Dir)
absDirOption :: ReadM (Path Abs Dir)
absDirOption = do
  String
raw <- ReadM String
readerAsk
  (SomeException -> ReadM (Path Abs Dir))
-> Either SomeException (Path Abs Dir) -> ReadM (Path Abs Dir)
forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> Either a b -> m b
leftA (ReadM (Path Abs Dir) -> SomeException -> ReadM (Path Abs Dir)
forall a b. a -> b -> a
const (String -> ReadM (Path Abs Dir)
forall a. String -> ReadM a
readerError [exon|not a valid absolute dir path: #{raw}|])) (String -> Either SomeException (Path Abs Dir)
forall (m :: * -> *). MonadThrow m => String -> m (Path Abs Dir)
parseAbsDir 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
  (SomeException -> ReadM (Path Rel Dir))
-> Either SomeException (Path Rel Dir) -> ReadM (Path Rel Dir)
forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> Either a b -> m b
leftA (ReadM (Path Rel Dir) -> SomeException -> ReadM (Path Rel Dir)
forall a b. a -> b -> a
const (String -> ReadM (Path Rel Dir)
forall a. String -> ReadM a
readerError [exon|not a valid relative dir path: #{raw}|])) (String -> Either SomeException (Path Rel Dir)
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. JsonConfig -> Rep JsonConfig x)
-> (forall x. Rep JsonConfig x -> JsonConfig) -> Generic JsonConfig
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
$cfrom :: forall x. JsonConfig -> Rep JsonConfig x
from :: forall x. JsonConfig -> Rep JsonConfig x
$cto :: forall x. Rep JsonConfig x -> JsonConfig
to :: forall x. Rep JsonConfig x -> JsonConfig
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 (IO (Either String Value) -> JsonConfig)
-> IO (Either String Value) -> JsonConfig
forall a b. (a -> b) -> a -> b
$ case String -> Maybe (Path Abs File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Abs File)
parseAbsFile String
raw of
    Just Path Abs File
f -> String -> IO (Either String Value)
forall a. FromJSON a => String -> IO (Either String a)
eitherDecodeFileStrict' (Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
f)
    Maybe (Path Abs File)
Nothing -> Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict' (String -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 String
raw))