{-# LANGUAGE RankNTypes #-}

module Data.HodaTime.Internal.Lens
(
   Lens
  ,view
  ,set
  ,modify
)
where

import Control.Applicative

-- This module is copied almost word for word from the basic-lens package.  We would use that instead but it's not supported by this version of stack lts
-- which means we have to use stack only features to get it to work.  So for now, we just make our own version.

-- TODO: Get rid of this and use the package when we upgrade to where it is supported

type Lens s t a b = forall f. Functor f => (a -> f b) -> (s -> f t)

newtype Id a = Id { forall a. Id a -> a
runId :: a }

instance Functor Id where fmap :: forall a b. (a -> b) -> Id a -> Id b
fmap a -> b
f = b -> Id b
forall a. a -> Id a
Id (b -> Id b) -> (Id a -> b) -> Id a -> Id b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f (a -> b) -> (Id a -> a) -> Id a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id a -> a
forall a. Id a -> a
runId

view :: Lens s t a b -> s -> a
view :: forall s t a b. Lens s t a b -> s -> a
view Lens s t a b
l = Const a t -> a
forall {k} a (b :: k). Const a b -> a
getConst (Const a t -> a) -> (s -> Const a t) -> s -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Const a b) -> s -> Const a t
Lens s t a b
l a -> Const a b
forall {k} a (b :: k). a -> Const a b
Const

modify :: Lens s t a b -> (a -> b) -> s -> t
modify :: forall s t a b. Lens s t a b -> (a -> b) -> s -> t
modify Lens s t a b
l a -> b
f = Id t -> t
forall a. Id a -> a
runId (Id t -> t) -> (s -> Id t) -> s -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Id b) -> s -> Id t
Lens s t a b
l (b -> Id b
forall a. a -> Id a
Id (b -> Id b) -> (a -> b) -> a -> Id b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

set :: Lens s t a b -> b -> s -> t
set :: forall s t a b. Lens s t a b -> b -> s -> t
set Lens s t a b
l b
a = Id t -> t
forall a. Id a -> a
runId (Id t -> t) -> (s -> Id t) -> s -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Id b) -> s -> Id t
Lens s t a b
l (b -> Id b
forall a. a -> Id a
Id (b -> Id b) -> (a -> b) -> a -> Id b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a -> b
forall a b. a -> b -> a
const b
a)