Main.hs

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

import           Control.Lens

newtype Key model keytype = Key { unKey :: keytype }
    deriving (Show, Eq, Ord)

makeWrapped ''Key

data A1 = A1 (Key A1 Int) deriving Show
data A2 = A2 (Key A2 Int) deriving Show


problemWithKey = do
    let k = Key 1
        a1 = A1 k
        a2 = A2 k
        -- Oh noes! Didn't prevent me from sharing key between two different
        -- types!
    print a1
    print a2



class ClosedTFKey a where
    type KeyT a
    getKey :: a -> KeyT a

data B1 = B1 Int deriving Show

instance ClosedTFKey B1 where
    type KeyT B1 = Int
    getKey (B1 i) = i

data B2 = B2 Int deriving Show

instance ClosedTFKey B2 where
    type KeyT B2 = Int
    getKey (B2 i) = i

problemWithClosedTFKey = do
    let someRandomInt = 42
        b1 = B1 someRandomInt
        -- Oh noes! Didn't prevent me from constructing with a value that might
        -- be inappropriate!
        b2 = B2 (getKey b1)
        -- Also didn't prevent me from sharing a key between two different types
    print b1
    print b2


data family OpenDFKey a
data instance OpenDFKey C1 = C1Key Int deriving Show

data C1 = C1 (OpenDFKey C1) deriving Show

newtype C2Key = C2Key Int deriving Show

data C2 = C2 C2Key deriving Show

openDFKeySameAsNewtypeKey = do
    let k1 = C1Key 1
        c1 = C1 k1

        k2 = C2Key 2
        c2 = C2 k2
        -- There's no usable difference between a open data family and using a
        -- newtype
    print c1
    print c2

main = problemWithKey >> problemWithClosedTFKey >> openDFKeySameAsNewtypeKey