lens.hs

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE RankNTypes #-}

module Main where

import Data.Functor.Const
import Data.Functor.Identity (Identity (..))
import Data.Monoid

data Profile = Profile {user :: User}
  deriving (Show)

data User = User {name :: String, age :: Int}
  deriving (Show)

-- json, json2 :: String
-- json2 = json & key "a" . elems . key "b" . _Number %~ (+1)

-- profile & template @String <>~ "---"

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

type Lens' s a = Lens s s a a

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

type Traversal' s a = Traversal s s a a

updateUser :: Lens' Profile User
updateUser f (Profile user) = Profile <$> f user

updateName :: Lens' User String
updateName f (User name age) = (\name -> User name age) <$> f name

updateAge :: Lens' User Int
updateAge f (User name age) = (\age -> User name age) <$> f age

over :: ((a -> Identity b) -> (s -> Identity t)) -> (a -> b) -> s -> t
over setter f = runIdentity . setter (Identity . f)

view :: ((a -> Const a b) -> (s -> Const a t)) -> s -> a
view getter s = getConst $ getter Const s

_1 :: Functor f => (a -> f c) -> ((a, b) -> f (c, b))
_1 f (a, b) = (\a -> (a, b)) <$> f a

_2 :: Functor f => (b -> f c) -> ((a, b) -> f (a, c))
_2 f (a, b) = (\b -> (a, b)) <$> f b

-- firstTwo :: Applicative f => (a -> f b) -> ((a, a, c) -> f (b, b, c))
firstTwo :: Traversal (a, a, c) (b, b, c) a b
firstTwo next (a, b, c) =
  (,,) <$> next a <*> next b <*> pure c

to f next x = next (f x)

-- class Traversable t where
--   traverse :: Applicative f => (a -> f b) -> (t a -> f (t b))

x :: (Int, Int, String) -> (Int, Int, String)
x = over (firstTwo . filtered (> 2)) (* 10)

toListOf lens = view (lens . to (\x -> [x]))

preview lens = getFirst . view (lens . to (First . Just))

_Just :: Traversal (Maybe a) (Maybe b) a b
_Just next (Just x) = Just <$> next x
_Just _ Nothing = pure Nothing

-- view (re (_Just . _Just)) 3 -- Just (Just 3)

(^..) = flip toListOf

(^?) = flip preview

y = [(x, Just (even x)) | x <- [1 .. 10]] ^.. (each . filteredBy (_2 . _Just . only True) . _1)

z = over (each . filteredBy (_2 . _Just . only True) . _1) (* 10) [(x, Just (even x)) | x <- [1 .. 10]]

-- y = view (each . to (\x -> First (Just x))) []

-- each :: Traversal [a] [b] a b
each :: Applicative f => (a -> f b) -> ([a] -> f [b])
each _ [] = pure []
each f (x : xs) = pure (:) <*> f x <*> each f xs

filtered :: (a -> Bool) -> Traversal' a a
filtered pred next x | pred x = next x
filtered _ _ x = pure x

has getter x = not (null (x ^? getter))

hasn't getter = not . has getter

filteredBy getter = filtered (has getter)

only :: Eq a => a -> Traversal' a a
only x = filtered (== x)

main :: IO ()
main = pure ()