{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Options.Harg.Sources.JSON
  ( JSONSource (..),
  )
where

import qualified Barbies as B
import qualified Data.Aeson as JSON
import qualified Data.ByteString.Lazy as LBS
import Data.Functor.Compose (Compose (..))
import Data.Functor.Identity (Identity (..))
import GHC.Generics (Generic)
import Options.Harg.Sources.Types
import Options.Harg.Types
import Options.Harg.Util (readFileLBS)

-- | Source that enables a parser to read options from a JSON file.
newtype JSONSource f = JSONSource (f ConfigFile)
  deriving ((forall x. JSONSource f -> Rep (JSONSource f) x)
-> (forall x. Rep (JSONSource f) x -> JSONSource f)
-> Generic (JSONSource f)
forall x. Rep (JSONSource f) x -> JSONSource f
forall x. JSONSource f -> Rep (JSONSource f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (JSONSource f) x -> JSONSource f
forall (f :: * -> *) x. JSONSource f -> Rep (JSONSource f) x
$cto :: forall (f :: * -> *) x. Rep (JSONSource f) x -> JSONSource f
$cfrom :: forall (f :: * -> *) x. JSONSource f -> Rep (JSONSource f) x
Generic, (forall (f :: * -> *) (g :: * -> *).
 (forall a. f a -> g a) -> JSONSource f -> JSONSource g)
-> FunctorB JSONSource
forall k (b :: (k -> *) -> *).
(forall (f :: k -> *) (g :: k -> *).
 (forall (a :: k). f a -> g a) -> b f -> b g)
-> FunctorB b
forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> JSONSource f -> JSONSource g
bmap :: (forall a. f a -> g a) -> JSONSource f -> JSONSource g
$cbmap :: forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> JSONSource f -> JSONSource g
B.FunctorB, FunctorB JSONSource
FunctorB JSONSource =>
(forall (e :: * -> *) (f :: * -> *) (g :: * -> *).
 Applicative e =>
 (forall a. f a -> e (g a)) -> JSONSource f -> e (JSONSource g))
-> TraversableB JSONSource
forall k (b :: (k -> *) -> *).
FunctorB b =>
(forall (e :: * -> *) (f :: k -> *) (g :: k -> *).
 Applicative e =>
 (forall (a :: k). f a -> e (g a)) -> b f -> e (b g))
-> TraversableB b
forall (e :: * -> *) (f :: * -> *) (g :: * -> *).
Applicative e =>
(forall a. f a -> e (g a)) -> JSONSource f -> e (JSONSource g)
btraverse :: (forall a. f a -> e (g a)) -> JSONSource f -> e (JSONSource g)
$cbtraverse :: forall (e :: * -> *) (f :: * -> *) (g :: * -> *).
Applicative e =>
(forall a. f a -> e (g a)) -> JSONSource f -> e (JSONSource g)
$cp1TraversableB :: FunctorB JSONSource
B.TraversableB, FunctorB JSONSource
FunctorB JSONSource =>
(forall (f :: * -> *). (forall a. f a) -> JSONSource f)
-> (forall (f :: * -> *) (g :: * -> *).
    JSONSource f -> JSONSource g -> JSONSource (Product f g))
-> ApplicativeB JSONSource
forall k (b :: (k -> *) -> *).
FunctorB b =>
(forall (f :: k -> *). (forall (a :: k). f a) -> b f)
-> (forall (f :: k -> *) (g :: k -> *).
    b f -> b g -> b (Product f g))
-> ApplicativeB b
forall (f :: * -> *). (forall a. f a) -> JSONSource f
forall (f :: * -> *) (g :: * -> *).
JSONSource f -> JSONSource g -> JSONSource (Product f g)
bprod :: JSONSource f -> JSONSource g -> JSONSource (Product f g)
$cbprod :: forall (f :: * -> *) (g :: * -> *).
JSONSource f -> JSONSource g -> JSONSource (Product f g)
bpure :: (forall a. f a) -> JSONSource f
$cbpure :: forall (f :: * -> *). (forall a. f a) -> JSONSource f
$cp1ApplicativeB :: FunctorB JSONSource
B.ApplicativeB)

-- | The result of reading a JSON file. @JSONSourceNotRequired@ is used when
-- the user has specified @defaultVal NoConfigFile@. It holds the contents of
-- the JSON file as a 'JSON.Value'.
data JSONSourceVal
  = JSONSourceVal LBS.ByteString
  | JSONSourceNotRequired

instance GetSource JSONSource Identity where
  type SourceVal JSONSource = JSONSourceVal
  getSource :: HargCtx -> JSONSource Identity -> IO (SourceVal JSONSource)
getSource _ctx :: HargCtx
_ctx (JSONSource (Identity (ConfigFile path :: FilePath
path))) =
    ByteString -> JSONSourceVal
JSONSourceVal (ByteString -> JSONSourceVal) -> IO ByteString -> IO JSONSourceVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
readFileLBS FilePath
path
  getSource _ctx :: HargCtx
_ctx (JSONSource (Identity NoConfigFile)) =
    JSONSourceVal -> IO JSONSourceVal
forall (f :: * -> *) a. Applicative f => a -> f a
pure JSONSourceVal
JSONSourceNotRequired

instance
  ( JSON.FromJSON (a Maybe),
    B.FunctorB a
  ) =>
  RunSource JSONSourceVal a
  where
  runSource :: JSONSourceVal
-> a (Compose Opt f)
-> [Either SourceRunError (a (Compose SourceRunResult f))]
runSource (JSONSourceVal j :: ByteString
j) opt :: a (Compose Opt f)
opt =
    [ByteString
-> a (Compose Opt f)
-> Either SourceRunError (a (Compose SourceRunResult f))
forall (a :: (* -> *) -> *) (f :: * -> *).
(FunctorB a, FromJSON (a Maybe), Applicative f) =>
ByteString
-> a (Compose Opt f)
-> Either SourceRunError (a (Compose SourceRunResult f))
runJSONSource ByteString
j a (Compose Opt f)
opt]
  runSource JSONSourceNotRequired _ =
    []

runJSONSource ::
  forall a f.
  ( B.FunctorB a,
    JSON.FromJSON (a Maybe),
    Applicative f
  ) =>
  LBS.ByteString ->
  a (Compose Opt f) ->
  Either SourceRunError (a (Compose SourceRunResult f))
runJSONSource :: ByteString
-> a (Compose Opt f)
-> Either SourceRunError (a (Compose SourceRunResult f))
runJSONSource json :: ByteString
json _opt :: a (Compose Opt f)
_opt =
  case Either FilePath (a Maybe)
res of
    Right v :: a Maybe
v -> a (Compose SourceRunResult f)
-> Either SourceRunError (a (Compose SourceRunResult f))
forall a b. b -> Either a b
Right (a (Compose SourceRunResult f)
 -> Either SourceRunError (a (Compose SourceRunResult f)))
-> a (Compose SourceRunResult f)
-> Either SourceRunError (a (Compose SourceRunResult f))
forall a b. (a -> b) -> a -> b
$ (forall a. Maybe a -> Compose SourceRunResult f a)
-> a Maybe -> a (Compose SourceRunResult f)
forall k (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FunctorB b =>
(forall (a :: k). f a -> g a) -> b f -> b g
B.bmap forall a. Maybe a -> Compose SourceRunResult f a
toSuccess a Maybe
v
    Left exc :: FilePath
exc -> SourceRunError
-> Either SourceRunError (a (Compose SourceRunResult f))
forall a b. a -> Either a b
Left (SourceRunError
 -> Either SourceRunError (a (Compose SourceRunResult f)))
-> SourceRunError
-> Either SourceRunError (a (Compose SourceRunResult f))
forall a b. (a -> b) -> a -> b
$ FilePath -> SourceRunError
toError FilePath
exc
  where
    res :: Either String (a Maybe)
    res :: Either FilePath (a Maybe)
res =
      ByteString -> Either FilePath (a Maybe)
forall a. FromJSON a => ByteString -> Either FilePath a
JSON.eitherDecode ByteString
json

    toSuccess :: Maybe x -> Compose SourceRunResult f x
    toSuccess :: Maybe x -> Compose SourceRunResult f x
toSuccess mx :: Maybe x
mx =
      SourceRunResult (f x) -> Compose SourceRunResult f x
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (SourceRunResult (f x) -> Compose SourceRunResult f x)
-> SourceRunResult (f x) -> Compose SourceRunResult f x
forall a b. (a -> b) -> a -> b
$ x -> f x
forall (f :: * -> *) a. Applicative f => a -> f a
pure (x -> f x) -> SourceRunResult x -> SourceRunResult (f x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SourceRunResult x
-> (x -> SourceRunResult x) -> Maybe x -> SourceRunResult x
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SourceRunResult x
forall a. SourceRunResult a
OptNotFound x -> SourceRunResult x
forall a. a -> SourceRunResult a
OptParsed Maybe x
mx

    toError :: String -> SourceRunError
    toError :: FilePath -> SourceRunError
toError =
      Maybe SomeOpt -> FilePath -> FilePath -> SourceRunError
SourceRunError Maybe SomeOpt
forall a. Maybe a
Nothing "JSONSource"