{-# LANGUAGE AllowAmbiguousTypes #-}

{- | 'traverse' for generic data types.

TODO This is harder to conceptualize than generic 'foldMap'. No nice clean
explanation yet.

This function can provide generic support for simple parser-esque types.
-}

module Generic.Data.Function.Traverse
  ( GenericTraverse(..)
  , genericTraverseNonSum , GTraverseNonSum
  , GenericTraverseSum(..), PfxTagCfg(..)
  , genericTraverseSum,     GTraverseSum
  , eqShowPfxTagCfg
  ) where

import GHC.Generics

import Generic.Data.Rep.Assert
import Generic.Data.Function.Traverse.NonSum
import Generic.Data.Function.Traverse.Sum
import Generic.Data.Function.Traverse.Constructor

import Data.Text qualified as Text

-- | Generic 'traverse' over a term of non-sum data type @f a@.
genericTraverseNonSum
    :: forall {cd} {gf} asserts tag a
    .  ( Generic a, Rep a ~ D1 cd gf
       , GTraverseNonSum cd tag gf
       , ApplyGCAsserts asserts tag
       , Functor (GenericTraverseF tag))
    => GenericTraverseF tag a
genericTraverseNonSum :: forall {k} {cd :: Meta} {gf :: Type -> Type}
       (asserts :: [GCAssert]) (tag :: k -> Type) a.
(Generic a, Rep a ~ D1 cd gf, GTraverseNonSum cd tag gf,
 ApplyGCAsserts asserts tag, Functor (GenericTraverseF tag)) =>
GenericTraverseF tag a
genericTraverseNonSum = (D1 cd gf Any -> a
Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to (D1 cd gf Any -> a) -> (gf Any -> D1 cd gf Any) -> gf Any -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. gf Any -> D1 cd gf Any
forall k i (c :: Meta) (f :: k -> Type) (p :: k). f p -> M1 i c f p
M1) (gf Any -> a)
-> GenericTraverseF tag (gf Any) -> GenericTraverseF tag a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} {k1} (cd :: Meta) (tag :: k) (gf :: k1 -> Type)
       (p :: k1).
GTraverseNonSum cd tag gf =>
GenericTraverseF tag (gf p)
forall (cd :: Meta) (tag :: k -> Type) (gf :: Type -> Type) p.
GTraverseNonSum cd tag gf =>
GenericTraverseF tag (gf p)
gTraverseNonSum @cd @tag

-- | Generic 'traverse' over a term of sum data type @f a@.
--
-- You must provide a configuration for how to handle constructors.
genericTraverseSum
    :: forall {cd} {gf} opts asserts tag a pt
    .  ( Generic a, Rep a ~ D1 cd gf
       , GTraverseSum opts cd tag gf
       , ApplyGCAsserts asserts tag
       , GenericTraverseC tag pt, Functor (GenericTraverseF tag))
    => PfxTagCfg pt
    -> GenericTraverseF tag a
genericTraverseSum :: forall {k} {cd :: Meta} {gf :: Type -> Type} (opts :: SumOpts)
       (asserts :: [GCAssert]) (tag :: k -> Type) a pt.
(Generic a, Rep a ~ D1 cd gf, GTraverseSum opts cd tag gf,
 ApplyGCAsserts asserts tag, GenericTraverseC tag pt,
 Functor (GenericTraverseF tag)) =>
PfxTagCfg pt -> GenericTraverseF tag a
genericTraverseSum PfxTagCfg pt
ptc = (D1 cd gf Any -> a
Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to (D1 cd gf Any -> a) -> (gf Any -> D1 cd gf Any) -> gf Any -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. gf Any -> D1 cd gf Any
forall k i (c :: Meta) (f :: k -> Type) (p :: k). f p -> M1 i c f p
M1) (gf Any -> a)
-> GenericTraverseF tag (gf Any) -> GenericTraverseF tag a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} {k1} {k2} (opts :: SumOpts) (cd :: k) (tag :: k1)
       (gf :: k2 -> Type) pt (p :: k2).
(GTraverseSum opts cd tag gf, GenericTraverseC tag pt) =>
PfxTagCfg pt -> GenericTraverseF tag (gf p)
forall (opts :: SumOpts) (cd :: Meta) (tag :: k -> Type)
       (gf :: Type -> Type) pt p.
(GTraverseSum opts cd tag gf, GenericTraverseC tag pt) =>
PfxTagCfg pt -> GenericTraverseF tag (gf p)
gTraverseSum @opts @cd @tag PfxTagCfg pt
ptc

-- | Construct a prefix tag config using existing 'Eq' and 'Show' instances.
--
-- The user only needs to provide the constructor name parser.
eqShowPfxTagCfg :: (Eq a, Show a) => (String -> a) -> PfxTagCfg a
eqShowPfxTagCfg :: forall a. (Eq a, Show a) => (String -> a) -> PfxTagCfg a
eqShowPfxTagCfg String -> a
f = PfxTagCfg
    { pfxTagCfgFromCstr :: String -> a
pfxTagCfgFromCstr = String -> a
f
    , pfxTagCfgEq :: a -> a -> Bool
pfxTagCfgEq = a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
    , pfxTagCfgShow :: a -> Text
pfxTagCfgShow = String -> Text
Text.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
    }