{-# LANGUAGE RankNTypes #-}
-- | Helper functions for testing your 'Decoder' and 'Encoder' functions.
--
module Waargonaut.Test
  ( roundTripSimple
  ) where

import           Data.Text               (Text)

import qualified Data.Text.Lazy          as TextL

import           Text.Parser.Char        (CharParsing)

import           Waargonaut.Encode       (Encoder)
import qualified Waargonaut.Encode       as E

import           Waargonaut.Decode       (CursorHistory, Decoder)
import qualified Waargonaut.Decode       as D
import           Waargonaut.Decode.Error (DecodeError)

-- | Test a 'Encoder' and 'Decoder' pair are able to maintain the "round trip"
-- property. That is, if you encode a given value, and then decode it, you should
-- have the exact same value that you started with.
roundTripSimple
  :: ( Eq b
     , Monad f
     , CharParsing f
     , Monad g
     , Show e
     )
  => (forall a. f a -> Text -> Either e a)
  -> Encoder g b
  -> Decoder g b
  -> b
  -> g (Either (DecodeError, CursorHistory) Bool)
roundTripSimple :: (forall a. f a -> Text -> Either e a)
-> Encoder g b
-> Decoder g b
-> b
-> g (Either (DecodeError, CursorHistory) Bool)
roundTripSimple forall a. f a -> Text -> Either e a
f Encoder g b
e Decoder g b
d b
a = do
  Text
encodedA <- Encoder g b -> b -> g Text
forall (f :: * -> *) a. Applicative f => Encoder f a -> a -> f Text
E.simpleEncodeTextNoSpaces Encoder g b
e b
a
  (b -> Bool)
-> Either (DecodeError, CursorHistory) b
-> Either (DecodeError, CursorHistory) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
a) (Either (DecodeError, CursorHistory) b
 -> Either (DecodeError, CursorHistory) Bool)
-> g (Either (DecodeError, CursorHistory) b)
-> g (Either (DecodeError, CursorHistory) Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. f a -> Text -> Either e a)
-> Decoder g b -> Text -> g (Either (DecodeError, CursorHistory) b)
forall (f :: * -> *) (g :: * -> *) e x.
(CharParsing f, Monad f, Monad g, Show e) =>
(forall a. f a -> Text -> Either e a)
-> Decoder g x -> Text -> g (Either (DecodeError, CursorHistory) x)
D.decodeFromText forall a. f a -> Text -> Either e a
f Decoder g b
d (Text -> Text
TextL.toStrict Text
encodedA)