Skip to content

Instantly share code, notes, and snippets.

@chshersh
Last active July 15, 2019 06:53
Show Gist options
  • Save chshersh/d9413b52aafd2057f1d8c87880aa3df7 to your computer and use it in GitHub Desktop.
Save chshersh/d9413b52aafd2057f1d8c87880aa3df7 to your computer and use it in GitHub Desktop.
Examples of custom type errors
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{- This is a full code for the following blog post:
http://kodimensional.dev/type-errors
-}
module TypeError where
import Data.Int (Int16, Int8)
import Data.Kind (Constraint, Type)
import Data.Word (Word8)
import GHC.TypeLits (ErrorMessage (..))
import Numeric.Natural (Natural)
import Type.Errors.Pretty (type (%), type (<>), TypeError)
type family Signed (t :: Type) :: Type where
Signed Word8 = Int16
Signed Natural = Integer
class ToSigned a where
toSigned :: a -> Signed a
type FooMessage =
'Text "First line of the foo message" ':$$:
'Text "Second line of the foo message: " ':<>: 'ShowType ErrorMessage
-- foo :: TypeError FooMessage
-- foo = error "unreachable"
type ListNumMessage
= "You've tried to perform an arithmetic operation on lists."
% "Possibly one of those: (+), (-), (*), fromInteger, negate, abs"
% ""
% "If you tried to add two lists like this:"
% ""
% " ghci> [5, 10] + [1, 2, 3]"
% ""
% "Then this is probably a typo and you wanted to append two lists."
% "Use (++) operator to append two lists."
% ""
% " ghci> [5, 10] ++ [1, 2, 3]"
% " [5, 10, 1, 2, 3]"
% ""
% "If you want to combine a list of numbers with an arithmetic operation,"
% "you can either use 'zipWith' for index-wise application:"
% ""
% " ghci> zipWith (*) [5, 10] [1, 2, 3]"
% " [5, 20]"
% ""
% "or 'liftA2' for pairwise application:"
% ""
% " ghci> liftA2 (*) [5, 10] [1, 2, 3]"
% " [5, 10, 15, 10, 20, 30]"
% ""
% "If you want to apply unary function to each element of the list, use 'map':"
% ""
% " ghci> map negate [2, -1, 0, -5]"
% " [-2, 1, 0, 5]"
% ""
instance TypeError ListNumMessage => Num [a]
type FunEqMessage (arg :: Type) (res :: Type)
= "You've attempted to compare two functions of the type:"
% ""
% " " <> (arg -> res)
% ""
% "To compare functions their argument should be one of the following types:"
% ""
% " Bool, Int8, Word8"
% ""
% "However, the functions have the following argument type:"
% ""
% " " <> arg
% ""
type family CheckFunArg (arg :: Type) (res :: Type) :: Constraint where
CheckFunArg Bool _ = ()
CheckFunArg Int8 _ = ()
CheckFunArg Word8 _ = ()
CheckFunArg arg r = TypeError (FunEqMessage arg r)
instance (CheckFunArg a b, Bounded a, Enum a, Eq b) => Eq (a -> b) where
(==) :: (a -> b) -> (a -> b) -> Bool
f == g = let universe = [minBound .. maxBound]
in map f universe == map g universe
boolId1, boolId2, boolId3 :: Bool -> Bool
boolId1 = id
boolId2 = not . not
boolId3 = not
inc1, inc2 :: Int -> Int
inc1 = (+1)
inc2 = succ
class CompilerError (msg :: ErrorMessage)
instance TypeError msg => CompilerError msg
type ParseDeprecated
= "Function 'parse' was deprecated in my-parser-1.2.6.0."
% "It will be deleted in my-parser-1.3.0.0."
% "Use 'parseConfig' instead."
% ""
% "See the following issue for motivation:"
% ""
% " * https://github.com/user/my-parser/issue/42"
% ""
parse :: CompilerError ParseDeprecated => FilePath -> IO ()
parse = error "unreachable"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment