Simple Applicatives for pure parallelism

Par.Data.hs

{-# LANGUAGE DerivingVia #-}

-- | A data type @Applicative Par@.
-- The layer of indirection enables explicit control over evaluation and
-- parallelism in the form of 'runPar' and 'spark' respectively.
-- @Par@ values should be passed strictly so sparks have a better chance to run.
module Par.Data (Par, runPar, spark) where

-- GHC/base
import GHC.Conc (par)

-- base
import Data.Monoid (Ap(..))

data Par a = Par a
  deriving (Show, Read, Functor)
  deriving (Semigroup, Monoid)
    via Ap Par a

runPar :: Par a -> a
runPar (Par x) = x

spark :: Par a -> Par a
spark (Par x) = x `par` Par x

instance Applicative Par where
  pure = Par
  liftA2 f (Par x) (Par y) = Par (f x y)

instance Eq  a => Eq  (Par a) where Par x    ==     Par y = x    ==     y
instance Ord a => Ord (Par a) where Par x `compare` Par y = x `compare` y

Par.Newtype.hs

{-# LANGUAGE DerivingVia #-}

-- | A newtype @Applicative Par@.
-- It's light-weight, but provides no means to control evaluation.
-- As such, the parallelism is implicit in use of @Applicative@.
-- @Par@ values must be passed lazily to avoid premature local evaluation.
module Par.Newtype (Par, runPar, foldPar) where

-- GHC/base
import GHC.Conc (par, pseq)

-- base
import Data.Monoid (Ap(..))

newtype Par a = Par a
  deriving (Show, Read, Functor)
  deriving (Semigroup, Monoid)
    via Ap Par a

runPar :: Par a -> a
runPar (Par x) = x

foldPar :: (Foldable f, Monoid a) => f a -> a
foldPar = runPar . foldMap Par

instance Applicative Par where
  pure = Par
  liftA2 f (Par x) (Par y) = Par (x `par` y `pseq` f x y)

instance Eq  a => Eq  (Par a) where
  p1 == p2 = runPar (liftA2 (==) p1 p2)

instance Ord a => Ord (Par a) where
  compare p1 p2 = runPar (liftA2 compare p1 p2)