{-# LANGUAGE RankNTypes #-}
-- |
--
-- Functions to execution of 'Waargonaut.Decode.Decoder's
--
module Waargonaut.Decode.Runners
  (
    -- * General over @f@
    decodeWithInput
  , decodeFromString
  , decodeFromText
  , decodeFromByteString

    -- * Identity
  , pureDecodeWithInput
  , pureDecodeFromText
  , pureDecodeFromByteString
  , pureDecodeFromString

    -- * Helpers
  , overrideParser
  , parseWith

  ) where

import           Prelude                    (Show, String, show)

import           Control.Category           (id, (.))
import           Control.Monad              (Monad (..))

import           Control.Monad.Reader       (local)

import           Data.Bifunctor             (first)
import           Data.Either                (Either (..))
import           Data.Function              (const)
import           Data.Functor.Identity      (Identity, runIdentity)

import           Data.Text                  (Text)
import qualified Data.Text                  as Text
import qualified Data.Text.Encoding         as Text

import           Text.Parser.Char           (CharParsing)

import           Data.ByteString            (ByteString)

import           Waargonaut.Decode.Error    (DecodeError (..))
import           Waargonaut.Types

import qualified Waargonaut.Decode.Internal as DI

import           Waargonaut.Decode.Types    (CursorHistory, DecodeResult (..),
                                             Decoder (..), mkCursor)

-- | General decoding function that takes a given parsing function and some
-- functions to handle the transition from the input of the 'Waargonaut.Decoder.Types.JCurs' to the
-- desired input type. The indexer and cursor requires a 'ByteString' to work
-- efficiently, but this does not preclude the use of other text types, provided
-- the right functions are present.
--
-- There are some specialised versions of this function provided for 'Text',
-- 'String', and 'ByteString'. They are implemented using this function, for
-- example to work with 'Text' input and the @attoparsec@ package:
--
-- @
-- import qualified Data.Attoparsec.Text as AT
-- import qualified Data.Text as Text
--
-- textDecode :: Monad g => Decoder g x -> Text -> g (Either (DecodeError, CursorHistory) x)
-- textDecode = decodeWithInput AT.parseOnly Text.decodeUtf8 Text.encodeUtf8
-- @
--
decodeWithInput
  :: ( CharParsing f
     , Show e
     , Monad g
     , Monad f
     )
  => (forall a. f a -> i -> Either e a)
  -> (ByteString -> i)
  -> (i -> ByteString)
  -> Decoder g x
  -> i
  -> g (Either (DecodeError, CursorHistory) x)
decodeWithInput :: (forall a. f a -> i -> Either e a)
-> (ByteString -> i)
-> (i -> ByteString)
-> Decoder g x
-> i
-> g (Either (DecodeError, CursorHistory) x)
decodeWithInput forall a. f a -> i -> Either e a
parserFn ByteString -> i
toI i -> ByteString
fromI Decoder g x
decode = DecodeResultT Count DecodeError g x
-> g (Either (DecodeError, CursorHistory) x)
forall (f :: * -> *) i a.
Monad f =>
DecodeResultT i DecodeError f a
-> f (Either (DecodeError, CursorHistory' i) a)
DI.runDecoderResultT
  (DecodeResultT Count DecodeError g x
 -> g (Either (DecodeError, CursorHistory) x))
-> (i -> DecodeResultT Count DecodeError g x)
-> i
-> g (Either (DecodeError, CursorHistory) x)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Decoder g x
-> ParseFn -> JCurs -> DecodeResultT Count DecodeError g x
forall (f :: * -> *) a.
Decoder f a
-> ParseFn -> JCurs -> DecodeResultT Count DecodeError f a
runDecoder Decoder g x
decode ((f Json -> i -> Either e Json)
-> f Json -> i -> Either DecodeError Json
forall (f :: * -> *) e a i.
(CharParsing f, Show e) =>
(f a -> i -> Either e a) -> f a -> i -> Either DecodeError a
parseWith f Json -> i -> Either e Json
forall a. f a -> i -> Either e a
parserFn f Json
forall (f :: * -> *). (Monad f, CharParsing f) => f Json
parseWaargonaut (i -> Either DecodeError Json) -> (ByteString -> i) -> ParseFn
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> i
toI)
  (JCurs -> DecodeResultT Count DecodeError g x)
-> (i -> JCurs) -> i -> DecodeResultT Count DecodeError g x
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> JCurs
mkCursor
  (ByteString -> JCurs) -> (i -> ByteString) -> i -> JCurs
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. i -> ByteString
fromI

-- | As per the 'decodeWithInput' function, but with the input type specialised
-- to 'String'.
--
-- This function goes via 'Data.Text.Text' to ensure the UTF-8 is handled as
-- best as we can.
--
decodeFromString
  :: ( CharParsing f
     , Monad f
     , Monad g
     , Show e
     )
  => (forall a. f a -> String -> Either e a)
  -> Decoder g x
  -> String
  -> g (Either (DecodeError, CursorHistory) x)
decodeFromString :: (forall a. f a -> String -> Either e a)
-> Decoder g x
-> String
-> g (Either (DecodeError, CursorHistory) x)
decodeFromString forall a. f a -> String -> Either e a
parseFn = (forall a. f a -> String -> Either e a)
-> (ByteString -> String)
-> (String -> ByteString)
-> Decoder g x
-> String
-> g (Either (DecodeError, CursorHistory) x)
forall (f :: * -> *) e (g :: * -> *) i x.
(CharParsing f, Show e, Monad g, Monad f) =>
(forall a. f a -> i -> Either e a)
-> (ByteString -> i)
-> (i -> ByteString)
-> Decoder g x
-> i
-> g (Either (DecodeError, CursorHistory) x)
decodeWithInput forall a. f a -> String -> Either e a
parseFn
  (Text -> String
Text.unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Text
Text.decodeUtf8)
  (Text -> ByteString
Text.encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
Text.pack)

-- | As per 'decodeWithInput' function but specialised to the 'ByteString' input type.
decodeFromByteString
  :: ( CharParsing f
     , Monad f
     , Monad g
     , Show e
     )
  => (forall a. f a -> ByteString -> Either e a)
  -> Decoder g x
  -> ByteString
  -> g (Either (DecodeError, CursorHistory) x)
decodeFromByteString :: (forall a. f a -> ByteString -> Either e a)
-> Decoder g x
-> ByteString
-> g (Either (DecodeError, CursorHistory) x)
decodeFromByteString forall a. f a -> ByteString -> Either e a
parseFn =
  (forall a. f a -> ByteString -> Either e a)
-> (ByteString -> ByteString)
-> (ByteString -> ByteString)
-> Decoder g x
-> ByteString
-> g (Either (DecodeError, CursorHistory) x)
forall (f :: * -> *) e (g :: * -> *) i x.
(CharParsing f, Show e, Monad g, Monad f) =>
(forall a. f a -> i -> Either e a)
-> (ByteString -> i)
-> (i -> ByteString)
-> Decoder g x
-> i
-> g (Either (DecodeError, CursorHistory) x)
decodeWithInput forall a. f a -> ByteString -> Either e a
parseFn ByteString -> ByteString
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id ByteString -> ByteString
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

-- | As per 'decodeWithInput' function but specialised to the 'Text' input type.
--
-- An example:
--
-- @
-- textDecode :: Decoder f a -> f (Either (DecodeError, CursorHistory) a)
-- textDecode = decodeFromText AT.parseOnly
-- @
--
decodeFromText
  :: ( 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)
decodeFromText :: (forall a. f a -> Text -> Either e a)
-> Decoder g x -> Text -> g (Either (DecodeError, CursorHistory) x)
decodeFromText forall a. f a -> Text -> Either e a
parseFn =
  (forall a. f a -> Text -> Either e a)
-> (ByteString -> Text)
-> (Text -> ByteString)
-> Decoder g x
-> Text
-> g (Either (DecodeError, CursorHistory) x)
forall (f :: * -> *) e (g :: * -> *) i x.
(CharParsing f, Show e, Monad g, Monad f) =>
(forall a. f a -> i -> Either e a)
-> (ByteString -> i)
-> (i -> ByteString)
-> Decoder g x
-> i
-> g (Either (DecodeError, CursorHistory) x)
decodeWithInput forall a. f a -> Text -> Either e a
parseFn ByteString -> Text
Text.decodeUtf8 Text -> ByteString
Text.encodeUtf8

-- | This function works using one of the 'decodeFrom*' functions and provides a
-- pure decoder that demands the 'Decoder' but specialised to 'Identity'.
-- 'Decoder's are often to be general in their @g@ type so most are fine to use
-- this function. It is offered as a convenience and can be used like so:
--
-- @
-- import qualified Data.Attoparsec.Text as AT
-- import qualified Data.Text as Text
--
-- pureTextDecode :: Decoder Identity x -> Text -> Either (DecodeError, CursorHistory) x
-- pureTextDecode = pureDecodeWithInput decodeWithText AT.parseOnly
-- @
--
pureDecodeWithInput
  :: ( Monad f
     , CharParsing f
     , Show e
     )
  => ( forall g. Monad g
       => (forall a. f a -> i -> Either e a)
       -> Decoder g x
       -> i
       -> g (Either (DecodeError, CursorHistory) x)
     )
  -> (forall a. f a -> i -> Either e a)
  -> Decoder Identity x
  -> i
  -> Either (DecodeError, CursorHistory) x
pureDecodeWithInput :: (forall (g :: * -> *).
 Monad g =>
 (forall a. f a -> i -> Either e a)
 -> Decoder g x -> i -> g (Either (DecodeError, CursorHistory) x))
-> (forall a. f a -> i -> Either e a)
-> Decoder Identity x
-> i
-> Either (DecodeError, CursorHistory) x
pureDecodeWithInput forall (g :: * -> *).
Monad g =>
(forall a. f a -> i -> Either e a)
-> Decoder g x -> i -> g (Either (DecodeError, CursorHistory) x)
decodeRunner forall a. f a -> i -> Either e a
parseFn Decoder Identity x
decoder =
  Identity (Either (DecodeError, CursorHistory) x)
-> Either (DecodeError, CursorHistory) x
forall a. Identity a -> a
runIdentity (Identity (Either (DecodeError, CursorHistory) x)
 -> Either (DecodeError, CursorHistory) x)
-> (i -> Identity (Either (DecodeError, CursorHistory) x))
-> i
-> Either (DecodeError, CursorHistory) x
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (forall a. f a -> i -> Either e a)
-> Decoder Identity x
-> i
-> Identity (Either (DecodeError, CursorHistory) x)
forall (g :: * -> *).
Monad g =>
(forall a. f a -> i -> Either e a)
-> Decoder g x -> i -> g (Either (DecodeError, CursorHistory) x)
decodeRunner forall a. f a -> i -> Either e a
parseFn Decoder Identity x
decoder

-- | As per 'pureDecodeWithInput' but specialised to 'Data.Text.Text'.
pureDecodeFromText
  :: ( Monad f
     , CharParsing f
     , Show e
     )
  => (forall a. f a -> Text -> Either e a)
  -> Decoder Identity x
  -> Text
  -> Either (DecodeError, CursorHistory) x
pureDecodeFromText :: (forall a. f a -> Text -> Either e a)
-> Decoder Identity x
-> Text
-> Either (DecodeError, CursorHistory) x
pureDecodeFromText =
  (forall (g :: * -> *).
 Monad g =>
 (forall a. f a -> Text -> Either e a)
 -> Decoder g x
 -> Text
 -> g (Either (DecodeError, CursorHistory) x))
-> (forall a. f a -> Text -> Either e a)
-> Decoder Identity x
-> Text
-> Either (DecodeError, CursorHistory) x
forall (f :: * -> *) e i x.
(Monad f, CharParsing f, Show e) =>
(forall (g :: * -> *).
 Monad g =>
 (forall a. f a -> i -> Either e a)
 -> Decoder g x -> i -> g (Either (DecodeError, CursorHistory) x))
-> (forall a. f a -> i -> Either e a)
-> Decoder Identity x
-> i
-> Either (DecodeError, CursorHistory) x
pureDecodeWithInput forall (g :: * -> *).
Monad g =>
(forall a. f a -> Text -> Either e a)
-> Decoder g x -> Text -> g (Either (DecodeError, CursorHistory) x)
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)
decodeFromText

-- | As per 'pureDecodeWithInput' but specialised to 'Data.ByteString.ByteString'.
pureDecodeFromByteString
  :: ( Monad f
     , CharParsing f
     , Show e
     )
  => (forall a. f a -> ByteString -> Either e a)
  -> Decoder Identity x
  -> ByteString
  -> Either (DecodeError, CursorHistory) x
pureDecodeFromByteString :: (forall a. f a -> ByteString -> Either e a)
-> Decoder Identity x
-> ByteString
-> Either (DecodeError, CursorHistory) x
pureDecodeFromByteString =
  (forall (g :: * -> *).
 Monad g =>
 (forall a. f a -> ByteString -> Either e a)
 -> Decoder g x
 -> ByteString
 -> g (Either (DecodeError, CursorHistory) x))
-> (forall a. f a -> ByteString -> Either e a)
-> Decoder Identity x
-> ByteString
-> Either (DecodeError, CursorHistory) x
forall (f :: * -> *) e i x.
(Monad f, CharParsing f, Show e) =>
(forall (g :: * -> *).
 Monad g =>
 (forall a. f a -> i -> Either e a)
 -> Decoder g x -> i -> g (Either (DecodeError, CursorHistory) x))
-> (forall a. f a -> i -> Either e a)
-> Decoder Identity x
-> i
-> Either (DecodeError, CursorHistory) x
pureDecodeWithInput forall (g :: * -> *).
Monad g =>
(forall a. f a -> ByteString -> Either e a)
-> Decoder g x
-> ByteString
-> g (Either (DecodeError, CursorHistory) x)
forall (f :: * -> *) (g :: * -> *) e x.
(CharParsing f, Monad f, Monad g, Show e) =>
(forall a. f a -> ByteString -> Either e a)
-> Decoder g x
-> ByteString
-> g (Either (DecodeError, CursorHistory) x)
decodeFromByteString

-- | As per 'pureDecodeWithInput' but specialised to 'Data.String.String'.
--
pureDecodeFromString
  :: ( Monad f
     , CharParsing f
     , Show e
     )
  => (forall a. f a -> String -> Either e a)
  -> Decoder Identity x
  -> String
  -> Either (DecodeError, CursorHistory) x
pureDecodeFromString :: (forall a. f a -> String -> Either e a)
-> Decoder Identity x
-> String
-> Either (DecodeError, CursorHistory) x
pureDecodeFromString =
  (forall (g :: * -> *).
 Monad g =>
 (forall a. f a -> String -> Either e a)
 -> Decoder g x
 -> String
 -> g (Either (DecodeError, CursorHistory) x))
-> (forall a. f a -> String -> Either e a)
-> Decoder Identity x
-> String
-> Either (DecodeError, CursorHistory) x
forall (f :: * -> *) e i x.
(Monad f, CharParsing f, Show e) =>
(forall (g :: * -> *).
 Monad g =>
 (forall a. f a -> i -> Either e a)
 -> Decoder g x -> i -> g (Either (DecodeError, CursorHistory) x))
-> (forall a. f a -> i -> Either e a)
-> Decoder Identity x
-> i
-> Either (DecodeError, CursorHistory) x
pureDecodeWithInput forall (g :: * -> *).
Monad g =>
(forall a. f a -> String -> Either e a)
-> Decoder g x
-> String
-> g (Either (DecodeError, CursorHistory) x)
forall (f :: * -> *) (g :: * -> *) e x.
(CharParsing f, Monad f, Monad g, Show e) =>
(forall a. f a -> String -> Either e a)
-> Decoder g x
-> String
-> g (Either (DecodeError, CursorHistory) x)
decodeFromString

-- | Helper function to handle wrapping up a parse failure using the given
-- parsing function. Intended to be used with the 'Waargonaut.Decode.runDecode' or 'Waargonaut.Decode.Traversal.simpleDecode'
-- functions.
--
-- @
-- import Data.Attoparsec.ByteString (parseOnly)
--
-- simpleDecode (list int) (parseWith (parseOnly parseWaargonaut)) "[1,1,2]"
-- @
--
parseWith
  :: ( CharParsing f
     , Show e
     )
  => (f a -> i -> Either e a)
  -> f a
  -> i
  -> Either DecodeError a
parseWith :: (f a -> i -> Either e a) -> f a -> i -> Either DecodeError a
parseWith f a -> i -> Either e a
f f a
p =
  (e -> DecodeError) -> Either e a -> Either DecodeError a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> DecodeError
ParseFailed (Text -> DecodeError) -> (e -> Text) -> e -> DecodeError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
Text.pack (String -> Text) -> (e -> String) -> e -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. e -> String
forall a. Show a => a -> String
show) (Either e a -> Either DecodeError a)
-> (i -> Either e a) -> i -> Either DecodeError a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f a -> i -> Either e a
f f a
p

-- | This function lets you override the parsing function that is being used in
-- a decoder for a different one. This means that when building your 'Decoder' you
-- are not bound to only using a single parsing function. If you have specific
-- needs for alternate parsers then you can use this function in your 'Decoder' to
-- make that change.
--
-- Similar to the other decoding functions, this operation allows you to specify
-- your own parsing function and if necessary a 'ByteString -> i' conversion.
--
-- @
--
-- parseUsingByteString :: (Show e, CharParsing f, Monad f) => f a -> ByteString -> Either e a
-- parseUsingByteString = ...
--
-- myTricksyObj = withCursor $ \curs -> do
--   curs' <- down curs
--   fA <- fromKey "normalFieldA" int curs'
--   fB <- fromKey "normalFieldB" text curs'
--   wB <- overrideParser parseUsingByteString id handTunedParser $ fromKey "weirdFieldC" fieldCDecoder curs'
--   pure $ Foo fA fB wB
-- @
--
overrideParser
  :: ( CharParsing g
     , Monad g
     , Monad f
     , Show e
     )
  => (forall x. g x -> i -> Either e x)
  -> (ByteString -> i)
  -> g Json
  -> DecodeResult f a
  -> DecodeResult f a
overrideParser :: (forall x. g x -> i -> Either e x)
-> (ByteString -> i)
-> g Json
-> DecodeResult f a
-> DecodeResult f a
overrideParser forall x. g x -> i -> Either e x
newParseFn ByteString -> i
floop g Json
parser =
  (ParseFn -> ParseFn) -> DecodeResult f a -> DecodeResult f a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (ParseFn -> ParseFn -> ParseFn
forall a b. a -> b -> a
const ((g Json -> i -> Either e Json)
-> g Json -> i -> Either DecodeError Json
forall (f :: * -> *) e a i.
(CharParsing f, Show e) =>
(f a -> i -> Either e a) -> f a -> i -> Either DecodeError a
parseWith g Json -> i -> Either e Json
forall x. g x -> i -> Either e x
newParseFn g Json
parser (i -> Either DecodeError Json) -> (ByteString -> i) -> ParseFn
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> i
floop))