{- |
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 (Key, 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 Env St CustomPrelude Text
-> Codec Env St CustomPrelude (Text -> CustomPrelude)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Bool) -> Key -> TomlCodec Text
textWithBool Text -> Bool
packageNameValid "package" TomlCodec Text
-> (CustomPrelude -> Text) -> Codec Env St CustomPrelude Text
forall (r :: * -> *) (w :: * -> *) field a object.
Codec r w field a -> (object -> field) -> Codec r w object a
.= CustomPrelude -> Text
cpPackage
    Codec Env St CustomPrelude (Text -> CustomPrelude)
-> Codec Env St CustomPrelude Text -> TomlCodec CustomPrelude
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Bool) -> Key -> TomlCodec Text
textWithBool Text -> Bool
moduleNameValid  "module"  TomlCodec Text
-> (CustomPrelude -> Text) -> Codec Env St CustomPrelude Text
forall (r :: * -> *) (w :: * -> *) field a object.
Codec r w field a -> (object -> field) -> Codec r w object a
.= CustomPrelude -> Text
cpModule

-- | Codec for text values.
textWithBool :: (Text -> Bool) -> Key -> TomlCodec Text
textWithBool :: (Text -> Bool) -> Key -> TomlCodec Text
textWithBool p :: Text -> Bool
p = (Text -> Text)
-> (Text -> Either Text Text) -> Key -> TomlCodec Text
forall a.
(a -> Text) -> (Text -> Either Text a) -> Key -> TomlCodec a
Toml.textBy Text -> Text
forall a. a -> a
id Text -> Either Text Text
validateText
  where
    validateText :: Text -> Either Text Text
    validateText :: Text -> Either Text Text
validateText s :: Text
s =
        if Text -> Bool
p Text
s
        then Text -> Either Text Text
forall a b. b -> Either a b
Right Text
s
        else Text -> Either Text Text
forall a b. a -> Either a b
Left "Given Text doesn't pass the validation"
{-# INLINE textWithBool #-}