RecordParser.hs

{-# 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 env = to <$> gParseRecord 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 env = M1 <$> gParseRecord 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 env = M1 <$> gParseRecord 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 env = (:*:) <$> gParseRecord env <*> gParseRecord 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 env =
    let key = selName (undefined :: M1 S s (K1 i a) p)
    in  M1 . K1 <$> case parseType (fromMaybe "" $ M.lookup key env) of
        Left err  -> Left $ "Field " ++ show key ++ " parsing error:\n" ++ err
        Right val -> Right val