showName :: String -> String -> String -> String
showName username name email = 
  "Hi " <> name <> "! " 
 <> "Your username is " <> username 
 <> " and your email is " <> email  

main :: IO ()
main = putStrLn $ 
  showName "gvolpe@github.com" "12345" "foo"

newtype Username = Username String
newtype Name = Name String
newtype Email = Email String

main :: IO ()
main = putStrLn $ showName' u n e
 where
  u = Username "gvolpe@github.com"
  n = Name "12345"
  e = Email ""

showName' :: Username -> Name -> Email -> String
showName' (Username u) (Name n) (Email e) =
  "Hi " <> n <> "! " <> "Your username is " 
  <> u <> " and your email is " <> e

mkUsername :: String -> Maybe Username
mkUsername [] = Nothing
mkUsername u  = Just (Username u)

mkName :: String -> Maybe Name
mkName [] = Nothing
mkName n  = Just (Name n)

-- Let's pretend we validate it properly
mkEmail :: String -> Maybe Email
mkEmail e = 
  if '@' `elem` e then Just (Email e) else Nothing

main :: IO ()
main = putStrLn $ showName' u n e
 where
  u = fromMaybe (error "Invalid username") (mkUsername "g")
  n = fromMaybe (error "Invalid name") (mkName "G")
  e = fromMaybe (error "Invalid email") (mkEmail "123")

λ main
types-matter: Invalid email
CallStack (from HasCallStack):
  error, called at app/Main.hs:20:25 in main:Main

{-# LANGUAGE DataKinds, FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-}

import Refined

data EmailPred

instance Predicate EmailPred String where
  validate p value = unless ('@' `elem` value)
    $ throwRefineOtherException (typeOf p) "Invalid email"

type Username' = Refined NonEmpty String
type Name' = Refined NonEmpty String
type Email' = Refined EmailPred String

{-# LANGUAGE TemplateHaskell #-}

main :: IO ()
main = putStrLn $ showNameRefined u n e
 where 
  u = $$(refineTH "gvolpe") :: Username'
  n = $$(refineTH "Gabriel") :: Name'
  e = $$(refineTH "123#abc") :: Email'

showNameRefined :: Username' -> Name' -> Email' -> String
showNameRefined username name email =
  "Hi " <> unrefine name <> "! "
    <> "Your username is " <> unrefine username
    <> " and your email is " <> unrefine email

λ app/Main.hs:23:18: error:
    * The predicate (EmailPred) does not hold: 
  Invalid email
    * In the Template Haskell splice $$(refineTH "123#abc")
      In the expression: $$(refineTH "123#abc") :: Email'
      In an equation for email':
          email' = $$(refineTH "123#abc") :: Email'
   |
23 |   email'    = $$(refineTH "123#abc") :: Email'
   |                  ^^^^^^^^^^^^^^^^^^

newtype HttpHost = HttpHost Text 
newtype HttpPort = HttpPort Int 
newtype HttpUri = HttpUri Text 

mkHttpHost :: Text -> Maybe HttpHost
mkHttpHost (null -> True) = Nothing
mkHttpHost h              = Just (HttpHost h)

-- Validation happens at runtime
mkHttpPort :: Int -> Maybe HttpPort
mkHttpPort n = 
  if n >= 1024 && n <= 49151 
  then Just (HttpPort n)
  else Nothing

-- We assume the inputs are validated
mkUri :: HttpHost -> HttpPort -> HttpUri
mkUri (HttpHost h) (HttpPort p) = 
  HttpUri (h <> ":" <> pack (show p))

main :: IO ()
main = print $ mkUri h p
 where
  h = fromMaybe (error "Invalid host") (mkHttpHost "127.0.0.1")
  p = fromMaybe (error "Invaild port") (mkHttpPort 123)

λ main
types-matter: Invaild port
CallStack (from HasCallStack):
  error, called at app/Main.hs:31:22 in main:Main

type HttpHost' = Refined NonEmpty Text
type HttpPort' = Refined (FromTo 1024 49151) Int

mkUri' :: HttpHost' -> HttpPort' -> HttpUri
mkUri' host port =
 HttpUri (unrefine host <> ":" <> pack (show $ unrefine port))

{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}

main :: IO ()
main = print $ mkUri h p
 where
  h = $$(refineTH "localhost") :: HttpHost'
  p = $$(refineTH 123) :: HttpPort'

λ app/Main.hs:33:14: error:
    * The predicate (FromTo 1024 49151) does not hold: 
  Value is out of range (minimum: 1024, maximum: 49151)
    * In the Template Haskell splice $$(refineTH 123)
      In the expression: $$(refineTH 123) :: HttpPort'
      In an equation for port': port' = $$(refineTH 123) :: HttpPort'
   |
33 |   port' = $$(refineTH 123) :: HttpPort'
   |              ^^^^^^^^^^^^

{-# LANGUAGE DataKinds, FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-}

import Refined

data LowerCase

instance Predicate LowerCase String where
  validate p value = unless (all isLower value)
    $ throwRefineOtherException (typeOf p) "Not all chars are lowercase"

type LowerCaseString = Refined LowerCase String