{-# LANGUAGE DeriveFunctor, TypeFamilies, PatternSynonyms, RankNTypes #-} module Data.Functor.Holey ( -- * The @Holey@ type family Holey -- * Types , HoleF(..) -- ** Patterns for hiding @Fix@ , pattern Hole , pattern Existing -- * Utility functions , whole , plug , punch ) where import Data.Functor.Foldable (Fix(..), unfix, fold, unfold) import Data.Functor.Decomposed -- | @HoleF f@ transforms the functor @f@ to add "holes". data HoleF f t = HoleF -- ^ A hole. | ExistingF (f t) -- ^ A normal value. deriving (Eq, Ord, Functor) pattern Hole = Fix HoleF pattern Existing e = Fix (ExistingF e) instance Decomposed HoleF where fmap1 _ HoleF = HoleF fmap1 f (ExistingF e) = ExistingF (f e) -- | If @T@ is a type that is defined as a fixpoint, then -- a @Holey T@ will be the type of "@T@s with holes". type family Holey f type instance Holey (Fix f) = Fix (HoleF f) -- | Upgrade a value of type @T@ to a value of type -- @T@-with-holes, without actually introducing any holes. whole :: Functor f => Fix f -> Fix (HoleF f) whole = unfold (ExistingF . unfix) -- | Fill all holes in a data structure with the given value. plug :: Functor f => Fix f -> Fix (HoleF f) -> Fix f plug x = fold phi where phi HoleF = x phi (ExistingF e) = Fix e -- | Replace any substructure matching the predicate with a hole. punch :: Functor f => (Fix f -> Bool) -> Fix f -> Fix (HoleF f) punch test = unfold phi where phi x@(Fix e) = if test x then HoleF else ExistingF e