public
Last active

Haskell library for traversing and editing recursive data structures

  • Download Gist
Makefile
Makefile
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
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)
Traverse.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81
{-# 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
Traverse/CursorM.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
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, ())
Traverse/List.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29
{-# 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

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.