{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TupleSections #-}

module Hinit.Template.Config where

import Control.Applicative
import Control.Lens ((^.), _1, _2, _3)
import Data.Generics.Labels ()
import Data.String.Interpolate
import Data.Text (Text, pack, unpack)
import GHC.Generics
import System.FilePath.Glob
  ( Pattern,
    compile,
    decompile,
    simplify,
  )
import Toml
import qualified Toml as T

data TemplateConfig = TemplateConfig
  { TemplateConfig -> Maybe Text
desc :: Maybe Text,
    TemplateConfig -> [Text]
tags :: [Text],
    TemplateConfig -> [Pattern]
ignores :: [Pattern],
    TemplateConfig -> [Option]
options :: [Option],
    TemplateConfig -> [OptionalIgnores]
optionals :: [OptionalIgnores]
  }
  deriving (Int -> TemplateConfig -> ShowS
[TemplateConfig] -> ShowS
TemplateConfig -> String
(Int -> TemplateConfig -> ShowS)
-> (TemplateConfig -> String)
-> ([TemplateConfig] -> ShowS)
-> Show TemplateConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TemplateConfig] -> ShowS
$cshowList :: [TemplateConfig] -> ShowS
show :: TemplateConfig -> String
$cshow :: TemplateConfig -> String
showsPrec :: Int -> TemplateConfig -> ShowS
$cshowsPrec :: Int -> TemplateConfig -> ShowS
Show, TemplateConfig -> TemplateConfig -> Bool
(TemplateConfig -> TemplateConfig -> Bool)
-> (TemplateConfig -> TemplateConfig -> Bool) -> Eq TemplateConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TemplateConfig -> TemplateConfig -> Bool
$c/= :: TemplateConfig -> TemplateConfig -> Bool
== :: TemplateConfig -> TemplateConfig -> Bool
$c== :: TemplateConfig -> TemplateConfig -> Bool
Eq, (forall x. TemplateConfig -> Rep TemplateConfig x)
-> (forall x. Rep TemplateConfig x -> TemplateConfig)
-> Generic TemplateConfig
forall x. Rep TemplateConfig x -> TemplateConfig
forall x. TemplateConfig -> Rep TemplateConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TemplateConfig x -> TemplateConfig
$cfrom :: forall x. TemplateConfig -> Rep TemplateConfig x
Generic)

pToTomlVal :: Pattern -> AnyValue
pToTomlVal :: Pattern -> AnyValue
pToTomlVal Pattern
p = Value 'TText -> AnyValue
forall (t :: TValue). Value t -> AnyValue
AnyValue (Value 'TText -> AnyValue) -> Value 'TText -> AnyValue
forall a b. (a -> b) -> a -> b
$ Text -> Value 'TText
Text (Text -> Value 'TText) -> Text -> Value 'TText
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Pattern -> String
decompile Pattern
p

tomlValToP :: AnyValue -> Either TomlBiMapError Pattern
tomlValToP :: AnyValue -> Either TomlBiMapError Pattern
tomlValToP (AnyValue Value t
v)
  | Text Text
t <- Value t
v = Pattern -> Either TomlBiMapError Pattern
forall a b. b -> Either a b
Right (Pattern -> Either TomlBiMapError Pattern)
-> Pattern -> Either TomlBiMapError Pattern
forall a b. (a -> b) -> a -> b
$ Pattern -> Pattern
simplify (Pattern -> Pattern) -> Pattern -> Pattern
forall a b. (a -> b) -> a -> b
$ String -> Pattern
compile (String -> Pattern) -> String -> Pattern
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
t
  | Bool
otherwise = TomlBiMapError -> Either TomlBiMapError Pattern
forall a b. a -> Either a b
Left (TomlBiMapError -> Either TomlBiMapError Pattern)
-> TomlBiMapError -> Either TomlBiMapError Pattern
forall a b. (a -> b) -> a -> b
$ MatchError -> TomlBiMapError
WrongValue (MatchError -> TomlBiMapError) -> MatchError -> TomlBiMapError
forall a b. (a -> b) -> a -> b
$ TValue -> AnyValue -> MatchError
MatchError TValue
TText (Value t -> AnyValue
forall (t :: TValue). Value t -> AnyValue
AnyValue Value t
v)

_Pattern :: TomlBiMap Pattern AnyValue
_Pattern :: TomlBiMap Pattern AnyValue
_Pattern = BiMap TomlBiMapError AnyValue Pattern -> TomlBiMap Pattern AnyValue
forall e a b. BiMap e a b -> BiMap e b a
invert (BiMap TomlBiMapError AnyValue Pattern
 -> TomlBiMap Pattern AnyValue)
-> BiMap TomlBiMapError AnyValue Pattern
-> TomlBiMap Pattern AnyValue
forall a b. (a -> b) -> a -> b
$ (Pattern -> AnyValue)
-> (AnyValue -> Either TomlBiMapError Pattern)
-> BiMap TomlBiMapError AnyValue Pattern
forall field object error.
(field -> object)
-> (object -> Either error field) -> BiMap error object field
prism Pattern -> AnyValue
pToTomlVal AnyValue -> Either TomlBiMapError Pattern
tomlValToP

instance HasItemCodec Pattern where
  hasItemCodec :: Either (TomlBiMap Pattern AnyValue) (TomlCodec Pattern)
hasItemCodec = TomlBiMap Pattern AnyValue
-> Either (TomlBiMap Pattern AnyValue) (TomlCodec Pattern)
forall a b. a -> Either a b
Left TomlBiMap Pattern AnyValue
_Pattern

templateConfigCodec :: TomlCodec TemplateConfig
templateConfigCodec :: TomlCodec TemplateConfig
templateConfigCodec = TomlCodec TemplateConfig
forall a. (Generic a, GenericCodec (Rep a)) => TomlCodec a
genericCodec

data Option
  = BoolOpt
      { Option -> Text
name :: Text,
        Option -> Maybe Text
desc :: Maybe Text,
        Option -> Maybe Bool
defB :: Maybe Bool
      }
  | TextOpt
      { name :: Text,
        desc :: Maybe Text,
        Option -> Maybe Text
defT :: Maybe Text
      }
  deriving (Int -> Option -> ShowS
[Option] -> ShowS
Option -> String
(Int -> Option -> ShowS)
-> (Option -> String) -> ([Option] -> ShowS) -> Show Option
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Option] -> ShowS
$cshowList :: [Option] -> ShowS
show :: Option -> String
$cshow :: Option -> String
showsPrec :: Int -> Option -> ShowS
$cshowsPrec :: Int -> Option -> ShowS
Show, Option -> Option -> Bool
(Option -> Option -> Bool)
-> (Option -> Option -> Bool) -> Eq Option
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Option -> Option -> Bool
$c/= :: Option -> Option -> Bool
== :: Option -> Option -> Bool
$c== :: Option -> Option -> Bool
Eq, (forall x. Option -> Rep Option x)
-> (forall x. Rep Option x -> Option) -> Generic Option
forall x. Rep Option x -> Option
forall x. Option -> Rep Option x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Option x -> Option
$cfrom :: forall x. Option -> Rep Option x
Generic)

pair' :: TomlCodec a -> TomlCodec b -> TomlCodec c -> TomlCodec (a, b, c)
pair' :: TomlCodec a -> TomlCodec b -> TomlCodec c -> TomlCodec (a, b, c)
pair' TomlCodec a
a TomlCodec b
b TomlCodec c
c =
  (,,)
    (a -> b -> c -> (a, b, c))
-> Codec (a, b, c) a -> Codec (a, b, c) (b -> c -> (a, b, c))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> TomlCodec a
a TomlCodec a -> ((a, b, c) -> a) -> Codec (a, b, c) a
forall field a object.
Codec field a -> (object -> field) -> Codec object a
.= ((a, b, c) -> Getting a (a, b, c) a -> a
forall s a. s -> Getting a s a -> a
^. Getting a (a, b, c) a
forall s t a b. Field1 s t a b => Lens s t a b
_1)
      Codec (a, b, c) (b -> c -> (a, b, c))
-> Codec (a, b, c) b -> Codec (a, b, c) (c -> (a, b, c))
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> TomlCodec b
b TomlCodec b -> ((a, b, c) -> b) -> Codec (a, b, c) b
forall field a object.
Codec field a -> (object -> field) -> Codec object a
.= ((a, b, c) -> Getting b (a, b, c) b -> b
forall s a. s -> Getting a s a -> a
^. Getting b (a, b, c) b
forall s t a b. Field2 s t a b => Lens s t a b
_2)
      Codec (a, b, c) (c -> (a, b, c))
-> Codec (a, b, c) c -> TomlCodec (a, b, c)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> TomlCodec c
c TomlCodec c -> ((a, b, c) -> c) -> Codec (a, b, c) c
forall field a object.
Codec field a -> (object -> field) -> Codec object a
.= ((a, b, c) -> Getting c (a, b, c) c -> c
forall s a. s -> Getting a s a -> a
^. Getting c (a, b, c) c
forall s t a b. Field3 s t a b => Lens s t a b
_3)

matchB :: Option -> Maybe (Text, Maybe Text, Bool)
matchB :: Option -> Maybe (Text, Maybe Text, Bool)
matchB BoolOpt {Maybe Bool
Maybe Text
Text
defB :: Maybe Bool
desc :: Maybe Text
name :: Text
$sel:defB:BoolOpt :: Option -> Maybe Bool
$sel:desc:BoolOpt :: Option -> Maybe Text
$sel:name:BoolOpt :: Option -> Text
..} = (Bool -> (Text, Maybe Text, Bool))
-> Maybe Bool -> Maybe (Text, Maybe Text, Bool)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text
name,Maybe Text
desc,) Maybe Bool
defB
matchB Option
_ = Maybe (Text, Maybe Text, Bool)
forall a. Maybe a
Nothing

matchB' :: Option -> Maybe (Text, Maybe Text)
matchB' :: Option -> Maybe (Text, Maybe Text)
matchB' BoolOpt {Maybe Bool
Maybe Text
Text
defB :: Maybe Bool
desc :: Maybe Text
name :: Text
$sel:defB:BoolOpt :: Option -> Maybe Bool
$sel:desc:BoolOpt :: Option -> Maybe Text
$sel:name:BoolOpt :: Option -> Text
..} = (Text, Maybe Text) -> Maybe (Text, Maybe Text)
forall a. a -> Maybe a
Just (Text
name, Maybe Text
desc)
matchB' Option
_ = Maybe (Text, Maybe Text)
forall a. Maybe a
Nothing

matchT :: Option -> Maybe (Text, Maybe Text, Text)
matchT :: Option -> Maybe (Text, Maybe Text, Text)
matchT TextOpt {Maybe Text
Text
defT :: Maybe Text
desc :: Maybe Text
name :: Text
$sel:defT:BoolOpt :: Option -> Maybe Text
$sel:desc:BoolOpt :: Option -> Maybe Text
$sel:name:BoolOpt :: Option -> Text
..} = (Text -> (Text, Maybe Text, Text))
-> Maybe Text -> Maybe (Text, Maybe Text, Text)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text
name,Maybe Text
desc,) Maybe Text
defT
matchT Option
_ = Maybe (Text, Maybe Text, Text)
forall a. Maybe a
Nothing

matchT' :: Option -> Maybe (Text, Maybe Text)
matchT' :: Option -> Maybe (Text, Maybe Text)
matchT' TextOpt {Maybe Text
Text
defT :: Maybe Text
desc :: Maybe Text
name :: Text
$sel:defT:BoolOpt :: Option -> Maybe Text
$sel:desc:BoolOpt :: Option -> Maybe Text
$sel:name:BoolOpt :: Option -> Text
..} = (Text, Maybe Text) -> Maybe (Text, Maybe Text)
forall a. a -> Maybe a
Just (Text
name, Maybe Text
desc)
matchT' Option
_ = Maybe (Text, Maybe Text)
forall a. Maybe a
Nothing

descCodec :: TomlCodec (Maybe Text)
descCodec :: TomlCodec (Maybe Text)
descCodec = TomlCodec Text -> TomlCodec (Maybe Text)
forall a. TomlCodec a -> TomlCodec (Maybe a)
dioptional (Key -> TomlCodec Text
text Key
"desc")

tyCodec :: Text -> TomlCodec Text
tyCodec :: Text -> TomlCodec Text
tyCodec Text
ty = TomlBiMap Text AnyValue -> Key -> TomlCodec Text
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match TomlBiMap Text AnyValue
_Ty Key
"type"
  where
    _Ty :: TomlBiMap Text AnyValue
_Ty = BiMap TomlBiMapError AnyValue Text -> TomlBiMap Text AnyValue
forall e a b. BiMap e a b -> BiMap e b a
invert (BiMap TomlBiMapError AnyValue Text -> TomlBiMap Text AnyValue)
-> BiMap TomlBiMapError AnyValue Text -> TomlBiMap Text AnyValue
forall a b. (a -> b) -> a -> b
$ (Text -> AnyValue)
-> (AnyValue -> Either TomlBiMapError Text)
-> BiMap TomlBiMapError AnyValue Text
forall field object error.
(field -> object)
-> (object -> Either error field) -> BiMap error object field
prism (Value 'TText -> AnyValue
forall (t :: TValue). Value t -> AnyValue
AnyValue (Value 'TText -> AnyValue)
-> (Text -> Value 'TText) -> Text -> AnyValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value 'TText
T.Text) AnyValue -> Either TomlBiMapError Text
tyFromToml
    tyFromToml :: AnyValue -> Either TomlBiMapError Text
tyFromToml (AnyValue Value t
v)
      | T.Text Text
t <- Value t
v =
        if Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
ty
          then Text -> Either TomlBiMapError Text
forall a b. b -> Either a b
Right Text
t
          else TomlBiMapError -> Either TomlBiMapError Text
forall a b. a -> Either a b
Left (TomlBiMapError -> Either TomlBiMapError Text)
-> TomlBiMapError -> Either TomlBiMapError Text
forall a b. (a -> b) -> a -> b
$ Text -> TomlBiMapError
ArbitraryError [i|Expecting type #{ty}, got type #{t}|]
      | Bool
otherwise =
        TomlBiMapError -> Either TomlBiMapError Text
forall a b. a -> Either a b
Left (TomlBiMapError -> Either TomlBiMapError Text)
-> TomlBiMapError -> Either TomlBiMapError Text
forall a b. (a -> b) -> a -> b
$ MatchError -> TomlBiMapError
WrongValue (MatchError -> TomlBiMapError) -> MatchError -> TomlBiMapError
forall a b. (a -> b) -> a -> b
$ TValue -> AnyValue -> MatchError
MatchError TValue
TText (Value t -> AnyValue
forall (t :: TValue). Value t -> AnyValue
AnyValue Value t
v)

optCodec :: TomlCodec Option
optCodec :: TomlCodec Option
optCodec =
  (Option -> Maybe (Text, Maybe Text, Bool))
-> ((Text, Maybe Text, Bool) -> Option)
-> TomlCodec (Text, Maybe Text, Bool)
-> TomlCodec Option
forall b a.
(b -> Maybe a) -> (a -> b) -> TomlCodec a -> TomlCodec b
dimatch Option -> Maybe (Text, Maybe Text, Bool)
matchB (\(Text
a, Maybe Text
b, Bool
c) -> Text -> Maybe Text -> Maybe Bool -> Option
BoolOpt Text
a Maybe Text
b (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
c)) TomlCodec (Text, Maybe Text, Bool)
bOptCodec
    TomlCodec Option -> TomlCodec Option -> TomlCodec Option
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> (Option -> Maybe (Text, Maybe Text))
-> ((Text, Maybe Text) -> Option)
-> TomlCodec (Text, Maybe Text)
-> TomlCodec Option
forall b a.
(b -> Maybe a) -> (a -> b) -> TomlCodec a -> TomlCodec b
dimatch Option -> Maybe (Text, Maybe Text)
matchB' (\(Text
a, Maybe Text
b) -> Text -> Maybe Text -> Maybe Bool -> Option
BoolOpt Text
a Maybe Text
b Maybe Bool
forall a. Maybe a
Nothing) TomlCodec (Text, Maybe Text)
bOptCodec'
    TomlCodec Option -> TomlCodec Option -> TomlCodec Option
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> (Option -> Maybe (Text, Maybe Text, Text))
-> ((Text, Maybe Text, Text) -> Option)
-> TomlCodec (Text, Maybe Text, Text)
-> TomlCodec Option
forall b a.
(b -> Maybe a) -> (a -> b) -> TomlCodec a -> TomlCodec b
dimatch Option -> Maybe (Text, Maybe Text, Text)
matchT (\(Text
a, Maybe Text
b, Text
c) -> Text -> Maybe Text -> Maybe Text -> Option
TextOpt Text
a Maybe Text
b (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
c)) TomlCodec (Text, Maybe Text, Text)
tOptCodec
    TomlCodec Option -> TomlCodec Option -> TomlCodec Option
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> (Option -> Maybe (Text, Maybe Text))
-> ((Text, Maybe Text) -> Option)
-> TomlCodec (Text, Maybe Text)
-> TomlCodec Option
forall b a.
(b -> Maybe a) -> (a -> b) -> TomlCodec a -> TomlCodec b
dimatch Option -> Maybe (Text, Maybe Text)
matchT' (\(Text
a, Maybe Text
b) -> Text -> Maybe Text -> Maybe Bool -> Option
BoolOpt Text
a Maybe Text
b Maybe Bool
forall a. Maybe a
Nothing) TomlCodec (Text, Maybe Text)
tOptCodec'
  where
    bOptCodec :: TomlCodec (Text, Maybe Text, Bool)
    bOptCodec :: TomlCodec (Text, Maybe Text, Bool)
bOptCodec = TomlCodec Text
-> TomlCodec (Maybe Text)
-> TomlCodec Bool
-> TomlCodec (Text, Maybe Text, Bool)
forall a b c.
TomlCodec a -> TomlCodec b -> TomlCodec c -> TomlCodec (a, b, c)
pair' (Key -> TomlCodec Text
text Key
"name") TomlCodec (Maybe Text)
descCodec (Key -> TomlCodec Bool
bool Key
"default")
    bOptCodec' :: TomlCodec (Text, Maybe Text)
    bOptCodec' :: TomlCodec (Text, Maybe Text)
bOptCodec' =
      TomlCodec Text
-> TomlCodec (Maybe Text) -> TomlCodec (Text, Maybe Text)
forall a b. TomlCodec a -> TomlCodec b -> TomlCodec (a, b)
pair (Key -> TomlCodec Text
text Key
"name") TomlCodec (Maybe Text)
descCodec
        TomlCodec (Text, Maybe Text)
-> Codec (Text, Maybe Text) Text -> TomlCodec (Text, Maybe Text)
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* Text -> TomlCodec Text
tyCodec Text
"bool" TomlCodec Text
-> ((Text, Maybe Text) -> Text) -> Codec (Text, Maybe Text) Text
forall field a object.
Codec field a -> (object -> field) -> Codec object a
.= Text -> (Text, Maybe Text) -> Text
forall a b. a -> b -> a
const Text
"bool"
    tOptCodec :: TomlCodec (Text, Maybe Text, Text)
    tOptCodec :: TomlCodec (Text, Maybe Text, Text)
tOptCodec =
      TomlCodec Text
-> TomlCodec (Maybe Text)
-> TomlCodec Text
-> TomlCodec (Text, Maybe Text, Text)
forall a b c.
TomlCodec a -> TomlCodec b -> TomlCodec c -> TomlCodec (a, b, c)
pair' (Key -> TomlCodec Text
text Key
"name") TomlCodec (Maybe Text)
descCodec (Key -> TomlCodec Text
text Key
"default")
    tOptCodec' :: TomlCodec (Text, Maybe Text)
    tOptCodec' :: TomlCodec (Text, Maybe Text)
tOptCodec' =
      TomlCodec Text
-> TomlCodec (Maybe Text) -> TomlCodec (Text, Maybe Text)
forall a b. TomlCodec a -> TomlCodec b -> TomlCodec (a, b)
pair (Key -> TomlCodec Text
text Key
"name") TomlCodec (Maybe Text)
descCodec
        TomlCodec (Text, Maybe Text)
-> Codec (Text, Maybe Text) Text -> TomlCodec (Text, Maybe Text)
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* Text -> TomlCodec Text
tyCodec Text
"text" TomlCodec Text
-> ((Text, Maybe Text) -> Text) -> Codec (Text, Maybe Text) Text
forall field a object.
Codec field a -> (object -> field) -> Codec object a
.= Text -> (Text, Maybe Text) -> Text
forall a b. a -> b -> a
const Text
"text"

instance HasItemCodec Option where
  hasItemCodec :: Either (TomlBiMap Option AnyValue) (TomlCodec Option)
hasItemCodec = TomlCodec Option
-> Either (TomlBiMap Option AnyValue) (TomlCodec Option)
forall a b. b -> Either a b
Right TomlCodec Option
optCodec

data OptionalIgnores = Optional
  { OptionalIgnores -> Text
when :: Text,
    OptionalIgnores -> [Pattern]
ignores :: [Pattern]
  }
  deriving (Int -> OptionalIgnores -> ShowS
[OptionalIgnores] -> ShowS
OptionalIgnores -> String
(Int -> OptionalIgnores -> ShowS)
-> (OptionalIgnores -> String)
-> ([OptionalIgnores] -> ShowS)
-> Show OptionalIgnores
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OptionalIgnores] -> ShowS
$cshowList :: [OptionalIgnores] -> ShowS
show :: OptionalIgnores -> String
$cshow :: OptionalIgnores -> String
showsPrec :: Int -> OptionalIgnores -> ShowS
$cshowsPrec :: Int -> OptionalIgnores -> ShowS
Show, OptionalIgnores -> OptionalIgnores -> Bool
(OptionalIgnores -> OptionalIgnores -> Bool)
-> (OptionalIgnores -> OptionalIgnores -> Bool)
-> Eq OptionalIgnores
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OptionalIgnores -> OptionalIgnores -> Bool
$c/= :: OptionalIgnores -> OptionalIgnores -> Bool
== :: OptionalIgnores -> OptionalIgnores -> Bool
$c== :: OptionalIgnores -> OptionalIgnores -> Bool
Eq, (forall x. OptionalIgnores -> Rep OptionalIgnores x)
-> (forall x. Rep OptionalIgnores x -> OptionalIgnores)
-> Generic OptionalIgnores
forall x. Rep OptionalIgnores x -> OptionalIgnores
forall x. OptionalIgnores -> Rep OptionalIgnores x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OptionalIgnores x -> OptionalIgnores
$cfrom :: forall x. OptionalIgnores -> Rep OptionalIgnores x
Generic)

instance HasItemCodec OptionalIgnores where
  hasItemCodec :: Either
  (TomlBiMap OptionalIgnores AnyValue) (TomlCodec OptionalIgnores)
hasItemCodec = TomlCodec OptionalIgnores
-> Either
     (TomlBiMap OptionalIgnores AnyValue) (TomlCodec OptionalIgnores)
forall a b. b -> Either a b
Right TomlCodec OptionalIgnores
forall a. (Generic a, GenericCodec (Rep a)) => TomlCodec a
genericCodec