sub.hs

{-# language TypeOperators #-}
{-# language PatternSynonyms #-}
{-# language MultiParamTypeClasses #-}
{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language ViewPatterns #-}
module Sub where

import Control.Lens

class (sub :: k -> *) :<: (sup :: k -> *) where
  subP :: Prism' (sup a) (sub a)

-- | Inject a subtype into a supertype via 'subP'
inject  :: sub :<: sup => sub a -> sup a
inject = review subP

-- | Try to project a subtype from a supertype via 'subP'
project :: sub :<: sup => sup a -> Maybe (sub a)
project = preview subP

instance f :<: f where
  subP = id

pattern Inj :: sub :<: sup => sub a -> sup a
pattern Inj a <- (project -> Just a) where
  Inj a = inject a