A functor whose type parameter is nominal.

List.hs

{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RoleAnnotations #-}

module List (List, fromText, list, unList) where

import qualified Data.Text as T

type role List nominal
data List a where
    Nil :: List a
    Cons :: a -> List a -> List a
    IsText :: T.Text -> List Char

instance Functor List where
    fmap _ Nil = Nil
    fmap f (Cons x xs) = Cons (f x) (fmap f xs)
    fmap f (IsText text) = foldr Cons Nil $ fmap f (T.unpack text)

list :: [a] -> List a
list = foldr Cons Nil

fromText :: T.Text -> List Char
fromText = IsText

unList :: List a -> [a]
unList Nil = []
unList (Cons x xs) = x : unList xs
unList (IsText text) = T.unpack text

-- This whole facade comes crashing down unless you hide the constructors.
-- I.e. if you don't hide the constructors, it is very easy to write a
-- "function" such that `xs == ys` but `f xs /= f ys`.
-- To prevent this, you have to prevent people from pattern matching the
-- constructors and force access through `unList`.
instance Eq a => Eq (List a) where
    xs == ys = unList xs == unList ys

ListTest.hs

module Test where

import List

import Control.Monad
import Data.Maybe
import System.Random

import qualified Data.Map as M
import qualified Data.Text as T

main :: IO ()
main = void $ flip traverse [1..100 :: Integer] $ \i -> do
    f <- randomFunction [minBound..maxBound]
    g <- randomFunction [minBound..maxBound]
    xs <- randomCharList
    guard $ fmap id xs == xs
    guard $ fmap (f . g) xs == (fmap f . fmap g) xs
    putStrLn ("Trial " <> show i <> " passed!")

-- random finite list, length 0 to 999
randomsIO :: Random a => IO [a]
randomsIO = do
    n <- ((mod 1000) . abs) <$> randomIO
    gen <- newStdGen
    return $ take n (randoms gen)

-- random partial function
randomFunction :: (Ord a, Random a) => [a] -> IO (a -> a)
randomFunction domain = do
    gen <- newStdGen
    let range = randoms gen
    let store = M.fromList (zip domain range)
    return $ \n -> fromJust (M.lookup n store)

-- text half the time, cons half the time
randomCharList :: IO (List Char)
randomCharList = do
    isText <- randomIO :: IO Bool
    if isText
        then fromText . T.pack <$> randomsIO
        else list <$> randomsIO