Record + Tuples lenses

Main.purs

module Main where

import Prelude

import Effect (Effect)
import Data.Foldable (fold)
import TryPureScript (h1, h3, text, render, Doc)

import Data.Tuple.Nested ((/\), type (/\), Tuple4, T2, T3, T4, T5, tuple4, get1, get2, get3)
import Data.Lens (lens, Lens, Lens', _1, _2, view, over, set)
import Data.Lens.Record (prop)
import Data.String (length)
import Type.Proxy (Proxy(..))

type Event = 
  { subject :: String
  , object :: String
  , action :: String
  , count :: Int
  }
  
duringNetflix :: Event
duringNetflix = { subject : "Brian"
                , object : "Dawn"
                , action : "cafuné"
                , count : 0
                }

both :: String /\ Event
both = "example" /\ duringNetflix

_object :: forall a r. Lens {object :: String | r} {object :: a | r} String a
_object = lens _.object $ _ { object = _ }

stringified :: String /\ String
stringified = over _2 show both

fourLong :: Tuple4 Int Int Int Int
fourLong = tuple4 1 2 3 4

set1 :: forall a b z. b -> T2 a z -> T2 b z
set1 c tup = set _1 c tup

set2 :: forall a b c z. c -> T3 a b z -> T3 a c z
set2 c tup = over _2 (set1 c) tup

set3 :: forall a b c d z. d -> T4 a b c z -> T4 a b d z
set3 c tup = over _2 (set2 c) tup

set4 :: forall a b c d e z. e -> T5 a b c d z -> T5 a b c e z
set4 c tup = over _2 (set3 c) tup

_elt1 :: forall a z. Lens' (T2 a z) a
_elt1 = lens get1 (flip set1)

_elt2 :: forall a b z. Lens' (T3 a b z) b
_elt2 = lens get2 (flip set2)

_elt3 :: forall a b c z. Lens' (T4 a b c z) c
_elt3 = lens get3 (flip set3)

exerciseWidget :: Array Doc
exerciseWidget = 
  [ h1 (text $ show duringNetflix)
  , h3 (text "basics")
  , h1 (text $ view _object duringNetflix)
  , h1 (text $ show $ view (prop (Proxy :: Proxy "count")) duringNetflix)
  , h1 (text $ show $ over _object length duringNetflix )
  , h1 (text $ show $ set _object true duringNetflix)
  , h3 (text "composition")
  , h1 (text $ view (_2 <<< _object) both)
  , h1 (text $ show $ over (_2 <<< _object) length both)
  , h1 (text $ show $ set (_2 <<< _object) false both)
  , h3 (text "composition questions")
  , h1 (text $ show stringified)
  , h1 (text $ show $ over _2 (view _object) both)
  , h3 (text "tuple questions")
  , h1 (text $ show $ set1 "ONE" fourLong)
  , h1 (text $ show $ set2 "TWO" fourLong)
  , h1 (text $ show $ set3 "THREE" fourLong)
  , h1 (text $ show $ set4 "FOUR" fourLong)
  , h1 (text $ show $ over _elt1 (_ * 200) fourLong)
  , h1 (text $ show $ over _elt2 (_ * 200) fourLong)
  , h1 (text $ show $ over _elt3 (_ * 200) fourLong)
  ]

main :: Effect Unit
main = render $ fold exerciseWidget