{-# OPTIONS_GHC -fno-warn-unused-imports #-}

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DerivingStrategies, DeriveFunctor, DerivingVia, StandaloneDeriving #-}

module DSV.ZipViewType
  ( ZipView (..), refineZipView
  , overHeaderError, overRowError, overZipViewError
  ) where

import DSV.ByteString
import DSV.Prelude
import DSV.Validation
import DSV.ViewType
import DSV.Vector

-- base
import Data.Functor.Compose (Compose (Compose))

{- |

'ZipView' captures a common pattern for consuming a DSV file with a header row: First we have one 'View' that looks at the header row, and from that we determine how to view the subsequent rows of data. We use that second 'View' to interpret each row.

For example, if we want to read the \"Date" and \"Price" columns, when we read the header we may see that these are the first and third columns, respectively; and so the first 'View' will return a 'View' that reads the first and third column of each row.

=== Errors

There are two distinct modes of failure in this process, represented by the two type parameters @headerError@ and @rowError@.

- A 'Failure' of the @headerError@ type is produced by the first 'View' if the header is malformed in a way that prevents us from being able to read the data rows - for example, if we want to read the \"Date" column but the header does not contain any entry with that name.

- A 'Failure' of the @rowError@ type is produced by the second 'View' for each malformed row - for example, if \"Price" is the third column but the row only contains two entries, or if we require the entry to contain a dollar amount but it contains some other unrecognizable string.

Note that header errors which are unrecoverable, whereas it is possible to continue past row errors and get a mixture of 'Failure' and 'Success' results among the rows.

-}

newtype ZipView headerError rowError a =
  ZipView
    (View headerError (Vector ByteString)
      (View rowError (Vector ByteString) a))
  deriving stock a
-> ZipView headerError rowError b -> ZipView headerError rowError a
(a -> b)
-> ZipView headerError rowError a -> ZipView headerError rowError b
(forall a b.
 (a -> b)
 -> ZipView headerError rowError a
 -> ZipView headerError rowError b)
-> (forall a b.
    a
    -> ZipView headerError rowError b
    -> ZipView headerError rowError a)
-> Functor (ZipView headerError rowError)
forall a b.
a
-> ZipView headerError rowError b -> ZipView headerError rowError a
forall a b.
(a -> b)
-> ZipView headerError rowError a -> ZipView headerError rowError b
forall headerError rowError a b.
a
-> ZipView headerError rowError b -> ZipView headerError rowError a
forall headerError rowError a b.
(a -> b)
-> ZipView headerError rowError a -> ZipView headerError rowError b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a
-> ZipView headerError rowError b -> ZipView headerError rowError a
$c<$ :: forall headerError rowError a b.
a
-> ZipView headerError rowError b -> ZipView headerError rowError a
fmap :: (a -> b)
-> ZipView headerError rowError a -> ZipView headerError rowError b
$cfmap :: forall headerError rowError a b.
(a -> b)
-> ZipView headerError rowError a -> ZipView headerError rowError b
Functor

-- | 'ZipView' has an 'Applicative' but no 'Monad', so you may wish to enable the @ApplicativeDo@ GHC extension.

deriving via
  Compose
    (View headerError (Vector ByteString))
    (View rowError (Vector ByteString))
  instance
    (Semigroup headerError, Semigroup rowError) =>
    Applicative (ZipView headerError rowError)

refineZipView ::
    forall headerError rowError a b .
    ZipView headerError rowError a
      -- ^ A view that produces a value of type @a@ for each row.
    -> View rowError a b
      -- ^ A way to interpret that @a@ value as a different type @b@.
    -> ZipView headerError rowError b
      -- ^ A view that produces a value of type @b@ for each row.

refineZipView :: ZipView headerError rowError a
-> View rowError a b -> ZipView headerError rowError b
refineZipView (ZipView (View Vector ByteString
-> Validation headerError (View rowError (Vector ByteString) a)
f)) View rowError a b
r2 =
  View
  headerError
  (Vector ByteString)
  (View rowError (Vector ByteString) b)
-> ZipView headerError rowError b
forall headerError rowError a.
View
  headerError
  (Vector ByteString)
  (View rowError (Vector ByteString) a)
-> ZipView headerError rowError a
ZipView (View
   headerError
   (Vector ByteString)
   (View rowError (Vector ByteString) b)
 -> ZipView headerError rowError b)
-> View
     headerError
     (Vector ByteString)
     (View rowError (Vector ByteString) b)
-> ZipView headerError rowError b
forall a b. (a -> b) -> a -> b
$
    (Vector ByteString
 -> Validation headerError (View rowError (Vector ByteString) b))
-> View
     headerError
     (Vector ByteString)
     (View rowError (Vector ByteString) b)
forall e a b. (a -> Validation e b) -> View e a b
View ((Vector ByteString
  -> Validation headerError (View rowError (Vector ByteString) b))
 -> View
      headerError
      (Vector ByteString)
      (View rowError (Vector ByteString) b))
-> (Vector ByteString
    -> Validation headerError (View rowError (Vector ByteString) b))
-> View
     headerError
     (Vector ByteString)
     (View rowError (Vector ByteString) b)
forall a b. (a -> b) -> a -> b
$
      (View rowError (Vector ByteString) a
 -> View rowError (Vector ByteString) b)
-> Validation headerError (View rowError (Vector ByteString) a)
-> Validation headerError (View rowError (Vector ByteString) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (View rowError a b
r2 View rowError a b
-> View rowError (Vector ByteString) a
-> View rowError (Vector ByteString) b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.) (Validation headerError (View rowError (Vector ByteString) a)
 -> Validation headerError (View rowError (Vector ByteString) b))
-> (Vector ByteString
    -> Validation headerError (View rowError (Vector ByteString) a))
-> Vector ByteString
-> Validation headerError (View rowError (Vector ByteString) b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Vector ByteString
-> Validation headerError (View rowError (Vector ByteString) a)
f

overHeaderError ::
    (headerError1 -> headerError2) ->
    ZipView headerError1 rowError a ->
    ZipView headerError2 rowError a

overHeaderError :: (headerError1 -> headerError2)
-> ZipView headerError1 rowError a
-> ZipView headerError2 rowError a
overHeaderError headerError1 -> headerError2
f (ZipView View
  headerError1
  (Vector ByteString)
  (View rowError (Vector ByteString) a)
v) =
    View
  headerError2
  (Vector ByteString)
  (View rowError (Vector ByteString) a)
-> ZipView headerError2 rowError a
forall headerError rowError a.
View
  headerError
  (Vector ByteString)
  (View rowError (Vector ByteString) a)
-> ZipView headerError rowError a
ZipView ((headerError1 -> headerError2)
-> View
     headerError1
     (Vector ByteString)
     (View rowError (Vector ByteString) a)
-> View
     headerError2
     (Vector ByteString)
     (View rowError (Vector ByteString) a)
forall e1 e2 a b. (e1 -> e2) -> View e1 a b -> View e2 a b
overViewError headerError1 -> headerError2
f View
  headerError1
  (Vector ByteString)
  (View rowError (Vector ByteString) a)
v)

overRowError ::
    (rowError1 -> rowError2) ->
    ZipView headerError rowError1 a ->
    ZipView headerError rowError2 a

overRowError :: (rowError1 -> rowError2)
-> ZipView headerError rowError1 a
-> ZipView headerError rowError2 a
overRowError rowError1 -> rowError2
f (ZipView View
  headerError
  (Vector ByteString)
  (View rowError1 (Vector ByteString) a)
v) =
    View
  headerError
  (Vector ByteString)
  (View rowError2 (Vector ByteString) a)
-> ZipView headerError rowError2 a
forall headerError rowError a.
View
  headerError
  (Vector ByteString)
  (View rowError (Vector ByteString) a)
-> ZipView headerError rowError a
ZipView ((View rowError1 (Vector ByteString) a
 -> View rowError2 (Vector ByteString) a)
-> View
     headerError
     (Vector ByteString)
     (View rowError1 (Vector ByteString) a)
-> View
     headerError
     (Vector ByteString)
     (View rowError2 (Vector ByteString) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((rowError1 -> rowError2)
-> View rowError1 (Vector ByteString) a
-> View rowError2 (Vector ByteString) a
forall e1 e2 a b. (e1 -> e2) -> View e1 a b -> View e2 a b
overViewError rowError1 -> rowError2
f) View
  headerError
  (Vector ByteString)
  (View rowError1 (Vector ByteString) a)
v)

overZipViewError ::
    forall headerError1 headerError2 rowError1 rowError2 a .
    (headerError1 -> headerError2) -> (rowError1 -> rowError2)
    -> ZipView headerError1 rowError1 a
    -> ZipView headerError2 rowError2 a

overZipViewError :: (headerError1 -> headerError2)
-> (rowError1 -> rowError2)
-> ZipView headerError1 rowError1 a
-> ZipView headerError2 rowError2 a
overZipViewError headerError1 -> headerError2
f rowError1 -> rowError2
g =
    (rowError1 -> rowError2)
-> ZipView headerError2 rowError1 a
-> ZipView headerError2 rowError2 a
forall rowError1 rowError2 headerError a.
(rowError1 -> rowError2)
-> ZipView headerError rowError1 a
-> ZipView headerError rowError2 a
overRowError rowError1 -> rowError2
g (ZipView headerError2 rowError1 a
 -> ZipView headerError2 rowError2 a)
-> (ZipView headerError1 rowError1 a
    -> ZipView headerError2 rowError1 a)
-> ZipView headerError1 rowError1 a
-> ZipView headerError2 rowError2 a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
    (headerError1 -> headerError2)
-> ZipView headerError1 rowError1 a
-> ZipView headerError2 rowError1 a
forall headerError1 headerError2 rowError a.
(headerError1 -> headerError2)
-> ZipView headerError1 rowError a
-> ZipView headerError2 rowError a
overHeaderError headerError1 -> headerError2
f