Instantly share code, notes, and snippets.

# rampion/Makefile Created May 21, 2009

What would you like to do?
Haskell library for traversing and editing recursive data structures
 module Traverse.CursorM where import Prelude ((\$), Bool) import Maybe import Monad import Traverse -- encapsulate a cursor in a monad newtype (Traversable t) => CursorM t a = CursorM { runCursor :: Cursor t -> Maybe (Cursor t, a) } instance (Traversable t) => Monad (CursorM t) where return a = CursorM \$ \c -> Just (c,a) m >>= f = CursorM \$ \c -> do (c', a) <- m `runCursor` c; f a `runCursor` c' -- move in a direction moveM :: (Traversable t) => Direction t -> CursorM t () moveM d = CursorM \$ \c -> do c' <- c `move` d; return (c', ()) -- move as far as possible in a direction skipM :: (Traversable t) => Direction t -> CursorM t () skipM d = CursorM \$ \c -> Just (c `skip` d, ()) -- test if it's possible to move in a direction from the current position canMoveM :: (Traversable t) => Direction t -> CursorM t Bool canMoveM d = CursorM \$ \c -> Just (c, c `canMove` d) -- see what moves are available in the current position validMovesM :: (Traversable t) => CursorM t [ Direction t ] validMovesM = CursorM \$ \c -> Just (c, validMoves c) -- follow a sequence of directions followM :: (Traversable t) => [ Direction t ] -> CursorM t () followM ds = CursorM \$ \c -> do c' <- follow c ds return (c', ()) -- move back to the start of the data structure resetM :: (Traversable t) => CursorM t () resetM = CursorM \$ \c -> Just (reset c, ()) -- see if we've reached the beginning of the data structure isResetM :: (Traversable t) => CursorM t Bool isResetM = CursorM \$ \c -> Just (c, isReset c) -- read the current value stored in the data structure readM :: (Traversable t) => CursorM t (Data t) readM = CursorM \$ \c -> Just (c, read c) -- change the current value stored in the data structure writeM :: (Traversable t) => Data t -> CursorM t () writeM v = CursorM \$ \c -> do c' <- c `write` v; return (c', ()) -- extract the substructure at this location extractM :: (Traversable t) => CursorM t t extractM = CursorM \$ \c -> Just (c, extract c) -- insert a new substructure at this location insertM :: (Traversable t) => t -> CursorM t () insertM t = CursorM \$ \c -> Just (c `insert` t, ())
 {-# LANGUAGE TypeFamilies #-} module Traverse.List where import Traverse instance Traversable [a] where -- move forward or backward through a list data Direction [a] = Forward | Backward directions = [ Forward, Backward ] opposite Forward = Backward opposite Backward = Forward -- store a path through a list, with preceding elements stored in reverse data Cursor [a] = ListCursor [a] [a] cursor as = ListCursor [] as move (ListCursor _ []) Forward = Nothing move (ListCursor bs (x:fs)) Forward = Just \$ ListCursor (x:bs) fs move (ListCursor [] _) Backward = Nothing move (ListCursor (x:bs) fs) Backward = Just \$ ListCursor bs (x:fs) reset (ListCursor bs fs) = ListCursor [] \$ foldl (flip (:)) fs bs isReset (ListCursor bs _) = null bs type Data [a] = a -- read or write the value at this position in the list read (ListCursor _ (x:fs)) = x write (ListCursor bs (_:fs)) x = Just \$ ListCursor bs (x:fs) write (ListCursor bs []) x = Just \$ ListCursor bs [x] -- extract or insert a new sublist at this point in the list extract (ListCursor _ fs) = fs insert (ListCursor bs _) fs = ListCursor bs fs
 BASE_SRC=Traverse.hs BASE_TGT=\$(basename \$(BASE_SRC)) BASE_OBJ=\$(addsuffix .o,\$(BASE_TGT)) BASE_INT=\$(addsuffix .hi,\$(BASE_TGT)) EXT_SRCS=\$(wildcard Traverse/*.hs) EXT_TGTS=\$(basename \$(EXT_SRCS)) EXT_OBJS=\$(addsuffix .o,\$(EXT_TGTS)) EXT_INTS=\$(addsuffix .hi,\$(EXT_TGTS)) SOURCES=\$(BASE_SRC) \$(EXT_SRCS) TARGETS=\$(BASE_TGT) \$(EXT_TGTS) OBJECTS=\$(BASE_OBJ) \$(EXT_OBJS) INTERFACES=\$(BASE_INT) \$(EXT_INTS) all: \$(OBJECTS) %.hi %.o: %.hs ghc -c \$< \$(EXT_OBJS): \$(BASE_OBJ) Traverse/Forest.o: Traverse/List.o clean: rm -f \$(OBJECTS) \$(INTERFACES)
 {-# LANGUAGE TypeFamilies #-} module Traverse where import Maybe (isNothing) import Monad (foldM) -- a class for traversing recursive data structures class Traversable t where -- directions the cursor can move through the structure data Direction t directions :: [ Direction t ] opposite :: Direction t -> Direction t -- used to hold state about where we are in the data structure data Cursor t cursor :: t -> Cursor t -- move one increment in the given direction move :: Cursor t -> Direction t -> Maybe (Cursor t) -- return to our entry point in the data structure reset :: Cursor t -> Cursor t isReset :: Cursor t -> Bool -- what kind(s) of data can be read/written in the data strucutre type Data t -- find the value stored at the current position read :: Cursor t -> Data t -- attempt to replace the value at the current position write :: Cursor t -> Data t -> Maybe (Cursor t) -- find the substructure at this position extract :: Cursor t -> t -- replace the substructure at this position insert :: Cursor t -> t -> Cursor t -- rules (or at least, suggestions): -- * The list of directions is comprehensive: -- d `elem` directions == True -- -- * Every direction has a dual: -- opposite . opposite == id -- -- * Moves are reversible: -- Just c' = c `move` d implies -- Just c = c' `move` (opposite d) -- -- * reset works as described -- isReset . reset == const True -- -- * creating a cursor doesn't change the structure -- extract . cursor == id -- -- * The original position is the reset location: -- isReset . cursor == const True -- -- * moves don't change the data structure -- Just c' = c `move` d implies -- extract . reset c' == extract . reset c -- move another increment in the a given direction if the previous action succeeded andMove :: (Traversable t) => Maybe (Cursor t) -> Direction t -> Maybe (Cursor t) andMove maybeCursor direction = maybeCursor >>= \c -> c `move` direction -- move as far as possible in the given direction skip :: (Traversable t) => Cursor t -> Direction t -> Cursor t skip cursor direction = case cursor `move` direction of Nothing -> cursor Just cursor' -> cursor' `skip` direction -- move as far as possible in the given direction if the previous action succeeded andSkip :: (Traversable t) => Maybe (Cursor t) -> Direction t -> Maybe (Cursor t) andSkip maybeCursor direction = maybeCursor >>= \c -> Just \$ c `skip` direction -- test if the cursor can move in the given direction from the current position canMove :: (Traversable t) => Cursor t -> Direction t -> Bool canMove cursor = isNothing . move cursor -- list the valid moves from the current cursor position validMoves :: (Traversable t) => Cursor t -> [ Direction t ] validMoves cursor = filter (canMove cursor) directions -- follow a sequence of directions follow :: (Traversable t) => Cursor t -> [ Direction t ] -> Maybe (Cursor t) follow = foldM move