module Gotyno.Helpers where

import Data.Aeson (FromJSON (..), ToJSON (..))
import qualified Data.Aeson as JSON
import Data.Aeson.Types (Parser)
import RIO
import qualified RIO.Text as Text

-- | Used for a more explicit style in `toJSON` instances. It also means we don't have to add type
-- annotations after the value.
newtype LiteralString = LiteralString Text
  deriving (LiteralString -> LiteralString -> Bool
(LiteralString -> LiteralString -> Bool)
-> (LiteralString -> LiteralString -> Bool) -> Eq LiteralString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LiteralString -> LiteralString -> Bool
$c/= :: LiteralString -> LiteralString -> Bool
== :: LiteralString -> LiteralString -> Bool
$c== :: LiteralString -> LiteralString -> Bool
Eq, Int -> LiteralString -> ShowS
[LiteralString] -> ShowS
LiteralString -> String
(Int -> LiteralString -> ShowS)
-> (LiteralString -> String)
-> ([LiteralString] -> ShowS)
-> Show LiteralString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LiteralString] -> ShowS
$cshowList :: [LiteralString] -> ShowS
show :: LiteralString -> String
$cshow :: LiteralString -> String
showsPrec :: Int -> LiteralString -> ShowS
$cshowsPrec :: Int -> LiteralString -> ShowS
Show, [LiteralString] -> Encoding
[LiteralString] -> Value
LiteralString -> Encoding
LiteralString -> Value
(LiteralString -> Value)
-> (LiteralString -> Encoding)
-> ([LiteralString] -> Value)
-> ([LiteralString] -> Encoding)
-> ToJSON LiteralString
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [LiteralString] -> Encoding
$ctoEncodingList :: [LiteralString] -> Encoding
toJSONList :: [LiteralString] -> Value
$ctoJSONList :: [LiteralString] -> Value
toEncoding :: LiteralString -> Encoding
$ctoEncoding :: LiteralString -> Encoding
toJSON :: LiteralString -> Value
$ctoJSON :: LiteralString -> Value
ToJSON)

-- | Used to encode `Integer` ({I,U}{64,128}) values, because there are ecosystems where these
-- cannot be decoded properly without having them come in as strings in transit.
newtype StringEncodedInteger = StringEncodedInteger Integer
  deriving (StringEncodedInteger -> StringEncodedInteger -> Bool
(StringEncodedInteger -> StringEncodedInteger -> Bool)
-> (StringEncodedInteger -> StringEncodedInteger -> Bool)
-> Eq StringEncodedInteger
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StringEncodedInteger -> StringEncodedInteger -> Bool
$c/= :: StringEncodedInteger -> StringEncodedInteger -> Bool
== :: StringEncodedInteger -> StringEncodedInteger -> Bool
$c== :: StringEncodedInteger -> StringEncodedInteger -> Bool
Eq, Int -> StringEncodedInteger -> ShowS
[StringEncodedInteger] -> ShowS
StringEncodedInteger -> String
(Int -> StringEncodedInteger -> ShowS)
-> (StringEncodedInteger -> String)
-> ([StringEncodedInteger] -> ShowS)
-> Show StringEncodedInteger
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StringEncodedInteger] -> ShowS
$cshowList :: [StringEncodedInteger] -> ShowS
show :: StringEncodedInteger -> String
$cshow :: StringEncodedInteger -> String
showsPrec :: Int -> StringEncodedInteger -> ShowS
$cshowsPrec :: Int -> StringEncodedInteger -> ShowS
Show)

instance FromJSON StringEncodedInteger where
  parseJSON :: Value -> Parser StringEncodedInteger
parseJSON = String
-> (Text -> Parser StringEncodedInteger)
-> Value
-> Parser StringEncodedInteger
forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"StringEncodedInteger" ((Text -> Parser StringEncodedInteger)
 -> Value -> Parser StringEncodedInteger)
-> (Text -> Parser StringEncodedInteger)
-> Value
-> Parser StringEncodedInteger
forall a b. (a -> b) -> a -> b
$ \Text
text ->
    case Text
text Text -> (Text -> String) -> String
forall a b. a -> (a -> b) -> b
& Text -> String
Text.unpack String -> (String -> Maybe Integer) -> Maybe Integer
forall a b. a -> (a -> b) -> b
& String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe of
      Just Integer
i -> StringEncodedInteger -> Parser StringEncodedInteger
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StringEncodedInteger -> Parser StringEncodedInteger)
-> StringEncodedInteger -> Parser StringEncodedInteger
forall a b. (a -> b) -> a -> b
$ Integer -> StringEncodedInteger
StringEncodedInteger Integer
i
      Maybe Integer
Nothing -> String -> Parser StringEncodedInteger
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser StringEncodedInteger)
-> String -> Parser StringEncodedInteger
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"Expected value readable as bigint, got: ", Text -> String
forall a. Show a => a -> String
show Text
text]

instance ToJSON StringEncodedInteger where
  toJSON :: StringEncodedInteger -> Value
toJSON (StringEncodedInteger Integer
i) = Text -> Value
JSON.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> Text
forall a. Show a => a -> Text
tshow Integer
i

-- | Checks that a value matches an expectation, used to check literals.
checkEqualTo :: (Eq a, Show a) => a -> a -> Parser a
checkEqualTo :: a -> a -> Parser a
checkEqualTo a
expected a
actual
  | a
expected a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
actual = a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
actual
  | Bool
otherwise = String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ String
"Expected: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
expected String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" but got: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
actual