{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE NoStarIsType #-}
{-# LANGUAGE EmptyDataDeriving #-}
-- | promoted json encoding and decoding functions

module Predicate.Data.Json (
  -- ** parse

    ParseJson'
  , ParseJson
  , ParseJsonFile'
  , ParseJsonFile

  -- ** encode

  , EncodeJson
  , EncodeJsonFile
 ) where
import Predicate.Core
import Predicate.Misc
import Predicate.Util
import Data.Proxy (Proxy(Proxy))
import Data.Typeable (Typeable)
import Data.Kind (Type)
import qualified Data.Aeson as A
import qualified Data.Aeson.Encode.Pretty as AP
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy.Char8 as BL8
import System.Directory (doesFileExist)
import Data.Bool (bool)
-- $setup

-- >>> :set -XDataKinds

-- >>> :set -XTypeApplications

-- >>> :set -XTypeOperators

-- >>> :set -XOverloadedStrings

-- >>> import Predicate.Prelude


-- | parse json data using the type @t@

data ParseJson' t p deriving Int -> ParseJson' t p -> ShowS
[ParseJson' t p] -> ShowS
ParseJson' t p -> String
(Int -> ParseJson' t p -> ShowS)
-> (ParseJson' t p -> String)
-> ([ParseJson' t p] -> ShowS)
-> Show (ParseJson' t p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k) k (p :: k). Int -> ParseJson' t p -> ShowS
forall k (t :: k) k (p :: k). [ParseJson' t p] -> ShowS
forall k (t :: k) k (p :: k). ParseJson' t p -> String
showList :: [ParseJson' t p] -> ShowS
$cshowList :: forall k (t :: k) k (p :: k). [ParseJson' t p] -> ShowS
show :: ParseJson' t p -> String
$cshow :: forall k (t :: k) k (p :: k). ParseJson' t p -> String
showsPrec :: Int -> ParseJson' t p -> ShowS
$cshowsPrec :: forall k (t :: k) k (p :: k). Int -> ParseJson' t p -> ShowS
Show

instance ( P p x
         , PP p x ~ BL8.ByteString
         , Typeable (PP t x)
         , Show (PP t x)
         , A.FromJSON (PP t x)
         ) => P (ParseJson' t p) x where
  type PP (ParseJson' t p) x = PP t x
  eval :: proxy (ParseJson' t p)
-> POpts -> x -> m (TT (PP (ParseJson' t p) x))
eval proxy (ParseJson' t p)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"ParseJson " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
t
        t :: String
t = Typeable (PP t x) => String
forall t. Typeable t => String
showT @(PP t x)
    TT ByteString
pp <- Proxy p -> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x
    TT (PP t x) -> m (TT (PP t x))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP t x) -> m (TT (PP t x))) -> TT (PP t x) -> m (TT (PP t x))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT ByteString
-> [Tree PE]
-> Either (TT (PP t x)) ByteString
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT ByteString
pp [] of
      Left TT (PP t x)
e -> TT (PP t x)
e
      Right ByteString
s ->
        let hhs :: [Tree PE]
hhs = [TT ByteString -> Tree PE
forall a. TT a -> Tree PE
hh TT ByteString
pp]
            msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ POpts -> ByteString -> String
litBL POpts
opts { oWidth :: HKD Identity Int
oWidth = POpts -> HKD Identity Int
forall (f :: Type -> Type). HOpts f -> HKD f Int
oWidth POpts
opts Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
3 } ByteString
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
        in case ByteString -> Either String (PP t x)
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode' ByteString
s of
           Right PP t x
b -> POpts -> Val (PP t x) -> String -> [Tree PE] -> TT (PP t x)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP t x -> Val (PP t x)
forall a. a -> Val a
Val PP t x
b) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ POpts -> PP t x -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts { oWidth :: HKD Identity Int
oWidth = POpts -> HKD Identity Int
forall (f :: Type -> Type). HOpts f -> HKD f Int
oWidth POpts
opts Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 } PP t x
b) [Tree PE]
hhs
           Left String
e -> POpts -> Val (PP t x) -> String -> [Tree PE] -> TT (PP t x)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (PP t x)
forall a. String -> Val a
Fail (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
e)) (POpts -> ByteString -> String
litBL POpts
opts ByteString
s) [Tree PE]
hhs

-- | parse json data using the type @t@

--

-- >>> pl @(ParseJson (Int,String) Id) "[10,\"abc\"]"

-- Present (10,"abc") (ParseJson (Int,[Char]) (10,"abc"))

-- Val (10,"abc")

--

-- >>> pl @(ParseJson (Int,String) Id) "[10,\"abc\",99]"

-- Error ParseJson (Int,[Char])([10,"abc",99]) Error in $: cannot unpack array of length 3 into a tuple of length 2 ([10,"abc",99])

-- Fail "ParseJson (Int,[Char])([10,\"abc\",99]) Error in $: cannot unpack array of length 3 into a tuple of length 2"

--

-- >>> pl @(ParseJson (Int,Bool) (FromString _ Id)) "[1,true]"

-- Present (1,True) (ParseJson (Int,Bool) (1,True))

-- Val (1,True)

--

-- >>> pl @(ParseJson (Int,Bool) Id) (A.encode (1,True))

-- Present (1,True) (ParseJson (Int,Bool) (1,True))

-- Val (1,True)

--

-- >>> pl @(ParseJson () Id) "[1,true]"

-- Error ParseJson ()([1,true]) Error in $: parsing () failed, expected an empty array ([1,true])

-- Fail "ParseJson ()([1,true]) Error in $: parsing () failed, expected an empty array"

--

data ParseJson (t :: Type) p deriving Int -> ParseJson t p -> ShowS
[ParseJson t p] -> ShowS
ParseJson t p -> String
(Int -> ParseJson t p -> ShowS)
-> (ParseJson t p -> String)
-> ([ParseJson t p] -> ShowS)
-> Show (ParseJson t p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t k (p :: k). Int -> ParseJson t p -> ShowS
forall t k (p :: k). [ParseJson t p] -> ShowS
forall t k (p :: k). ParseJson t p -> String
showList :: [ParseJson t p] -> ShowS
$cshowList :: forall t k (p :: k). [ParseJson t p] -> ShowS
show :: ParseJson t p -> String
$cshow :: forall t k (p :: k). ParseJson t p -> String
showsPrec :: Int -> ParseJson t p -> ShowS
$cshowsPrec :: forall t k (p :: k). Int -> ParseJson t p -> ShowS
Show
type ParseJsonT (t :: Type) p = ParseJson' (Hole t) p

instance P (ParseJsonT t p) x => P (ParseJson t p) x where
  type PP (ParseJson t p) x = PP (ParseJsonT t p) x
  eval :: proxy (ParseJson t p)
-> POpts -> x -> m (TT (PP (ParseJson t p) x))
eval proxy (ParseJson t p)
_ = Proxy (ParseJsonT t p)
-> POpts -> x -> m (TT (PP (ParseJsonT t p) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (ParseJsonT t p)
forall k (t :: k). Proxy t
Proxy @(ParseJsonT t p))

-- | parse json file @p@ using the type @t@

data ParseJsonFile' t p deriving Int -> ParseJsonFile' t p -> ShowS
[ParseJsonFile' t p] -> ShowS
ParseJsonFile' t p -> String
(Int -> ParseJsonFile' t p -> ShowS)
-> (ParseJsonFile' t p -> String)
-> ([ParseJsonFile' t p] -> ShowS)
-> Show (ParseJsonFile' t p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k) k (p :: k). Int -> ParseJsonFile' t p -> ShowS
forall k (t :: k) k (p :: k). [ParseJsonFile' t p] -> ShowS
forall k (t :: k) k (p :: k). ParseJsonFile' t p -> String
showList :: [ParseJsonFile' t p] -> ShowS
$cshowList :: forall k (t :: k) k (p :: k). [ParseJsonFile' t p] -> ShowS
show :: ParseJsonFile' t p -> String
$cshow :: forall k (t :: k) k (p :: k). ParseJsonFile' t p -> String
showsPrec :: Int -> ParseJsonFile' t p -> ShowS
$cshowsPrec :: forall k (t :: k) k (p :: k). Int -> ParseJsonFile' t p -> ShowS
Show

instance ( P p x
         , PP p x ~ String
         , Typeable (PP t x)
         , Show (PP t x)
         , A.FromJSON (PP t x)
         ) => P (ParseJsonFile' t p) x where
  type PP (ParseJsonFile' t p) x = PP t x
  eval :: proxy (ParseJsonFile' t p)
-> POpts -> x -> m (TT (PP (ParseJsonFile' t p) x))
eval proxy (ParseJsonFile' t p)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"ParseJsonFile " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
t
        t :: String
t = Typeable (PP t x) => String
forall t. Typeable t => String
showT @(PP t x)
    TT String
pp <- Proxy p -> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x
    case Inline
-> POpts
-> String
-> TT String
-> [Tree PE]
-> Either (TT (PP t x)) String
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT String
pp [] of
      Left TT (PP t x)
e -> TT (PP t x) -> m (TT (PP t x))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (PP t x)
e
      Right String
p -> do
        let hhs :: [Tree PE]
hhs = [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]
            msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
        Maybe (Maybe ByteString)
mb <- IO (Maybe ByteString) -> m (Maybe (Maybe ByteString))
forall (m :: Type -> Type) a. MonadEval m => IO a -> m (Maybe a)
runIO (IO (Maybe ByteString) -> m (Maybe (Maybe ByteString)))
-> IO (Maybe ByteString) -> m (Maybe (Maybe ByteString))
forall a b. (a -> b) -> a -> b
$
                IO Bool
-> IO (Maybe ByteString)
-> IO (Maybe ByteString)
-> IO (Maybe ByteString)
forall (m :: Type -> Type) a.
Monad m =>
m Bool -> m a -> m a -> m a
ifM (String -> IO Bool
doesFileExist String
p)
                    (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> IO ByteString -> IO (Maybe ByteString)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BS8.readFile String
p)
                    IO (Maybe ByteString)
forall a. Monoid a => a
mempty
        TT (PP t x) -> m (TT (PP t x))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP t x) -> m (TT (PP t x))) -> TT (PP t x) -> m (TT (PP t x))
forall a b. (a -> b) -> a -> b
$ case Maybe (Maybe ByteString)
mb of
          Maybe (Maybe ByteString)
Nothing -> POpts -> Val (PP t x) -> String -> [Tree PE] -> TT (PP t x)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (PP t x)
forall a. String -> Val a
Fail (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" must run in IO")) String
"" [Tree PE]
hhs
          Just Maybe ByteString
Nothing -> POpts -> Val (PP t x) -> String -> [Tree PE] -> TT (PP t x)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (PP t x)
forall a. String -> Val a
Fail (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" file does not exist")) String
"" [Tree PE]
hhs
          Just (Just ByteString
s) ->
            case ByteString -> Either String (PP t x)
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecodeStrict' ByteString
s of
               Right PP t x
b -> POpts -> Val (PP t x) -> String -> [Tree PE] -> TT (PP t x)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP t x -> Val (PP t x)
forall a. a -> Val a
Val PP t x
b) (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ POpts -> PP t x -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP t x
b) [Tree PE]
hhs
               Left String
e -> POpts -> Val (PP t x) -> String -> [Tree PE] -> TT (PP t x)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (PP t x)
forall a. String -> Val a
Fail (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
e)) (POpts -> ByteString -> String
litBS POpts
opts ByteString
s) [Tree PE]
hhs

-- | parse a json file @p@ using the type @t@

--

-- >>> pz @(ParseJsonFile [A.Value] "test1.json" >> Id !! 2) ()

-- Val (Object (fromList [("lastName",String "Doe"),("age",Number 45.0),("firstName",String "John"),("likesPizza",Bool False)]))

--

data ParseJsonFile (t :: Type) p deriving Int -> ParseJsonFile t p -> ShowS
[ParseJsonFile t p] -> ShowS
ParseJsonFile t p -> String
(Int -> ParseJsonFile t p -> ShowS)
-> (ParseJsonFile t p -> String)
-> ([ParseJsonFile t p] -> ShowS)
-> Show (ParseJsonFile t p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t k (p :: k). Int -> ParseJsonFile t p -> ShowS
forall t k (p :: k). [ParseJsonFile t p] -> ShowS
forall t k (p :: k). ParseJsonFile t p -> String
showList :: [ParseJsonFile t p] -> ShowS
$cshowList :: forall t k (p :: k). [ParseJsonFile t p] -> ShowS
show :: ParseJsonFile t p -> String
$cshow :: forall t k (p :: k). ParseJsonFile t p -> String
showsPrec :: Int -> ParseJsonFile t p -> ShowS
$cshowsPrec :: forall t k (p :: k). Int -> ParseJsonFile t p -> ShowS
Show
type ParseJsonFileT (t :: Type) p = ParseJsonFile' (Hole t) p

instance P (ParseJsonFileT t p) x => P (ParseJsonFile t p) x where
  type PP (ParseJsonFile t p) x = PP (ParseJsonFileT t p) x
  eval :: proxy (ParseJsonFile t p)
-> POpts -> x -> m (TT (PP (ParseJsonFile t p) x))
eval proxy (ParseJsonFile t p)
_ = Proxy (ParseJsonFileT t p)
-> POpts -> x -> m (TT (PP (ParseJsonFileT t p) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (ParseJsonFileT t p)
forall k (t :: k). Proxy t
Proxy @(ParseJsonFileT t p))

-- | encode json with pretty option

--

-- >>> pl @(EncodeJson 'False Id) (10,"def")

-- Present "[10,\"def\"]" (EncodeJson [10,"def"])

-- Val "[10,\"def\"]"

--

-- >>> pl @(EncodeJson 'False Id >> ParseJson (Int,Bool) Id) (1,True)

-- Present (1,True) ((>>) (1,True) | {ParseJson (Int,Bool) (1,True)})

-- Val (1,True)

--

data EncodeJson (pretty :: Bool) p deriving Int -> EncodeJson pretty p -> ShowS
[EncodeJson pretty p] -> ShowS
EncodeJson pretty p -> String
(Int -> EncodeJson pretty p -> ShowS)
-> (EncodeJson pretty p -> String)
-> ([EncodeJson pretty p] -> ShowS)
-> Show (EncodeJson pretty p)
forall (pretty :: Bool) k (p :: k).
Int -> EncodeJson pretty p -> ShowS
forall (pretty :: Bool) k (p :: k). [EncodeJson pretty p] -> ShowS
forall (pretty :: Bool) k (p :: k). EncodeJson pretty p -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EncodeJson pretty p] -> ShowS
$cshowList :: forall (pretty :: Bool) k (p :: k). [EncodeJson pretty p] -> ShowS
show :: EncodeJson pretty p -> String
$cshow :: forall (pretty :: Bool) k (p :: k). EncodeJson pretty p -> String
showsPrec :: Int -> EncodeJson pretty p -> ShowS
$cshowsPrec :: forall (pretty :: Bool) k (p :: k).
Int -> EncodeJson pretty p -> ShowS
Show

instance ( GetBool pretty
         , A.ToJSON (PP p x)
         , P p x
         ) => P (EncodeJson pretty p) x where
  type PP (EncodeJson pretty p) x = BL8.ByteString
  eval :: proxy (EncodeJson pretty p)
-> POpts -> x -> m (TT (PP (EncodeJson pretty p) x))
eval proxy (EncodeJson pretty p)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"EncodeJson"
        pretty :: Bool
pretty = GetBool pretty => Bool
forall (a :: Bool). GetBool a => Bool
getBool @pretty
    TT (PP p x)
pp <- Proxy p -> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x
    TT ByteString -> m (TT ByteString)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT ByteString -> m (TT ByteString))
-> TT ByteString -> m (TT ByteString)
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP p x)
-> [Tree PE]
-> Either (TT ByteString) (PP p x)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (PP p x)
pp [] of
      Left TT ByteString
e -> TT ByteString
e
      Right PP p x
p ->
        let d :: ByteString
d = (PP p x -> ByteString)
-> (PP p x -> ByteString) -> Bool -> PP p x -> ByteString
forall a. a -> a -> Bool -> a
bool PP p x -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode PP p x -> ByteString
forall a. ToJSON a => a -> ByteString
AP.encodePretty Bool
pretty PP p x
p
        in POpts -> Val ByteString -> String -> [Tree PE] -> TT ByteString
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (ByteString -> Val ByteString
forall a. a -> Val a
Val ByteString
d) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> ShowS
litL POpts
opts (POpts -> ByteString -> String
litBL POpts
opts ByteString
d)) [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp]

-- | encode a json file with pretty option

data EncodeJsonFile (pretty :: Bool) p q deriving Int -> EncodeJsonFile pretty p q -> ShowS
[EncodeJsonFile pretty p q] -> ShowS
EncodeJsonFile pretty p q -> String
(Int -> EncodeJsonFile pretty p q -> ShowS)
-> (EncodeJsonFile pretty p q -> String)
-> ([EncodeJsonFile pretty p q] -> ShowS)
-> Show (EncodeJsonFile pretty p q)
forall (pretty :: Bool) k (p :: k) k (q :: k).
Int -> EncodeJsonFile pretty p q -> ShowS
forall (pretty :: Bool) k (p :: k) k (q :: k).
[EncodeJsonFile pretty p q] -> ShowS
forall (pretty :: Bool) k (p :: k) k (q :: k).
EncodeJsonFile pretty p q -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EncodeJsonFile pretty p q] -> ShowS
$cshowList :: forall (pretty :: Bool) k (p :: k) k (q :: k).
[EncodeJsonFile pretty p q] -> ShowS
show :: EncodeJsonFile pretty p q -> String
$cshow :: forall (pretty :: Bool) k (p :: k) k (q :: k).
EncodeJsonFile pretty p q -> String
showsPrec :: Int -> EncodeJsonFile pretty p q -> ShowS
$cshowsPrec :: forall (pretty :: Bool) k (p :: k) k (q :: k).
Int -> EncodeJsonFile pretty p q -> ShowS
Show

instance ( GetBool pretty
         , PP p x ~ String
         , P p x
         , A.ToJSON (PP q x)
         , P q x
         ) => P (EncodeJsonFile pretty p q) x where
  type PP (EncodeJsonFile pretty p q) x = ()
  eval :: proxy (EncodeJsonFile pretty p q)
-> POpts -> x -> m (TT (PP (EncodeJsonFile pretty p q) x))
eval proxy (EncodeJsonFile pretty p q)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"EncodeJsonFile"
        pretty :: Bool
pretty = GetBool pretty => Bool
forall (a :: Bool). GetBool a => Bool
getBool @pretty
    Either (TT ()) (String, PP q x, TT String, TT (PP q x))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> x
-> [Tree PE]
-> m (Either (TT ()) (PP p x, PP q x, TT (PP p x), TT (PP q x)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
       (proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts x
x []
    case Either (TT ()) (String, PP q x, TT String, TT (PP q x))
lr of
      Left TT ()
e -> TT () -> m (TT ())
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT ()
e
      Right (String
p,PP q x
q,TT String
pp,TT (PP q x)
qq) -> do
        let d :: ByteString
d = (PP q x -> ByteString)
-> (PP q x -> ByteString) -> Bool -> PP q x -> ByteString
forall a. a -> a -> Bool -> a
bool PP q x -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode PP q x -> ByteString
forall a. ToJSON a => a -> ByteString
AP.encodePretty Bool
pretty PP q x
q
            hhs :: [Tree PE]
hhs = [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp, TT (PP q x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q x)
qq]
        Maybe ()
mb <- IO () -> m (Maybe ())
forall (m :: Type -> Type) a. MonadEval m => IO a -> m (Maybe a)
runIO (IO () -> m (Maybe ())) -> IO () -> m (Maybe ())
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
BL8.writeFile String
p ByteString
d
        TT () -> m (TT ())
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT () -> m (TT ())) -> TT () -> m (TT ())
forall a b. (a -> b) -> a -> b
$ case Maybe ()
mb of
          Maybe ()
Nothing -> POpts -> Val () -> String -> [Tree PE] -> TT ()
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val ()
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" must run in IO")) String
"" [Tree PE]
hhs
          Just () -> POpts -> Val () -> String -> [Tree PE] -> TT ()
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (() -> Val ()
forall a. a -> Val a
Val ()) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> ShowS
litL POpts
opts (POpts -> ByteString -> String
litBL POpts
opts ByteString
d)) [Tree PE]
hhs