Skip to content

Instantly share code, notes, and snippets.

@willtim
Last active August 29, 2015 14:03
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save willtim/336393ebe0c4f42530b8 to your computer and use it in GitHub Desktop.
Hoodlums: Purely Functional Text Editing
------------------------------------------------------------
-- 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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment