{- |
Copyright: (c) 2017-2019 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

This module implements data type for representing custom alternative preludes.
-}

module Summoner.CustomPrelude
       ( CustomPrelude (..)
       , customPreludeT
       ) where

import Toml (TomlCodec, (.=))

import Summoner.Text (moduleNameValid, packageNameValid)

import qualified Toml


data CustomPrelude = CustomPrelude
    { CustomPrelude -> Text
cpPackage :: !Text
    , CustomPrelude -> Text
cpModule  :: !Text
    } deriving stock (Int -> CustomPrelude -> ShowS
[CustomPrelude] -> ShowS
CustomPrelude -> String
(Int -> CustomPrelude -> ShowS)
-> (CustomPrelude -> String)
-> ([CustomPrelude] -> ShowS)
-> Show CustomPrelude
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CustomPrelude] -> ShowS
$cshowList :: [CustomPrelude] -> ShowS
show :: CustomPrelude -> String
$cshow :: CustomPrelude -> String
showsPrec :: Int -> CustomPrelude -> ShowS
$cshowsPrec :: Int -> CustomPrelude -> ShowS
Show, CustomPrelude -> CustomPrelude -> Bool
(CustomPrelude -> CustomPrelude -> Bool)
-> (CustomPrelude -> CustomPrelude -> Bool) -> Eq CustomPrelude
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CustomPrelude -> CustomPrelude -> Bool
$c/= :: CustomPrelude -> CustomPrelude -> Bool
== :: CustomPrelude -> CustomPrelude -> Bool
$c== :: CustomPrelude -> CustomPrelude -> Bool
Eq)

customPreludeT :: TomlCodec CustomPrelude
customPreludeT :: TomlCodec CustomPrelude
customPreludeT = Text -> Text -> CustomPrelude
CustomPrelude
    (Text -> Text -> CustomPrelude)
-> Codec CustomPrelude Text
-> Codec CustomPrelude (Text -> CustomPrelude)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Bool) -> TomlBiMap Text AnyValue -> Key -> TomlCodec Text
forall a. (a -> Bool) -> TomlBiMap a AnyValue -> Key -> TomlCodec a
Toml.validateIf Text -> Bool
packageNameValid TomlBiMap Text AnyValue
Toml._Text "package" TomlCodec Text
-> (CustomPrelude -> Text) -> Codec CustomPrelude Text
forall field a object.
Codec field a -> (object -> field) -> Codec object a
.= CustomPrelude -> Text
cpPackage
    Codec CustomPrelude (Text -> CustomPrelude)
-> Codec CustomPrelude Text -> TomlCodec CustomPrelude
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Bool) -> TomlBiMap Text AnyValue -> Key -> TomlCodec Text
forall a. (a -> Bool) -> TomlBiMap a AnyValue -> Key -> TomlCodec a
Toml.validateIf Text -> Bool
moduleNameValid  TomlBiMap Text AnyValue
Toml._Text "module"  TomlCodec Text
-> (CustomPrelude -> Text) -> Codec CustomPrelude Text
forall field a object.
Codec field a -> (object -> field) -> Codec object a
.= CustomPrelude -> Text
cpModule