Examples of custom type errors

TypeError.hs

{-# 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"