90 lines
2.4 KiB
Haskell
90 lines
2.4 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
module Zipper (
|
|
Tree(..)
|
|
, Zipper(..)
|
|
, at
|
|
, parse
|
|
, up
|
|
) where
|
|
|
|
newtype Tree = Tree {
|
|
children :: [(String, Tree)]
|
|
}
|
|
|
|
data Context = Top | Context {
|
|
before :: Tree
|
|
, after :: Tree
|
|
, line :: String
|
|
, above :: Context
|
|
}
|
|
|
|
data Zipper = Zipper {
|
|
context :: Context
|
|
, focus :: Tree
|
|
}
|
|
|
|
at :: Int -> Zipper -> Zipper
|
|
at k (Zipper {context, focus}) =
|
|
let (beforeSubTrees, (line, newFocus), afterSubTrees) = openLines k ([], subTrees) in
|
|
Zipper {
|
|
context = Context {
|
|
before = Tree beforeSubTrees
|
|
, after = Tree afterSubTrees
|
|
, line
|
|
, above = context
|
|
}
|
|
, focus = newFocus
|
|
}
|
|
where
|
|
subTrees = children focus
|
|
openLines 0 (left, []) = (drop 1 left, head left, [])
|
|
openLines 0 (left, (center:right)) = (left, center, right)
|
|
openLines _ (left, []) = openLines 0 (left, [])
|
|
openLines n (left, (center:right)) = openLines (n-1) (center:left, right)
|
|
|
|
insert :: String -> Zipper -> Zipper
|
|
insert newLine z@(Zipper {context = Top}) = plug newLine z
|
|
insert newLine (Zipper {context, focus}) = Zipper {
|
|
context = Context {
|
|
before = Tree ((line context, focus):(children $ before context))
|
|
, after = after context
|
|
, line = newLine
|
|
, above = above context
|
|
}
|
|
, focus = Tree []
|
|
}
|
|
|
|
parse :: String -> Zipper
|
|
parse = zipUp . fst . foldl getStructure (Zipper Top $ Tree [], 0) . lines
|
|
where
|
|
getStructure (zipper, depth) line =
|
|
let (indent, content) = span (== ' ') line in
|
|
let n = depth - length indent in
|
|
if n < 0
|
|
then (plug content zipper, length indent)
|
|
else (insert content (funPower n up zipper), length indent)
|
|
funPower 0 _ x = x
|
|
funPower n f x = funPower (n-1) f $ f x
|
|
|
|
plug :: String -> Zipper -> Zipper
|
|
plug line (Zipper {context}) = Zipper {
|
|
context = Context {
|
|
before = Tree []
|
|
, after = Tree []
|
|
, line
|
|
, above = context
|
|
}
|
|
, focus = Tree []
|
|
}
|
|
|
|
up :: Zipper -> Zipper
|
|
up z@(Zipper {context = Top}) = z
|
|
up (Zipper {context = Context {before, after, line, above}, focus}) = Zipper {
|
|
context = above
|
|
, focus = Tree (reverse (children before) ++ ((line, focus) : children after))
|
|
}
|
|
|
|
zipUp :: Zipper -> Zipper
|
|
zipUp z@(Zipper {context = Top}) = z
|
|
zipUp z = zipUp (up z)
|