-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.JSON.Types
-- Copyright   :  (C) 2016-2025 David M. Johnson
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <code@dmj.io>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Types for the @Miso.JSON@ module and JSON specification.
--
-- This was ported from <https://github.com/dmjio/json-test> by [@ners](https://github.com/ners)
--
----------------------------------------------------------------------------
{-# LANGUAGE CPP #-}
----------------------------------------------------------------------------
module Miso.JSON.Types
  ( -- * Types
    Value (..)
  , Result (..)
  , Pair
  , Object
  ) where
----------------------------------------------------------------------------
import Control.Applicative (Alternative (..))
import Control.Monad (MonadPlus(..), ap)
import Data.Map.Strict (Map)
----------------------------------------------------------------------------
import Data.String (IsString(fromString))
import Miso.String (MisoString, toMisoString)
----------------------------------------------------------------------------
#if __GLASGOW_HASKELL__ <= 881
import Prelude hiding (fail)
import Control.Monad.Fail (MonadFail (..))
#endif
----------------------------------------------------------------------------
data Value
  = Number Double
  | Bool Bool
  | String MisoString
  | Array [Value]
  | Object (Map MisoString Value)
  | Null
  deriving (Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Value -> ShowS
showsPrec :: Int -> Value -> ShowS
$cshow :: Value -> String
show :: Value -> String
$cshowList :: [Value] -> ShowS
showList :: [Value] -> ShowS
Show, Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
/= :: Value -> Value -> Bool
Eq)
----------------------------------------------------------------------------
instance IsString Value where
  fromString :: String -> Value
fromString = MisoString -> Value
String (MisoString -> Value) -> (String -> MisoString) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> MisoString
forall a. IsString a => String -> a
fromString
----------------------------------------------------------------------------
type Pair = (MisoString, Value)
----------------------------------------------------------------------------
type Object = Map MisoString Value
----------------------------------------------------------------------------
data Result a
  = Success a
  | Error MisoString
  deriving (Int -> Result a -> ShowS
[Result a] -> ShowS
Result a -> String
(Int -> Result a -> ShowS)
-> (Result a -> String) -> ([Result a] -> ShowS) -> Show (Result a)
forall a. Show a => Int -> Result a -> ShowS
forall a. Show a => [Result a] -> ShowS
forall a. Show a => Result a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Result a -> ShowS
showsPrec :: Int -> Result a -> ShowS
$cshow :: forall a. Show a => Result a -> String
show :: Result a -> String
$cshowList :: forall a. Show a => [Result a] -> ShowS
showList :: [Result a] -> ShowS
Show, Result a -> Result a -> Bool
(Result a -> Result a -> Bool)
-> (Result a -> Result a -> Bool) -> Eq (Result a)
forall a. Eq a => Result a -> Result a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Result a -> Result a -> Bool
== :: Result a -> Result a -> Bool
$c/= :: forall a. Eq a => Result a -> Result a -> Bool
/= :: Result a -> Result a -> Bool
Eq)
----------------------------------------------------------------------------
instance Functor Result where
  fmap :: forall a b. (a -> b) -> Result a -> Result b
fmap a -> b
f (Success a
a) = b -> Result b
forall a. a -> Result a
Success (a -> b
f a
a)
  fmap a -> b
_ (Error MisoString
err) = MisoString -> Result b
forall a. MisoString -> Result a
Error MisoString
err
  {-# INLINE fmap #-}
----------------------------------------------------------------------------
instance Applicative Result where
  pure :: forall a. a -> Result a
pure  = a -> Result a
forall a. a -> Result a
Success
  {-# INLINE pure #-}
  <*> :: forall a b. Result (a -> b) -> Result a -> Result b
(<*>) = Result (a -> b) -> Result a -> Result b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
  {-# INLINE (<*>) #-}
----------------------------------------------------------------------------
instance Monad Result where
  return :: forall a. a -> Result a
return = a -> Result a
forall a. a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE return #-}
  Success a
a >>= :: forall a b. Result a -> (a -> Result b) -> Result b
>>= a -> Result b
k = a -> Result b
k a
a
  Error MisoString
err >>= a -> Result b
_ = MisoString -> Result b
forall a. MisoString -> Result a
Error MisoString
err
  {-# INLINE (>>=) #-}
----------------------------------------------------------------------------
instance MonadFail Result where
  fail :: forall a. String -> Result a
fail String
err = MisoString -> Result a
forall a. MisoString -> Result a
Error (MisoString -> Result a) -> MisoString -> Result a
forall a b. (a -> b) -> a -> b
$ String -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString String
err
  {-# INLINE fail #-}
----------------------------------------------------------------------------
instance Alternative Result where
  empty :: forall a. Result a
empty = Result a
forall a. Result a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  {-# INLINE empty #-}
  <|> :: forall a. Result a -> Result a -> Result a
(<|>) = Result a -> Result a -> Result a
forall a. Result a -> Result a -> Result a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
  {-# INLINE (<|>) #-}
----------------------------------------------------------------------------
instance MonadPlus Result where
  mzero :: forall a. Result a
mzero = String -> Result a
forall a. String -> Result a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"mzero"
  {-# INLINE mzero #-}
  mplus :: forall a. Result a -> Result a -> Result a
mplus a :: Result a
a@(Success a
_) Result a
_ = Result a
a
  mplus Result a
_ Result a
b             = Result a
b
  {-# INLINE mplus #-}
----------------------------------------------------------------------------
instance Semigroup (Result a) where
  <> :: Result a -> Result a -> Result a
(<>) = Result a -> Result a -> Result a
forall a. Result a -> Result a -> Result a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
  {-# INLINE (<>) #-}
----------------------------------------------------------------------------
instance Monoid (Result a) where
  mempty :: Result a
mempty  = String -> Result a
forall a. String -> Result a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"mempty"
  {-# INLINE mempty #-}
  mappend :: Result a -> Result a -> Result a
mappend = Result a -> Result a -> Result a
forall a. Semigroup a => a -> a -> a
(<>)
  {-# INLINE mappend #-}
----------------------------------------------------------------------------
instance Foldable Result where
  foldMap :: forall m a. Monoid m => (a -> m) -> Result a -> m
foldMap a -> m
_ (Error MisoString
_)   = m
forall a. Monoid a => a
mempty
  foldMap a -> m
f (Success a
y) = a -> m
f a
y
  {-# INLINE foldMap #-}
----------------------------------------------------------------------------
  foldr :: forall a b. (a -> b -> b) -> b -> Result a -> b
foldr a -> b -> b
_ b
z (Error MisoString
_)   = b
z
  foldr a -> b -> b
f b
z (Success a
y) = a -> b -> b
f a
y b
z
  {-# INLINE foldr #-}
----------------------------------------------------------------------------
instance Traversable Result where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Result a -> f (Result b)
traverse a -> f b
_ (Error MisoString
err) = Result b -> f (Result b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MisoString -> Result b
forall a. MisoString -> Result a
Error MisoString
err)
  traverse a -> f b
f (Success a
a) = b -> Result b
forall a. a -> Result a
Success (b -> Result b) -> f b -> f (Result b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
  {-# INLINE traverse #-}
----------------------------------------------------------------------------