DerivingVia and SOP experiments

SOPNF.hs

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
module SOPNF where

import Control.DeepSeq
import Data.Kind
import qualified GHC.Generics as GHC
import Generics.SOP

-- Nothing about the following is truly tied to using generics-sop. A similar
-- construction should work with GHC.Generics as well. But it's a bit nicer
-- with generics-sop because the notion of a code is more explicit.

-- * 'NFData' generically using generics-sop

-- | Generic version of 'rnf', operating on sums of products.
--
grnf :: forall code . (All2 NFData code, All SListI code) => SOP I code -> ()
grnf = rnf . hcollapse . hcmap (Proxy @NFData) (mapIK rnf)

-- | Adapter for using the SOP default with @DerivingVia@.
--
newtype SOPGeneric a = SOPGeneric a

-- | Generic instance just converts and calls 'grnf'.
--
instance (Generic a, All2 NFData (Code a)) => NFData (SOPGeneric a) where
  rnf (SOPGeneric x) = grnf @(Code a) (from x)

-- | Example small datatype where we can use the SOP-generic default
-- we just defined.
--
data MySmallType = MySmallType Int Bool
  deriving (GHC.Generic, Generic)
  deriving NFData via (SOPGeneric MySmallType)

-- * Lifting instances via SOP-compatible codes

-- | Collection of constraints that expesses that a given type @a@ has an SOP code
-- that is compatible with @code@. Here, compatibility of two codes means that all
-- types occurring in the codes are pointwise coercible into each other.
--
type SOPCompatible (a :: Type) (code :: [[Type]]) =
  ( Generic a
  , AllZip2 (LiftedCoercible I I) (Code a) code
  , All SListI code
  )

-- | A modified version of 'from' that does not map a type to its SOP representation,
-- but to a given compaitble SOP representation as indicated by @code@.
--
fromCompatible :: forall a code . (SOPCompatible a code) => a -> SOP I code
fromCompatible = hcoerce . from

-- | Adapter for making use of an SOP-compatible code in instances.
--
newtype SOPCompatibleWith a (code :: [[Type]]) = SOPCompatibleWith a

-- | Adapted instance can reuse the same 'grnf' as above.
--
instance (SOPCompatible a code, All2 NFData code) => NFData (SOPCompatibleWith a code) where
  rnf (SOPCompatibleWith x) = grnf @code (fromCompatible x)

-- * Example

-- | The purpose of 'Foo' is just to actually check whether it all works as expected,
-- as there *is* an instance @NFData (a -> b)@, but there is no instance @NFData Foo@.
--
newtype Foo = Foo (Int -> Char)

-- | We use the 'Ignore' newtype as an adapter so that we do not have to provide an
-- 'NFData' instance for the wrapped type.
--
newtype Ignore a = Ignore { runIgnore :: a }

-- | Instance that ignores the wrapped type.
--
instance NFData (Ignore a) where
  rnf _ = ()

-- | Another small datatype which makes use of 'Foo', so that we cannot
-- use the normal 'NFData' instances.
--
data AnotherSmallType = AnotherSmallType Int Foo Bool
  deriving (GHC.Generic, Generic)
  deriving NFData via (AnotherSmallType `SOPCompatibleWith` '[ '[ Int, Ignore Foo, Bool ] ])

-- * Computing the modified / compatible code via type-level functions

-- The following three type families recursively traverse the list of list
-- of types that is a code and replace all members of the exclusion list with
-- 'Ignore'-wrapped versions.
--
-- Of course, this can be done in various other ways that would be more
-- generic and reusable for other similar replacement / modification operations.

type family Exclude (es :: [Type]) (code :: [[Type]]) :: [[Type]] where
  Exclude es '[]      = '[]
  Exclude es (x : xs) = Exclude' es x ': Exclude es xs

type family Exclude' (es :: [Type]) (xs :: [Type]) :: [Type] where
  Exclude' es '[]      = '[]
  Exclude' es (a : xs) = Exclude'' es a : Exclude' es xs

type family Exclude'' (es :: [Type]) (x :: Type) :: Type where
  Exclude'' '[]      x = x
  Exclude'' (e : es) e = Ignore e
  Exclude'' (e : es) x = Exclude'' es x

-- | Adapter for using a code with excluded types in instances.
newtype Excluding (es :: [Type]) (a :: Type) = Excluding a

-- | The `NFData` instance for 'Excluding' can be derived.
-- Standalone deriving is necessary here because the context cannot
-- be inferred. (Not entirely clear to me why not.)
--
deriving via (a `SOPCompatibleWith` Exclude es (Code a))
  instance (SOPCompatible a (Exclude es (Code a)), All2 NFData (Exclude es (Code a))) => NFData (Excluding es a)

-- | Example of somewhat bigger type using exclusion by type.
--
data MyBigType =
  MyBigType
    { f1 :: Int
    , f2 :: Double
    , f3 :: Foo
    , f4 :: Char
    }
  deriving (GHC.Generic, Generic)
  deriving NFData via (Excluding '[ Foo ] MyBigType)