draft.hs

{-# LANGUAGE DeriveFunctor         #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeOperators         #-}

import           GHC.Generics

main :: IO ()
main = putStrLn "Hello"

class (Functor f, Functor g) => f :<: g where
  inj :: f a -> g a

instance Functor f => f :<: f where
  inj = id

instance {-# OVERLAPS #-} (Functor f, Functor g) => f :<: (f :+: g) where
  inj = L1

instance (Functor f, Functor g, Functor h, f :<: g) => f :<: (h :+: g) where
  inj = R1 . inj

data Order = Order deriving Eq

newtype Bulk a = Bulk {- ByLoadId X -} a deriving (Eq, Functor)
newtype Mass a = Mass {- ByLoadId Y -} a deriving (Eq, Functor)
newtype Pallet a = Pallet {- ByLoadId Z -} a deriving (Eq, Functor)

type SomeOrder = (Bulk :+: Mass :+: Pallet) Order

x :: SomeOrder
x = inj $ Bulk Order

y :: SomeOrder
y = inj $ Mass Order

z :: Bool
z = x == y