-- module NanoLens where
module Main where

import Data.Functor.Const
import Data.Functor.Identity

infixl 8 ^.
infixr 4 ~.
infixr 4 %~

over :: ((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over l f = runIdentity . l (Identity . f)
set :: ((a -> Identity b) -> s -> Identity t) -> b -> s -> t
set l = over l . const
get :: ((a -> Const a a) -> s -> Const a s) -> s -> a
get l = getConst . l Const

(^.) :: s -> ((a -> Const a a) -> s -> Const a s) -> a
(^.) = flip get
(%~) :: ((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
(%~) = over
(~.) :: ((a -> Identity b) -> s -> Identity t) -> b -> s -> t
(~.) = set

-- A boring example

data SomeExample = SomeExample { foo_ :: Int, bar_ :: Double } deriving Show
data SomeNested = SomeNested { leftEx_ :: SomeExample, rightEx_ :: SomeExample } deriving Show
-- Manually define the lenses (the tedious part)
foo :: Functor f => (Int -> f Int) -> SomeExample -> f SomeExample
foo f x = fmap (\y -> x{ foo_ = y }) $ f $ foo_ x
bar :: Functor f => (Double -> f Double) -> SomeExample -> f SomeExample
bar f x = fmap (\y -> x{ bar_ = y }) $ f $ bar_ x
leftEx :: Functor f => (SomeExample -> f SomeExample) -> SomeNested -> f SomeNested
leftEx f x = fmap (\y -> x{ leftEx_ = y }) $ f $ leftEx_ x
rightEx :: Functor f => (SomeExample -> f SomeExample) -> SomeNested -> f SomeNested
rightEx f x = fmap (\y -> x{ rightEx_ = y }) $ f $ rightEx_ x


main :: IO ()
main = do
  let example = SomeNested 
        { leftEx_ = SomeExample { foo_ = 42, bar_ = pi }
        , rightEx_ = SomeExample { foo_ = 7, bar_ = exp 1 }
        }
  print example
  print (leftEx.foo ~. 21 $ example)
  print $ example ^. rightEx.bar