Created
October 1, 2023 02:14
-
-
Save dcecile/4d8d116764af4ae5c95aa9da88896114 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| {-# 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 | |
Author
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
https://play.haskell.org/saved/nEVaLhMF