Hoodlums: Purely Functional Text Editing

Prac1_handleKey.hs

------------------------------------------------------------
-- Hoodlums: Purely Functional Text Editing
--
-- handleKey implementation for Prac1.hs
-- see https://personal.cis.strath.ac.uk/conor.mcbride/CS410/
--
-- Note: you will also need to change the "Here" data type to
-- accomodate a String payload
--

handleKey :: Key -> TextCursor -> Maybe (Damage, TextCursor)

handleKey (CharKey '(') (sz, (cz, Here{}, cs), ss)
               = Just (LineChanged, (sz, (cz, Here cs, []), ss))

handleKey (CharKey ')') (sz, (cz, Here xs, cs), ss)
               = Just (LineChanged, (sz, (cz, Here xs, xs ++ cs), ss))

handleKey (CharKey c) (sz, (cz, h, cs), ss)
               = Just (LineChanged, (sz, (cz :< c, h, cs), ss))
handleKey (ArrowKey _ LeftArrow)  (sz, (cz :< c, h, cs), ss)
               = Just (PointChanged, (sz, (cz, h, c:cs), ss))
handleKey (ArrowKey _ RightArrow) (sz, (cz, h, c:cs), ss)
               = Just (PointChanged, (sz, (cz :< c, h, cs), ss))
handleKey (ArrowKey _ UpArrow)  (sz :< z, crsr, ss)
               = let (pos, oldline) = deactivate crsr
                     newcrsr = activate (pos, z)
                 in Just (LotsChanged, (sz, newcrsr, oldline : ss))
handleKey (ArrowKey _ DownArrow)  (sz, crsr, s:ss)
               = let (pos, oldline) = deactivate crsr
                     newcrsr = activate (pos, s)
                 in Just (LotsChanged, (sz :< oldline, newcrsr, ss))
handleKey (Return)   (sz, (cz, h, cs), ss)
               = Just (LotsChanged, (sz :< bwdToList cz, (B0, h, cs), ss))
handleKey _ _ = Nothing

bwdToList :: Bwd a -> [a]
bwdToList = go []
  where
   go ys B0        = ys
   go ys (xs :< x) = go (x:ys) xs

test = bwdToList ((((B0 :< 1) :< 2) :< 3) :< 4)