polymorphic-lens-type.hs

polymorphic-lens-type.hs

#!/usr/bin/env stack
-- stack runghc --resolver lts-7.7 --install-ghc --package lens

{-# LANGUAGE PackageImports #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE RankNTypes #-}

-- that's what I was looking for,
-- thanks to 'shachaf' from #haskell-lens on Freenode IRC.
{-# LANGUAGE NoMonomorphismRestriction #-}

import "lens" Control.Lens (Lens', traverse, view, over)
import "lens" Control.Lens.TH (makeLenses)


type Point = (Int, Int)

data Proton   = Proton   { _protonPosition   :: Point } deriving (Show, Eq)
data Electron = Electron { _electronPosition :: Point } deriving (Show, Eq)
data Atom     = Atom     { _electrons :: [Electron]
                         , _protons :: [Proton]
                         , _electron :: Electron
                         , _proton :: Proton
                         } deriving (Show, Eq)

makeLenses ''Proton
makeLenses ''Electron
makeLenses ''Atom


defAtom :: Atom
defAtom = Atom { _electrons = []
               , _protons   = [ Proton { _protonPosition = (10, 20) }
                              , Proton { _protonPosition = (100, 200) }
                              , Proton { _protonPosition = (1000, 2000) }
                              ]
               , _electron  = Electron { _electronPosition = (5, 6) }
               , _proton    = Proton   { _protonPosition   = (7, 8) }
               }


main :: IO ()
main = do

  separate

  -- now I don't have to describe explicit types for my local lenses
  -- that used both as getters and setters.
  let -- lens :: Lens' Atom Point
      lens = electron . electronPosition

  let atom = defAtom
  print $ view lens atom
  let atom2 = over lens (\(a, b) -> (a + 10, b + 20)) atom
  print atom2

  -- separate

  -- let lensT = protons . traverse . protonPosition
  --     atom3 = over lensT (\(a, b) -> (a + 1, b + 2)) atom2
  -- print atom3

  separate

  where separate = putStrLn "----------------------------------------"