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

{-# OPTIONS_HADDOCK show-extensions #-}

{-|
Module      : Data.Vinyl.Utils.Operator
Description : Operations on records parametrized with various kinds of functions.
Copyright   : (c) Marcin Mrotek, 2014
License     : BSD3
Maintainer  : marcin.jan.mrotek@gmail.com
-}

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

import Control.Applicative
import Data.Functor.Compose
import Data.Functor.Contravariant
import Data.Monoid
import Data.Vinyl
import Data.Vinyl.Constraint
import Data.Vinyl.TyFun

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

(/$/) :: Functor f => Rec el ((->) a) rs -> Rec el (Const (f a)) rs -> Rec el 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 el (Compose ((->) a) f) rs -> Rec el (Const a) rs -> Rec el f rs
-- ^Apply a record of (f 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 el (Op a) rs -> Rec el f rs -> Rec el (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 el (Compose (Op a) f) rs -> Rec el f rs -> Rec el (Const a) rs
-- ^Apply a record of (f x -> f a) functions to a plain f-record to obtain a constant type record.
(\$$\) = operator (\(Compose (Op f)) x -> Const $ f x)

predicate (Predicate p) x = Const $ p <$> x

(\&&\) :: forall el f rs. Applicative f => Rec el Predicate rs -> Rec el 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 el (Const (f Bool)) xs -> f Bool -> f Bool
        go RNil b = b
        go (Const a :& as) b = go as $ (&&) <$> a <*> b
        result :: Rec el (Const (f Bool)) rs
        result = operator predicate p r
    
(\||\) :: forall el f rs. Applicative f => Rec el Predicate rs -> Rec el 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 el (Const (f Bool)) xs -> f Bool -> f Bool
        go RNil b = b
        go (Const a :& as) b = go as $ (||) <$> a <*> b
        result :: Rec el (Const (f Bool)) rs
        result = operator predicate p r

p :: (a -> Bool) -> Predicate a
-- ^Shorthand for creation of predicates.
p = Predicate