Created
June 11, 2015 20:35
-
-
Save roman/09c8b38f589d0e6aab27 to your computer and use it in GitHub Desktop.
Example on how to create constrained functions for particular ADT constructors in Haskell using GADTs, DataKinds and KindSignatures extension
This file contains 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 DataKinds #-} | |
{-# LANGUAGE KindSignatures #-} | |
{-# LANGUAGE GADTs #-} | |
module Main where | |
data UserType | |
= VirtualUser | |
| RealUser | |
data User (userType :: UserType) where | |
MkVirtualUser :: String -> User 'VirtualUser | |
MkRealUser :: String -> User 'RealUser | |
deliverPackage :: User 'RealUser -> String -> IO () | |
deliverPackage (MkRealUser name) package = | |
putStrLn $ "Delivering package " ++ package ++ " for user " ++ name | |
sendEmail :: User 'VirtualUser -> String -> IO () | |
sendEmail (MkVirtualUser email) body = | |
putStrLn $ "Sending email to " ++ email ++ " with body: \n" ++ body | |
userData :: User userType -> IO () | |
userData (MkRealUser name) = putStrLn $ "User with name: " ++ name | |
userData (MkVirtualUser email) = putStrLn $ "User with email: " ++ email | |
main :: IO () | |
main = do | |
let vuser = MkVirtualUser "[email protected]" | |
ruser = MkRealUser "Roman Gonzalez" | |
-- Compiles with all types of users | |
userData vuser | |
userData ruser | |
-------------------------------------------------------------------------------- | |
-- Compiles only with types of user @'RealUser@ | |
deliverPackage ruser "foobar" | |
{- | |
deliverPackage vuser "barfoo" -- <- Compile Error | |
-- Couldn't match type ‘'VirtualUser’ with ‘'RealUser’ | |
-- Expected type: User 'RealUser | |
-- Actual type: User 'VirtualUser | |
-- In the first argument of ‘deliverPackage’, namely ‘vuser’ | |
-- In a stmt of a 'do' block: deliverPackage vuser "barfoo" | |
-} | |
-------------------------------------------------------------------------------- | |
-- Compiles only with types of user @'VirtualUser@ | |
sendEmail vuser "[email protected]" | |
{- | |
sendEmail ruser "[email protected]" -- <- Compile Error | |
-- Couldn't match type ‘'RealUser’ with ‘'VirtualUser’ | |
-- Expected type: User 'VirtualUser | |
-- Actual type: User 'RealUser | |
-- In the first argument of ‘sendEmail’, namely ‘ruser’ | |
-- In a stmt of a 'do' block: sendEmail ruser "[email protected]" | |
-} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
I used EmptyDataDecl because there no need for that in your example. But as you noticed, nothing prevents you from doing otherwise.