-- |
-- Module     : Unbound.Generics.LocallyNameless.Internal.Fold
-- Copyright  : (c) 2014, Aleksey Kliger
-- License    : BSD3 (See LICENSE)
-- Maintainer : Aleksey Kliger
-- Stability  : experimental
--
-- Some utilities for working with Folds.
--
-- If you are using <http://hackage.haskell.org/package/lens lens>, you don't need this module.
{-# LANGUAGE RankNTypes #-}
module Unbound.Generics.LocallyNameless.Internal.Fold (Fold, Traversal', toListOf, filtered, justFiltered, foldMapOf) where

import Control.Applicative
import Data.Maybe (fromJust)
import Data.Functor.Contravariant
import Data.Monoid

type Getting r s a = (a -> Const r a) -> s -> Const r s

type Fold s a = forall f . (Contravariant f, Applicative f) => (a -> f a) -> s -> f s

type Traversal' s a = forall f . Applicative f => (a -> f a) -> s -> f s

toListOf :: Fold s a -> s -> [a]
-- toListOf :: Getting (Endo [a]) s a -> s -> [a]
toListOf :: forall s a. Fold s a -> s -> [a]
toListOf Fold s a
l = Getting (Endo [a]) s a -> (a -> [a] -> [a]) -> [a] -> s -> [a]
forall r s a. Getting (Endo r) s a -> (a -> r -> r) -> r -> s -> r
foldrOf Getting (Endo [a]) s a
Fold s a
l (:) []
{-# INLINE toListOf #-}

foldMapOf :: Getting r s a -> (a -> r) -> s -> r
foldMapOf :: forall r s a. Getting r s a -> (a -> r) -> s -> r
foldMapOf Getting r s a
l a -> r
f = Const r s -> r
forall {k} a (b :: k). Const a b -> a
getConst (Const r s -> r) -> (s -> Const r s) -> s -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting r s a
l (r -> Const r a
forall {k} a (b :: k). a -> Const a b
Const (r -> Const r a) -> (a -> r) -> a -> Const r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> r
f)
{-# INLINE foldMapOf #-}

foldrOf :: Getting (Endo r) s a -> (a -> r -> r) -> r -> s -> r
foldrOf :: forall r s a. Getting (Endo r) s a -> (a -> r -> r) -> r -> s -> r
foldrOf Getting (Endo r) s a
l a -> r -> r
f r
z = (Endo r -> r) -> (s -> Endo r) -> s -> r
forall a b. (a -> b) -> (s -> a) -> s -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Endo r -> r -> r) -> r -> Endo r -> r
forall a b c. (a -> b -> c) -> b -> a -> c
flip Endo r -> r -> r
forall a. Endo a -> a -> a
appEndo r
z) (Getting (Endo r) s a -> (a -> Endo r) -> s -> Endo r
forall r s a. Getting r s a -> (a -> r) -> s -> r
foldMapOf Getting (Endo r) s a
l ((r -> r) -> Endo r
forall a. (a -> a) -> Endo a
Endo ((r -> r) -> Endo r) -> (a -> r -> r) -> a -> Endo r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> r -> r
f))
{-# INLINE foldrOf #-}

filtered :: (a -> Bool) -> Traversal' a a
filtered :: forall a. (a -> Bool) -> Traversal' a a
filtered a -> Bool
p a -> f a
afa a
x = if a -> Bool
p a
x then a -> f a
afa a
x else a -> f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
{-# INLINE filtered #-}

justFiltered :: (a -> Maybe b) -> Fold a b
justFiltered :: forall a b. (a -> Maybe b) -> Fold a b
justFiltered a -> Maybe b
p b -> f b
bfb a
x = case a -> Maybe b
p a
x of
                        Just b
b -> (a -> b) -> f b -> f a
forall a' a. (a' -> a) -> f a -> f a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (Maybe b -> b
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe b -> b) -> (a -> Maybe b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe b
p) (b -> f b
bfb b
b)
                        Maybe b
Nothing -> a -> f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
{-# INLINE justFiltered #-}