FP_HSE2020Fall_15prLens

Fp15prLens.hs

{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
module Fp15prLens where

import Data.Functor.Const (Const(Const, getConst))
import Data.Functor.Identity (Identity(Identity, runIdentity))

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

--      (s -> a) -> (s -> a -> s) -> (a -> f a) -> s -> f s
lens :: (s -> a) -> (s -> a -> s) -> Lens s a
lens get set = \ret s -> fmap (set s) (ret $ get s)

{-
_2 :: Lens (a,b) b   -- (b -> f b) -> (a,b) -> f (a,b)
_2 f (x,y) = fmap ((,) x) (f y)

_1 :: Lens (a,b) a   -- (a -> f a) -> (a,b) -> f (a,b)
_1 = lens (\(x,_) -> x) (\(_,y) v -> (v,y))
-}

-- Геттер
--      ((a -> Const a a) -> s -> Const a s) -> s -> a
view :: Lens s a                             -> s -> a
view lns s = getConst (lns Const s)

-- Сеттер
--      ((a -> Identity a) -> s -> Identity s) -> (a -> a) -> s -> s
over :: Lens s a                               -> (a -> a) -> s -> s
over lns fn s = runIdentity $ lns (Identity . fn) s

--     ((a -> Identity a) -> s -> Identity s) -> a -> s -> s
set :: Lens s a                               -> a -> s -> s
set lns a s = runIdentity $ lns (Identity . const a) s


-------------------------------------------------------------  
class Field1 s a where
  _1 :: Lens s a

  
class Field2 s a where
  _2 :: Lens s a 


class Field3 s a  where
  _3 :: Lens s a 

{-
GHCi> view _1 ('a',12,False)
12
GHCi> over _2 succ (True,41,"ABC")
(True,42,"ABC")

GHCi> over _1 (^2) (3,True,"ABC")
(9,True,"ABC")
GHCi> over _3 tail (3,True,"ABC")
(3,True,"BC")
-}