{-# LANGUAGE GHC2021 #-}
{-# LANGUAGE ExplicitNamespaces #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# OPTIONS -Wpartial-fields #-}

import qualified Data.Text as T
import qualified Data.Time as Time

data Visitor where
  Member :: { name :: T.Text, birthday :: Time.Day } -> Visitor
  NonMember :: { alias :: Maybe T.Text } -> Visitor

data Visitor' where
  Member' :: { _name :: T.Text, _birthday :: Time.Day } -> Visitor'
  NonMember' :: { _alias :: Maybe T.Text } -> Visitor'

main :: IO ()
main = do
  (makeGreeting Member { name = "Haskell Curry" , birthday = read "1900-09-12" }
    >>= putStrLn . T.unpack)
  (makeGreeting NonMember { alias = Nothing }
    >>= putStrLn . T.unpack)
  (makeGreeting'' NonMember' { _alias = Nothing }
    >>= putStrLn . T.unpack)

makeGreeting :: Visitor -> IO T.Text
makeGreeting visitor =
  case visitor of
    nonMember@(NonMember {}) ->
      pure $ case nonMember.alias of
        Just name -> "Hello, " <> name <> "!"
        Nothing   -> "Hello, mysterious visitor!"
    member@(Member {}) -> do
      today <- Time.utctDay <$> Time.getCurrentTime
      let monthAndDay = (\(_y, m, d) -> (m, d)) . Time.toGregorian
      if monthAndDay today == monthAndDay (member.birthday)
      then pure $ "Happy birthday, " <> member.name <> "!"
      else pure $ "Welcome back, " <> member.name <> "!"

makeGreeting' :: Visitor -> IO T.Text
makeGreeting' visitor =
  pure visitor.name

makeGreeting'' :: Visitor' -> IO T.Text
makeGreeting'' visitor =
  pure visitor._name