Unfilled.hs

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wall #-}
-- The checks of inheritance (inheritUnfilled) have a constraint that their body does not use, by design.
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- | The data type @Unfilled@: a field that has not been filled in, at its path.
module ReOC.Data.Unfilled (
  Unfilled (..),
  UnfilledLike (..),
  lawNamesUnfilled,
  InheritUnfilled,
  inheritUnfilled,
) where

import Control.Lens (Optic, cloneLens, view)
import Data.Functor.Const (Const)
import ReOC.Data.Step (Step)
import ReOC.Name.Path (PathLike (..))

-- | A field that has not been filled in, at its path.
newtype Unfilled = Unfilled [Step]
  deriving (Eq, Ord, Show)

-- | The name of the data type @Unfilled@.
class UnfilledLike p f x x' where
  unfilled ::
    Optic p f x x' Unfilled Unfilled

-- | Identity
instance (x' ~ Unfilled) => UnfilledLike p f Unfilled x' where
  unfilled = id

-- | Lens
instance (p ~ (->), Functor f, x' ~ Unfilled) => PathLike p f Unfilled x' where
  path f (Unfilled x1) = fmap Unfilled (f x1)

{- | Rebuilds a value from the name of each field or constructor.

Laws:

> lawNamesUnfilled == id
-}
lawNamesUnfilled :: Unfilled -> Unfilled
lawNamesUnfilled s =
  Unfilled
    (view (cloneLens path) s)

-- | The classes that a data type holding @Unfilled@ in one field, or in one or more constructors, inherits.
type InheritUnfilled s =
  ( UnfilledLike (->) (Const ()) s s
  , PathLike (->) (Const ()) s s
  )

-- | Checks that a data type inherits every class of @InheritUnfilled@.
inheritUnfilled :: (InheritUnfilled s) => proxy s -> ()
inheritUnfilled _ = ()