progLA.hs

{-# LANGUAGE GADTs, FlexibleContexts, TemplateHaskell #-}
import Control.Monad.State
import qualified Data.IntMap as M
import Control.Lens

data Field = Field String (M.IntMap Chara) deriving (Show)
data Chara = Chara String deriving (Show)
updateField f (Field s m) = Field (f s) m
updateChara f (Chara s) = Chara (f s)

sync :: ((Field, Chara) -> (Field, Chara)) -> Field -> Field
sync f e@(Field _ c) = let (Field s k,c') = f (e, c M.! 0) in Field s $ M.insert 0 c' $ k

type LA p q = State (p, q)

runLA = execState

hook (Left f) = _1 %= f
hook (Right f) = _2 %= f

parent = use _1

self = use _2

prog :: LA Field Chara ()
prog = do
  hook $ Right $ updateChara ("1/"++)
  c <- self
  hook $ Left $ (\(Field s m) -> Field s (M.insert 1 c m))
  hook $ Right $ updateChara ("2/"++)
  Chara s <- self
  hook $ Left $ updateField (take 2 s++)
  Field s _ <- parent
  c <- self
  hook $ Left $ (\(Field s m) -> Field s (M.insert 2 c m))
  hook $ Right $ updateChara (++("//field:" ++ s))

main = do
  let e = Field "field" $ M.singleton 0 $ Chara "charaA"
  print $ e
  print $ sync (runLA prog) e