{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

-- | This module provide a registry with default values for parsing options
module Data.Registry.Options.Defaults where

import Data.Registry
import Data.Registry.Options.Decoder
import Data.Registry.Options.FieldConfiguration

-- | Default registry
defaults :: Registry
  '[]
  '[FieldConfiguration, Decoder Bool, Decoder Int, Decoder Text,
    Decoder String]
defaults =
  FieldConfiguration -> Typed FieldConfiguration
forall a. Typeable a => a -> Typed a
fun FieldConfiguration
defaultFieldConfiguration
    Typed FieldConfiguration
-> Registry
     '[] '[Decoder Bool, Decoder Int, Decoder Text, Decoder String]
-> Registry
     '[]
     '[FieldConfiguration, Decoder Bool, Decoder Int, Decoder Text,
       Decoder String]
forall a b c. AddRegistryLike a b c => a -> b -> c
<: Registry
  '[] '[Decoder Bool, Decoder Int, Decoder Text, Decoder String]
decoders

-- | Default decoders
decoders :: Registry
  '[] '[Decoder Bool, Decoder Int, Decoder Text, Decoder String]
decoders =
  (Text -> Either Text Bool) -> Typed (Decoder Bool)
forall a.
Typeable a =>
(Text -> Either Text a) -> Typed (Decoder a)
addDecoder Text -> Either Text Bool
boolDecoder
    Typed (Decoder Bool)
-> Registry '[] '[Decoder Int, Decoder Text, Decoder String]
-> Registry
     '[] '[Decoder Bool, Decoder Int, Decoder Text, Decoder String]
forall a b c. AddRegistryLike a b c => a -> b -> c
<: (Text -> Either Text Int) -> Typed (Decoder Int)
forall a.
Typeable a =>
(Text -> Either Text a) -> Typed (Decoder a)
addDecoder Text -> Either Text Int
intDecoder
    Typed (Decoder Int)
-> Registry '[] '[Decoder Text, Decoder String]
-> Registry '[] '[Decoder Int, Decoder Text, Decoder String]
forall a b c. AddRegistryLike a b c => a -> b -> c
<: (Text -> Either Text Text) -> Typed (Decoder Text)
forall a.
Typeable a =>
(Text -> Either Text a) -> Typed (Decoder a)
addDecoder Text -> Either Text Text
textDecoder
    Typed (Decoder Text)
-> Typed (Decoder String)
-> Registry '[] '[Decoder Text, Decoder String]
forall a b c. AddRegistryLike a b c => a -> b -> c
<: (Text -> Either Text String) -> Typed (Decoder String)
forall a.
Typeable a =>
(Text -> Either Text a) -> Typed (Decoder a)
addDecoder Text -> Either Text String
stringDecoder