{-|
Module      : LensUtils
Description : Lens utility functions
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

This module provides functions that are useful with lenses.

-}
module LensUtils
  (
  -- * Strict update operations
    overStrict
  , setStrict

  -- * time lenses
  , zonedTimeLocalTime
  , localTimeTimeOfDay
  , localTimeDay
  ) where

import           Control.Lens
import           Data.Time
import           StrictUnit

-- | Modify the target of a 'Setter' with a function. The result
-- is strict in the results of applying the function. Strict version
-- of 'over'
overStrict :: LensLike ((,) StrictUnit) s t a b -> (a -> b) -> s -> t
overStrict :: LensLike ((,) StrictUnit) s t a b -> (a -> b) -> s -> t
overStrict LensLike ((,) StrictUnit) s t a b
l a -> b
f = (StrictUnit, t) -> t
forall b. (StrictUnit, b) -> b
run ((StrictUnit, t) -> t) -> (s -> (StrictUnit, t)) -> s -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike ((,) StrictUnit) s t a b
l (b -> (StrictUnit, b)
forall b. b -> (StrictUnit, b)
nur (b -> (StrictUnit, b)) -> (a -> b) -> a -> (StrictUnit, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  where
    nur :: b -> (StrictUnit, b)
nur b
y = (b
y b -> StrictUnit -> StrictUnit
`seq` StrictUnit
StrictUnit, b
y)
    run :: (StrictUnit, b) -> b
run (StrictUnit
StrictUnit,b
y) = b
y
{-# INLINE overStrict #-}

-- | Set a value strictly in the set value. Strict version of 'set'.
setStrict :: ASetter s t a b -> b -> s -> t
setStrict :: ASetter s t a b -> b -> s -> t
setStrict ASetter s t a b
l b
x = ASetter s t a b -> b -> s -> t
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter s t a b
l (b -> s -> t) -> b -> s -> t
forall a b. (a -> b) -> a -> b
$! b
x
{-# INLINE setStrict #-}

-- | 'Lens' to the 'LocalTime' component of a 'ZonedTime'
zonedTimeLocalTime :: Lens' ZonedTime LocalTime
zonedTimeLocalTime :: (LocalTime -> f LocalTime) -> ZonedTime -> f ZonedTime
zonedTimeLocalTime LocalTime -> f LocalTime
f (ZonedTime LocalTime
t TimeZone
z) = (LocalTime -> TimeZone -> ZonedTime
ZonedTime (LocalTime -> TimeZone -> ZonedTime)
-> TimeZone -> LocalTime -> ZonedTime
forall (f :: * -> *) a b. Functor f => f (a -> b) -> a -> f b
?? TimeZone
z) (LocalTime -> ZonedTime) -> f LocalTime -> f ZonedTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LocalTime -> f LocalTime
f LocalTime
t
{-# INLINE zonedTimeLocalTime #-}

-- | 'Lens' to the 'TimeOfDay component of a 'LocalTime'.
localTimeTimeOfDay :: Lens' LocalTime TimeOfDay
localTimeTimeOfDay :: (TimeOfDay -> f TimeOfDay) -> LocalTime -> f LocalTime
localTimeTimeOfDay TimeOfDay -> f TimeOfDay
f (LocalTime Day
d TimeOfDay
t) = Day -> TimeOfDay -> LocalTime
LocalTime Day
d (TimeOfDay -> LocalTime) -> f TimeOfDay -> f LocalTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TimeOfDay -> f TimeOfDay
f TimeOfDay
t
{-# INLINE localTimeTimeOfDay #-}

-- | 'Lens' to the 'TimeOfDay component of a 'LocalTime'.
localTimeDay :: Lens' LocalTime Day
localTimeDay :: (Day -> f Day) -> LocalTime -> f LocalTime
localTimeDay Day -> f Day
f (LocalTime Day
d TimeOfDay
t) = (Day -> TimeOfDay -> LocalTime
LocalTime (Day -> TimeOfDay -> LocalTime) -> TimeOfDay -> Day -> LocalTime
forall (f :: * -> *) a b. Functor f => f (a -> b) -> a -> f b
?? TimeOfDay
t) (Day -> LocalTime) -> f Day -> f LocalTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Day -> f Day
f Day
d
{-# INLINE localTimeDay #-}