Optparse.hs

-- |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 = do
  raw <- readerAsk
  leftA (const (readerError [exon|not a valid absolute file path: #{raw}|])) (parseAbsFile raw)

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

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

newtype JsonConfig =
  JsonConfig { unJsonConfig :: IO (Either String Value) }
  deriving stock (Generic)

instance Show JsonConfig where
  show (JsonConfig _) = "JsonConfig"

jsonOption ::
  ReadM JsonConfig
jsonOption = do
  raw <- readerAsk
  pure $ JsonConfig $ case parseAbsFile raw of
    Just f -> eitherDecodeFileStrict' (toFilePath f)
    Nothing -> pure (eitherDecodeStrict' (encodeUtf8 raw))