{-# OPTIONS_GHC -fno-warn-orphans #-}

module Recalc.Server.Types where

import Data.Aeson qualified as Json

-- import Recalc.Engine (Isn't (..), Meta (..))
--
-- instance Isn't Json.Value where
--  isn't = (Json.Null ==)

data Nullable t
  = Missing
  | Null
  | Is t
  deriving (Nullable t -> Nullable t -> Bool
(Nullable t -> Nullable t -> Bool)
-> (Nullable t -> Nullable t -> Bool) -> Eq (Nullable t)
forall t. Eq t => Nullable t -> Nullable t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall t. Eq t => Nullable t -> Nullable t -> Bool
== :: Nullable t -> Nullable t -> Bool
$c/= :: forall t. Eq t => Nullable t -> Nullable t -> Bool
/= :: Nullable t -> Nullable t -> Bool
Eq, Eq (Nullable t)
Eq (Nullable t) =>
(Nullable t -> Nullable t -> Ordering)
-> (Nullable t -> Nullable t -> Bool)
-> (Nullable t -> Nullable t -> Bool)
-> (Nullable t -> Nullable t -> Bool)
-> (Nullable t -> Nullable t -> Bool)
-> (Nullable t -> Nullable t -> Nullable t)
-> (Nullable t -> Nullable t -> Nullable t)
-> Ord (Nullable t)
Nullable t -> Nullable t -> Bool
Nullable t -> Nullable t -> Ordering
Nullable t -> Nullable t -> Nullable t
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall t. Ord t => Eq (Nullable t)
forall t. Ord t => Nullable t -> Nullable t -> Bool
forall t. Ord t => Nullable t -> Nullable t -> Ordering
forall t. Ord t => Nullable t -> Nullable t -> Nullable t
$ccompare :: forall t. Ord t => Nullable t -> Nullable t -> Ordering
compare :: Nullable t -> Nullable t -> Ordering
$c< :: forall t. Ord t => Nullable t -> Nullable t -> Bool
< :: Nullable t -> Nullable t -> Bool
$c<= :: forall t. Ord t => Nullable t -> Nullable t -> Bool
<= :: Nullable t -> Nullable t -> Bool
$c> :: forall t. Ord t => Nullable t -> Nullable t -> Bool
> :: Nullable t -> Nullable t -> Bool
$c>= :: forall t. Ord t => Nullable t -> Nullable t -> Bool
>= :: Nullable t -> Nullable t -> Bool
$cmax :: forall t. Ord t => Nullable t -> Nullable t -> Nullable t
max :: Nullable t -> Nullable t -> Nullable t
$cmin :: forall t. Ord t => Nullable t -> Nullable t -> Nullable t
min :: Nullable t -> Nullable t -> Nullable t
Ord, Int -> Nullable t -> ShowS
[Nullable t] -> ShowS
Nullable t -> String
(Int -> Nullable t -> ShowS)
-> (Nullable t -> String)
-> ([Nullable t] -> ShowS)
-> Show (Nullable t)
forall t. Show t => Int -> Nullable t -> ShowS
forall t. Show t => [Nullable t] -> ShowS
forall t. Show t => Nullable t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall t. Show t => Int -> Nullable t -> ShowS
showsPrec :: Int -> Nullable t -> ShowS
$cshow :: forall t. Show t => Nullable t -> String
show :: Nullable t -> String
$cshowList :: forall t. Show t => [Nullable t] -> ShowS
showList :: [Nullable t] -> ShowS
Show)

-- instance Isn't a => Isn't (Nullable a) where
--  isn't (Is x) = isn't x
--  isn't _ = True

instance Json.FromJSON t => Json.FromJSON (Nullable t) where
  parseJSON :: Value -> Parser (Nullable t)
parseJSON Value
Json.Null = Nullable t -> Parser (Nullable t)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Nullable t
forall t. Nullable t
Null
  parseJSON Value
v = t -> Nullable t
forall t. t -> Nullable t
Is (t -> Nullable t) -> Parser t -> Parser (Nullable t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser t
forall a. FromJSON a => Value -> Parser a
Json.parseJSON Value
v

  omittedField :: Maybe (Nullable t)
omittedField = Nullable t -> Maybe (Nullable t)
forall a. a -> Maybe a
Just Nullable t
forall t. Nullable t
Missing

instance Json.ToJSON t => Json.ToJSON (Nullable t) where
  toJSON :: Nullable t -> Value
toJSON = \case
    Nullable t
Null -> Value
Json.Null
    Nullable t
Missing -> Value
Json.Null
    Is t
t -> t -> Value
forall a. ToJSON a => a -> Value
Json.toJSON t
t

  omitField :: Nullable t -> Bool
omitField = \case Nullable t
Missing -> Bool
True; Nullable t
_ -> Bool
False