{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
-- Module: Data.Env.RecordParser
-- Description: Type class that provides parsers for records.
--
-- This module provides a type class 'RecordParser' that provides parsers for
-- records. The parsers are used to parse environment variables into records
-- based on their string representation.
module Data.Env.RecordParser (
  RecordParser (..),
) where

import           Data.Env.TypeParser
import           Data.Map (Map)
import           GHC.Generics
import qualified Data.Map as M
import           Data.Maybe

-- | Type class for validating environment schemas.
class RecordParser a where
  parseRecord :: Map String String -> Either String a

instance (Generic a, GRecordParser (Rep a)) => RecordParser a where

  parseRecord :: (Generic a, GRecordParser (Rep a))
              => Map String String -> Either String a
  parseRecord :: (Generic a, GRecordParser (Rep a)) =>
Map String String -> Either String a
parseRecord Map String String
env = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to (Rep a Any -> a) -> Either String (Rep a Any) -> Either String a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String String -> Either String (Rep a Any)
forall p. Map String String -> Either String (Rep a p)
forall {k} (f :: k -> *) (p :: k).
GRecordParser f =>
Map String String -> Either String (f p)
gParseRecord Map String String
env


--------------------------------------------------------------------------------
-- Generic instances
--------------------------------------------------------------------------------

-- | Generic validation class.
class GRecordParser f where
  gParseRecord :: Map String String -> Either String (f p)

-- | Handle metadata (wrapping fields in `M1`)
instance GRecordParser f => GRecordParser (M1 D c f) where
  gParseRecord :: Map String String -> Either String (M1 D c f p)
  gParseRecord :: forall (p :: k). Map String String -> Either String (M1 D c f p)
gParseRecord Map String String
env = f p -> M1 D c f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> M1 D c f p)
-> Either String (f p) -> Either String (M1 D c f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String String -> Either String (f p)
forall (p :: k). Map String String -> Either String (f p)
forall {k} (f :: k -> *) (p :: k).
GRecordParser f =>
Map String String -> Either String (f p)
gParseRecord Map String String
env

-- | Handle metadata (wrapping fields in `M1`)
instance GRecordParser f => GRecordParser (M1 C c f) where
  gParseRecord :: Map String String -> Either String (M1 C c f p)
  gParseRecord :: forall (p :: k). Map String String -> Either String (M1 C c f p)
gParseRecord Map String String
env = f p -> M1 C c f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> M1 C c f p)
-> Either String (f p) -> Either String (M1 C c f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String String -> Either String (f p)
forall (p :: k). Map String String -> Either String (f p)
forall {k} (f :: k -> *) (p :: k).
GRecordParser f =>
Map String String -> Either String (f p)
gParseRecord Map String String
env

-- | Handle multiple fields in a record
instance (GRecordParser f, GRecordParser g) => GRecordParser (f :*: g) where
  gParseRecord :: Map String String -> Either String ((f :*: g) p)
  gParseRecord :: forall (p :: k). Map String String -> Either String ((:*:) f g p)
gParseRecord Map String String
env = f p -> g p -> (:*:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (f p -> g p -> (:*:) f g p)
-> Either String (f p) -> Either String (g p -> (:*:) f g p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String String -> Either String (f p)
forall (p :: k). Map String String -> Either String (f p)
forall {k} (f :: k -> *) (p :: k).
GRecordParser f =>
Map String String -> Either String (f p)
gParseRecord Map String String
env Either String (g p -> (:*:) f g p)
-> Either String (g p) -> Either String ((:*:) f g p)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map String String -> Either String (g p)
forall (p :: k). Map String String -> Either String (g p)
forall {k} (f :: k -> *) (p :: k).
GRecordParser f =>
Map String String -> Either String (f p)
gParseRecord Map String String
env

-- | Handle individual fields
instance (TypeParser a, Selector s) => GRecordParser (M1 S s (K1 i a)) where
  gParseRecord :: Map String String -> Either String (M1 S s (K1 i a) p)
  gParseRecord :: forall {k} (p :: k).
Map String String -> Either String (M1 S s (K1 i a) p)
gParseRecord Map String String
env =
    let key :: String
key = M1 S s (K1 i a) Any -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> String
selName (M1 S s (K1 i a) p
forall {k} {p :: k}. M1 S s (K1 i a) p
forall a. HasCallStack => a
undefined :: M1 S s (K1 i a) p)
    in  K1 i a p -> M1 S s (K1 i a) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 i a p -> M1 S s (K1 i a) p)
-> (a -> K1 i a p) -> a -> M1 S s (K1 i a) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> K1 i a p
forall k i c (p :: k). c -> K1 i c p
K1 (a -> M1 S s (K1 i a) p)
-> Either String a -> Either String (M1 S s (K1 i a) p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case String -> Either String a
forall a. TypeParser a => String -> Either String a
parseType (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
key Map String String
env) of
        Left String
err  -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"Field " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
key String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" parsing error:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err
        Right a
val -> a -> Either String a
forall a b. b -> Either a b
Right a
val