module Hpgsql.Encoding.RowDecoderMonadic
  ( RowDecoderMonadic (..), -- TODO: Can we export ctor?
    ConversionState (..),
    toMonadicRowDecoder,
  )
where

import Data.Bifunctor (first)
import qualified Data.List as List
import Hpgsql.Encoding (FieldInfo, RowDecoder (..))
import qualified Hpgsql.SimpleParser as Parser

-- | Unlike @Hpgsql.Encoding.RowDecoder@, this has a @Monad@ instance.
-- You should prefer to use @Hpgsql.Encoding.RowDecoder@ (through @FromPgRow@ instances)
-- instead of this, and use this only if your row decoder is complex enough that
-- decoded fields can change the behaviour of other decoded fields.
-- The regular @RowDecoder@ can even type-check queries that return no results, while
-- this can't.
-- Look for the 'query' and 'pipeline' functions with an 'M' in them for ways to query
-- with this kind of row decoder.
newtype RowDecoderMonadic a = RowDecoderMonadic
  { -- | Returns the parsed row and the number of columns parsed
    forall a. RowDecoderMonadic a -> ConversionState -> Parser (a, Int)
fullRowDecoder :: ConversionState -> Parser.Parser (a, Int)
  }

newtype ConversionState = ConversionState
  { ConversionState -> [FieldInfo]
colsLeftToParse :: [FieldInfo]
  }

instance Functor RowDecoderMonadic where
  fmap :: forall a b. (a -> b) -> RowDecoderMonadic a -> RowDecoderMonadic b
fmap a -> b
f (RowDecoderMonadic {ConversionState -> Parser (a, Int)
fullRowDecoder :: forall a. RowDecoderMonadic a -> ConversionState -> Parser (a, Int)
fullRowDecoder :: ConversionState -> Parser (a, Int)
fullRowDecoder}) = (ConversionState -> Parser (b, Int)) -> RowDecoderMonadic b
forall a.
(ConversionState -> Parser (a, Int)) -> RowDecoderMonadic a
RowDecoderMonadic ((ConversionState -> Parser (b, Int)) -> RowDecoderMonadic b)
-> (ConversionState -> Parser (b, Int)) -> RowDecoderMonadic b
forall a b. (a -> b) -> a -> b
$ \ConversionState
cs -> ((a, Int) -> (b, Int)) -> Parser (a, Int) -> Parser (b, Int)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (a, Int) -> (b, Int)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> b
f) (ConversionState -> Parser (a, Int)
fullRowDecoder ConversionState
cs)

instance Applicative RowDecoderMonadic where
  pure :: forall a. a -> RowDecoderMonadic a
pure a
v = (ConversionState -> Parser (a, Int)) -> RowDecoderMonadic a
forall a.
(ConversionState -> Parser (a, Int)) -> RowDecoderMonadic a
RowDecoderMonadic ((ConversionState -> Parser (a, Int)) -> RowDecoderMonadic a)
-> (ConversionState -> Parser (a, Int)) -> RowDecoderMonadic a
forall a b. (a -> b) -> a -> b
$ \ConversionState
_cs -> (a, Int) -> Parser (a, Int)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
v, Int
0)
  RowDecoderMonadic {fullRowDecoder :: forall a. RowDecoderMonadic a -> ConversionState -> Parser (a, Int)
fullRowDecoder = ConversionState -> Parser (a -> b, Int)
rpF} <*> :: forall a b.
RowDecoderMonadic (a -> b)
-> RowDecoderMonadic a -> RowDecoderMonadic b
<*> RowDecoderMonadic {fullRowDecoder :: forall a. RowDecoderMonadic a -> ConversionState -> Parser (a, Int)
fullRowDecoder = ConversionState -> Parser (a, Int)
rpV} = (ConversionState -> Parser (b, Int)) -> RowDecoderMonadic b
forall a.
(ConversionState -> Parser (a, Int)) -> RowDecoderMonadic a
RowDecoderMonadic ((ConversionState -> Parser (b, Int)) -> RowDecoderMonadic b)
-> (ConversionState -> Parser (b, Int)) -> RowDecoderMonadic b
forall a b. (a -> b) -> a -> b
$ \ConversionState
cs -> do
    (rowF, n1) <- ConversionState -> Parser (a -> b, Int)
rpF ConversionState
cs
    (rowV, n2) <- rpV cs {colsLeftToParse = List.drop n1 cs.colsLeftToParse}
    pure (rowF rowV, n1 + n2)

instance Monad RowDecoderMonadic where
  RowDecoderMonadic {ConversionState -> Parser (a, Int)
fullRowDecoder :: forall a. RowDecoderMonadic a -> ConversionState -> Parser (a, Int)
fullRowDecoder :: ConversionState -> Parser (a, Int)
fullRowDecoder} >>= :: forall a b.
RowDecoderMonadic a
-> (a -> RowDecoderMonadic b) -> RowDecoderMonadic b
>>= a -> RowDecoderMonadic b
f = (ConversionState -> Parser (b, Int)) -> RowDecoderMonadic b
forall a.
(ConversionState -> Parser (a, Int)) -> RowDecoderMonadic a
RowDecoderMonadic ((ConversionState -> Parser (b, Int)) -> RowDecoderMonadic b)
-> (ConversionState -> Parser (b, Int)) -> RowDecoderMonadic b
forall a b. (a -> b) -> a -> b
$ \ConversionState
cs0 -> do
    (row, numColsParsed) <- ConversionState -> Parser (a, Int)
fullRowDecoder ConversionState
cs0
    let RowDecoderMonadic {fullRowDecoder = parserOfRemainder} = f row
    parserOfRemainder cs0 {colsLeftToParse = List.drop numColsParsed cs0.colsLeftToParse}

-- | Takes an Applicative row parser (which can type-check result rows before even fetching
-- any rows from the response) and transforms it into a Monadic row parser, which has no such
-- type-checking.
toMonadicRowDecoder :: RowDecoder a -> RowDecoderMonadic a
toMonadicRowDecoder :: forall a. RowDecoder a -> RowDecoderMonadic a
toMonadicRowDecoder RowDecoder {[FieldInfo] -> Parser a
fullRowDecoder :: [FieldInfo] -> Parser a
fullRowDecoder :: forall a. RowDecoder a -> [FieldInfo] -> Parser a
fullRowDecoder, Int
numExpectedColumns :: Int
numExpectedColumns :: forall a. RowDecoder a -> Int
numExpectedColumns} = (ConversionState -> Parser (a, Int)) -> RowDecoderMonadic a
forall a.
(ConversionState -> Parser (a, Int)) -> RowDecoderMonadic a
RowDecoderMonadic ((ConversionState -> Parser (a, Int)) -> RowDecoderMonadic a)
-> (ConversionState -> Parser (a, Int)) -> RowDecoderMonadic a
forall a b. (a -> b) -> a -> b
$ \ConversionState
cs -> do
  let numActualCols :: Int
numActualCols = [FieldInfo] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ConversionState
cs.colsLeftToParse
  case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
numActualCols Int
numExpectedColumns of
    Ordering
EQ -> (,Int
numExpectedColumns) (a -> (a, Int)) -> Parser a -> Parser (a, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldInfo] -> Parser a
fullRowDecoder ConversionState
cs.colsLeftToParse
    Ordering
GT -> (,Int
numExpectedColumns) (a -> (a, Int)) -> Parser a -> Parser (a, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldInfo] -> Parser a
fullRowDecoder (Int -> [FieldInfo] -> [FieldInfo]
forall a. Int -> [a] -> [a]
List.take Int
numExpectedColumns ConversionState
cs.colsLeftToParse)
    Ordering
LT -> [Char] -> Parser (a, Int)
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser (a, Int)) -> [Char] -> Parser (a, Int)
forall a b. (a -> b) -> a -> b
$ [Char]
"More number of columns expected by the row parser than found in query results. Expected " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
numExpectedColumns [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" but got " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
numActualCols