Operator.hs

{-|
Module      : Data.Vinyl.Utils.Operator
Copyright   : (c) Marcin Mrotek, 2014
License     : BSD3
Maintainer  : marcin.jan.mrotek@gmail.com

Operations on records parametrized with various kinds of functions.
-}

{-# LANGUAGE 
      ConstraintKinds
    , DataKinds
    , FlexibleContexts
    , FlexibleInstances
    , MultiParamTypeClasses
    , PolyKinds 
    , RankNTypes
    , ScopedTypeVariables
    , TypeFamilies
    , TypeOperators
    #-}

{-# OPTIONS_HADDOCK show-extensions #-}

module Data.Vinyl.Utils.Operator (
      operator
    , (/$/), (/$$/), (\$\), (\$$\), (\&&\), (\||\)
) where

import Data.Functor.Contravariant
import Data.Vinyl
import Data.Vinyl.Functor

operator :: (forall t. f t -> g t -> h t) -> Rec f rs -> Rec g rs -> Rec h rs
-- ^Create an operator between records sharing their fields but differing in functors.
operator _ RNil RNil = RNil
operator f (a :& as) (b :& bs) = (f a b) :& operator f as bs
operator _ RNil _ = error "impossible"
operator _ _ RNil = error "impossible"

(/$/) :: Functor f => Rec ((->) a) rs -> Rec (Const (f a)) rs -> Rec f rs
-- ^Apply a record of (a -> x) functions to a constant type record to obtain a plain f-record.
(/$/) = operator (\f (Const x) -> f <$> x)

(/$$/) :: Rec (Compose ((->) a) f) rs -> Rec (Const a) rs -> Rec f rs
-- ^Apply a record of (a -> f x) functions to a constant type record to obtain a plain f-record.
(/$$/) = operator (\(Compose f) (Const x) -> f x)

(\$\) :: Functor f => Rec (Op a) rs -> Rec f rs -> Rec (Const (f a)) rs
-- ^Apply a record of (x -> a) functions to a plain f-record to obtain a constant type record.
(\$\) = operator (\(Op f) x -> Const $ f <$> x)

(\$$\) :: Rec (Compose (Op a) f) rs -> Rec f rs -> Rec (Const a) rs
-- ^Apply a record of (f x -> a) functions to a plain f-record to obtain a constant type record.
(\$$\) = operator (\(Compose (Op f)) x -> Const $ f x)

predicate :: Functor f => Predicate t -> f t -> Const (f Bool) a
predicate (Predicate p) x = Const $ p <$> x

(\&&\) :: forall f rs. Applicative f => Rec Predicate rs -> Rec f rs -> f Bool
-- ^Apply a predicate record to a plain f-record to obtain a boolean product inside the f functor.
(\&&\) p r = go result $ pure True
    where
        go :: Rec (Const (f Bool)) xs -> f Bool -> f Bool
        go RNil b = b
        go (Const a :& as) b = go as $ (&&) <$> a <*> b
        result :: Rec (Const (f Bool)) rs
        result = operator predicate p r
    
(\||\) :: forall f rs. Applicative f => Rec Predicate rs -> Rec f rs -> f Bool
-- ^Apply a predicate record to a plain f-record to obtain a boolean sum inside the f functor.
(\||\) p r = go result $ pure False
    where 
        go :: Rec (Const (f Bool)) xs -> f Bool -> f Bool
        go RNil b = b
        go (Const a :& as) b = go as $ (||) <$> a <*> b
        result :: Rec (Const (f Bool)) rs
        result = operator predicate p r