{-# LANGUAGE DefaultSignatures  #-}
{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE StandaloneDeriving #-}

{-|

Module      : Greeting
Description : Effective Haskell module example.
Copyright   : © Frank Jung, 2023-2024
License     : GPL-3.0-only

-}

module Greeting (
  -- * Types
  Name (..)
  , Salutation (..)
  , GreetingMessage (..)
  , Redacted (..)
  , Common (..)
  , Secret (..)
  , UserName (..)
  , AdminUser (..)
  -- * Functions
  , defaultMessage
  , formatMessage
) where

import           Data.List (intercalate)
import           Fmt       (fmt, (+|), (|+))


-- | Name type.
newtype Name = Name {Name -> String
getName :: String}
deriving instance Eq Name
deriving instance Show Name

-- | Salutation type.
newtype Salutation = Salutation {Salutation -> String
getSalutation :: String}
deriving instance Eq Salutation
deriving instance Show Salutation

-- | Greeting message type. It consists of a salutation, a name to greet,
-- and a list of names from whom the greeting is from.
data GreetingMessage = GreetingMessage {
    GreetingMessage -> Salutation
greetingSalutation :: Salutation
  , GreetingMessage -> Name
greetingTo         :: Name
  , GreetingMessage -> [Name]
greetingFrom       :: [Name]}
deriving instance Eq GreetingMessage
deriving instance Show GreetingMessage

{-| Default greeting message.

@
'defaultMessage' {
    'greetingSalutation' :: 'Salutation' \"Hello\"
  , 'greetingTo'         :: Name \"World\"
  , 'greetingFrom'       :: []}
}
@

-}
defaultMessage :: GreetingMessage
defaultMessage :: GreetingMessage
defaultMessage = GreetingMessage {
    greetingSalutation :: Salutation
greetingSalutation = String -> Salutation
Salutation String
"Hello"
  , greetingTo :: Name
greetingTo = String -> Name
Name String
"World"
  , greetingFrom :: [Name]
greetingFrom = []}

{- | Format greeting message.

>>> formatMessage defaultMessage
"Hello, World!"

>>> formatMessage (defaultMessage {greetingTo = Name "Robyn", greetingFrom = [Name "Frank"]})
"Hello, Robyn! from Frank"

-}
formatMessage :: GreetingMessage -> String
formatMessage :: GreetingMessage -> String
formatMessage (GreetingMessage (Salutation String
s) (Name String
to) [Name]
from) =
  Builder -> String
forall b. FromBuilder b => Builder -> b
fmt (Builder -> String) -> Builder -> String
forall a b. (a -> b) -> a -> b
$ Builder
"" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| String
s String -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
", " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| String
to String -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"!" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| String
fromStr String -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
  where
    fromStr :: String
fromStr
      | [Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
from = String
""
      | Bool
otherwise = String
" from " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Name -> String) -> [Name] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Name -> String
getName [Name]
from)

-- | Redacted type class.
class Redacted a where
  redacted :: a -> String
  default redacted :: Show a => a -> String
  redacted = a -> String
forall a. Show a => a -> String
show

-- | Common type.
newtype Common = Common String
-- | Override Show instance to echo result with out type signature.
-- A better way is to use GeneralizedNewtypeDeriving extension to derive the
-- Show instance.  This Show instance does not show the type.
instance Show Common where
  show :: Common -> String
show (Common String
s) = String
s

-- | Common type instance of Redacted.
-- This will echo the string as is.
instance Redacted Common

-- | Secret type.
newtype Secret = Secret String
-- | Redacted will not show string value for this 'Secret' type.
instance Redacted Secret where
  redacted :: Secret -> String
redacted Secret
_ = String
"(redacted)"

-- | Simpler way to implement Redacted instance for 'Secret'.
-- Needs the `DeriveAnyClass` extension.
-- Overrides Show instance to give a customised value.
newtype UserName = UserName String
  deriving stock (UserName -> UserName -> Bool
(UserName -> UserName -> Bool)
-> (UserName -> UserName -> Bool) -> Eq UserName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserName -> UserName -> Bool
== :: UserName -> UserName -> Bool
$c/= :: UserName -> UserName -> Bool
/= :: UserName -> UserName -> Bool
Eq, Int -> UserName -> ShowS
[UserName] -> ShowS
UserName -> String
(Int -> UserName -> ShowS)
-> (UserName -> String) -> ([UserName] -> ShowS) -> Show UserName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserName -> ShowS
showsPrec :: Int -> UserName -> ShowS
$cshow :: UserName -> String
show :: UserName -> String
$cshowList :: [UserName] -> ShowS
showList :: [UserName] -> ShowS
Show)
  deriving anyclass (UserName -> String
(UserName -> String) -> Redacted UserName
forall a. (a -> String) -> Redacted a
$credacted :: UserName -> String
redacted :: UserName -> String
Redacted)
-- custom Show instance
-- instance Show UserName where
--   show (UserName user) = "UserName: " <> user

-- | AdminUer type. Will override Redacted instance to give a customised value.
newtype AdminUser = AdminUser UserName deriving stock (AdminUser -> AdminUser -> Bool
(AdminUser -> AdminUser -> Bool)
-> (AdminUser -> AdminUser -> Bool) -> Eq AdminUser
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AdminUser -> AdminUser -> Bool
== :: AdminUser -> AdminUser -> Bool
$c/= :: AdminUser -> AdminUser -> Bool
/= :: AdminUser -> AdminUser -> Bool
Eq, Int -> AdminUser -> ShowS
[AdminUser] -> ShowS
AdminUser -> String
(Int -> AdminUser -> ShowS)
-> (AdminUser -> String)
-> ([AdminUser] -> ShowS)
-> Show AdminUser
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AdminUser -> ShowS
showsPrec :: Int -> AdminUser -> ShowS
$cshow :: AdminUser -> String
show :: AdminUser -> String
$cshowList :: [AdminUser] -> ShowS
showList :: [AdminUser] -> ShowS
Show)
-- custom Redacted instance
instance Redacted AdminUser where
  redacted :: AdminUser -> String
redacted (AdminUser (UserName String
user)) = String
"AdminUser " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
user