-- |
--  Module      : Cfg.Deriving.Value
--  Copyright   : © Jonathan Lorimer, 2023
--  License     : MIT
--  Maintainer  : jonathanlorimer@pm.me
--  Stability   : stable
--
-- @since 0.0.2.0
--
-- This module provides a type 'Value' for generating instances for \"leaf\"
-- elements of your configuration tree. These are the elements you actually
-- care about and want to parse out of a configuration source.
module Cfg.Deriving.Value where

import Cfg.Parser
import Cfg.Parser.Value
import Data.Coerce
import GHC.Generics

-- | This newtype is used to derive 'ValueParser' instances for your types
-- using the deriving via mechanism. In general this should be used for sum
-- types, and product types without named fields (i.e. not records). The
-- majority of the types that you would want as values should have instances in
-- "Cfg.Source" and "Cfg.Parser".
--
-- @since 0.0.2.0
newtype Value a = Value {forall a. Value a -> a
unValue :: a}

-- | @since 0.0.2.0
instance (Generic a) => Generic (Value a) where
  type Rep (Value a) = Rep a
  to :: forall x. Rep (Value a) x -> Value a
to = a -> Value a
forall a. a -> Value a
Value (a -> Value a) -> (Rep a x -> a) -> Rep a x -> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep a x -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to
  from :: forall x. Value a -> Rep (Value a) x
from (Value a
x) = a -> Rep a x
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from a
x

-- | @since 0.0.2.0
instance (Generic a, GValueParser (Rep a)) => ValueParser (Value a) where
  parser :: Parser (Value a)
parser = Parser a -> Parser (Value a)
forall a b. Coercible a b => a -> b
coerce (Parser a -> Parser (Value a))
-> (Parser a -> Parser (Value a)) -> Parser a -> Parser (Value a)
forall a. a -> a -> a
`asTypeOf` (a -> Value a) -> Parser a -> Parser (Value 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 a -> Value a
forall a. a -> Value a
Value (Parser a -> Parser (Value a)) -> Parser a -> Parser (Value a)
forall a b. (a -> b) -> a -> b
$ forall a. (Generic a, GValueParser (Rep a)) => Parser a
defaultValueParser @a

-- | @since 0.0.2.0
instance (Generic a, GValueParser (Rep a)) => ConfigParser (Value a)