-- |
--  Module      : Cfg.Parser.Value
--  Copyright   : © Jonathan Lorimer, 2023
--  License     : MIT
--  Maintainer  : jonathanlorimer@pm.me
--  Stability   : stable
--
-- @since 0.0.2.0
--
-- This module contains the generic machinery for value parsers. The main use
-- case for deriving 'Cfg.Parser.ValueParser' generically is for sum types, as
-- instances for most common types are provided in "Cfg.Parser".
module Cfg.Parser.Value where

import Cfg.Parser
import Data.Kind (Type)
import Data.Text qualified as T
import GHC.Generics
import Text.Megaparsec
import Text.Megaparsec.Char (string)

-- | This is the function that hooks into the generic machinery. It is called
-- by the deriving mechanism in "Cfg.Deriving.Value".
--
-- @since 0.0.2.0
defaultValueParser
  :: forall a
   . (Generic a, GValueParser (Rep a))
  => Parser a
defaultValueParser :: forall a. (Generic a, GValueParser (Rep a)) => Parser a
defaultValueParser = (Rep a Any -> a)
-> ParsecT Void Text Identity (Rep a Any)
-> ParsecT Void Text Identity a
forall a b.
(a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to (ParsecT Void Text Identity (Rep a Any)
 -> ParsecT Void Text Identity a)
-> ParsecT Void Text Identity (Rep a Any)
-> ParsecT Void Text Identity a
forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) p. GValueParser f => Parser (f p)
gParser @(Rep a)

-- | This is a generic version of 'Cfg.Parser.ValueParser'
--
-- @since 0.0.2.0
class GValueParser (f :: Type -> Type) where
  gParser :: Parser (f p)

-- | @since 0.0.2.0
instance GValueParser V1 where
  gParser :: forall p. Parser (V1 p)
gParser = Parser (V1 p)
forall a. HasCallStack => a
undefined

-- | @since 0.0.2.0
instance GValueParser U1 where
  gParser :: forall p. Parser (U1 p)
gParser = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"()" ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (U1 p)
-> ParsecT Void Text Identity (U1 p)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> U1 p -> ParsecT Void Text Identity (U1 p)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 p
forall k (p :: k). U1 p
U1

-- | @since 0.0.2.0
instance (ValueParser a) => GValueParser (K1 R a) where
  gParser :: forall p. Parser (K1 R a p)
gParser = a -> K1 R a p
forall k i c (p :: k). c -> K1 i c p
K1 (a -> K1 R a p)
-> ParsecT Void Text Identity a
-> ParsecT Void Text Identity (K1 R a p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ValueParser a => Parser a
parser @a

-- | @since 0.0.2.0
instance (GValueParser f) => GValueParser (M1 D s f) where
  gParser :: forall p. Parser (M1 D s f p)
gParser = f p -> M1 D s f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> M1 D s f p)
-> ParsecT Void Text Identity (f p)
-> ParsecT Void Text Identity (M1 D s f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) p. GValueParser f => Parser (f p)
gParser @f

-- | @since 0.0.2.0
instance (Constructor c) => GValueParser (M1 C c U1) where
  gParser :: forall p. Parser (M1 C c U1 p)
gParser = U1 p -> M1 C c U1 p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 U1 p
forall k (p :: k). U1 p
U1 M1 C c U1 p
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (M1 C c U1 p)
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall (c :: Meta) k1 (t :: Meta -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName @c Any c Any Any
forall a. HasCallStack => a
undefined)

-- | @since 0.0.2.0
instance (GValueParser f) => GValueParser (M1 S s f) where
  gParser :: forall p. Parser (M1 S s f p)
gParser = f p -> M1 S s f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> M1 S s f p)
-> ParsecT Void Text Identity (f p)
-> ParsecT Void Text Identity (M1 S s f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) p. GValueParser f => Parser (f p)
gParser @f

-- | This is the main instance, which distributs a value parser over a sum type
-- using retry and alternative.
--
-- @since 0.0.2.0
instance (GValueParser a, GValueParser b) => GValueParser (a :+: b) where
  gParser :: forall p. Parser ((:+:) a b p)
gParser = a p -> (:+:) a b p
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (a p -> (:+:) a b p)
-> ParsecT Void Text Identity (a p)
-> ParsecT Void Text Identity ((:+:) a b p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity (a p)
-> ParsecT Void Text Identity (a p)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity (a p)
 -> ParsecT Void Text Identity (a p))
-> ParsecT Void Text Identity (a p)
-> ParsecT Void Text Identity (a p)
forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) p. GValueParser f => Parser (f p)
gParser @a) ParsecT Void Text Identity ((:+:) a b p)
-> ParsecT Void Text Identity ((:+:) a b p)
-> ParsecT Void Text Identity ((:+:) a b p)
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> b p -> (:+:) a b p
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (b p -> (:+:) a b p)
-> ParsecT Void Text Identity (b p)
-> ParsecT Void Text Identity ((:+:) a b p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> *) p. GValueParser f => Parser (f p)
gParser @b)

-- | This is also an important instance for product types with unnamed fields
-- that are intended to be parsed as values (not nested configurations).
--
-- @since 0.0.2.0
instance (GValueParser a, GValueParser b) => GValueParser (a :*: b) where
  gParser :: forall p. Parser ((:*:) a b p)
gParser = (a p -> b p -> (:*:) a b p)
-> ParsecT Void Text Identity (a p)
-> ParsecT Void Text Identity (b p)
-> ParsecT Void Text Identity ((:*:) a b p)
forall a b c.
(a -> b -> c)
-> ParsecT Void Text Identity a
-> ParsecT Void Text Identity b
-> ParsecT Void Text Identity c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a p -> b p -> (:*:) a b p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (forall (f :: * -> *) p. GValueParser f => Parser (f p)
gParser @a) (forall (f :: * -> *) p. GValueParser f => Parser (f p)
gParser @b)