diff --git a/2016-04-05/texteditor.hs b/2016-04-05/texteditor.hs new file mode 100644 index 0000000..c12f983 --- /dev/null +++ b/2016-04-05/texteditor.hs @@ -0,0 +1,79 @@ +module TextEditor where + +import Data.Monoid ((<>), Sum(..)) + +data JoinList m a = Empty | Value m a | JoinList m (JoinList m a) (JoinList m a) + deriving (Show, Eq) + +meta :: (Monoid m) => JoinList m a -> m +meta Empty = mempty +meta (Value m _) = m +meta (JoinList m _ _ ) = m + +instance Monoid m => Monoid (JoinList m a) where + mempty = Empty + + mappend Empty x = x + mappend x Empty = x + mappend left right = JoinList (meta left <> meta right) left right + +instance Functor (JoinList m) where + fmap _ Empty = Empty + fmap f (Value m x) = Value m (f x) + fmap f (JoinList m left right) = JoinList m (fmap f left) (fmap f right) + +instance Foldable (JoinList m) where + foldMap _ Empty = mempty + foldMap f (Value _ x) = f x + foldMap f (JoinList _ left right) = foldMap f left <> foldMap f right + +data Meta = Meta { lineCount :: Sum Int + , letterCount :: Sum Int + , wordCount :: Sum Int + } deriving (Show) + +instance Monoid Meta where + mempty = Meta mempty mempty mempty + mappend (Meta a b c) (Meta x y z) = Meta (a <> x) (b <> y) (c <> z) + +mkMeta :: String -> Meta +mkMeta x = Meta (Sum 1) (Sum . length $ x) (Sum . length . words $ x) + +type Text = JoinList Meta String + +fromList :: [String] -> Text +fromList [] = Empty +fromList [x] = Value (mkMeta x) x +fromList xs = + let (left, right) = splitAt (length xs `div` 2) xs + in fromList left <> fromList right + +getAt :: Int -> Text -> Maybe String +getAt 1 (Value _ x) = Just x +getAt n (JoinList _ left right) = + let l = getSum . lineCount . meta $ left + in if n <= l + then getAt n left + else getAt (n - l) right +getAt _ _ = Nothing + +transform :: Int -> String -> Text -> (Int -> String -> Text -> Maybe Text) -> Maybe Text +transform n s (JoinList _ left right) f = + let l = getSum . lineCount . meta $ left + in if n <= l + then fmap (\e -> JoinList (meta e <> meta right) e right) $ f n s left + else fmap (\e -> JoinList (meta left <> meta e) left e) $ f (n - l) s right +transform _ _ _ _ = Nothing + +editAt :: Int -> String -> Text -> Maybe Text +editAt 1 s (Value _ _) = Just (Value (mkMeta s) s) +editAt n s l@JoinList {} = transform n s l editAt +editAt _ _ _ = Nothing + +insertAt :: Int -> String -> Text -> Maybe Text +insertAt 1 s Empty = Just $ Value (mkMeta s) s +insertAt 1 s v@(Value _ _) = + let left = Value (mkMeta s) s + in Just (JoinList (meta left <> meta v) left v) +insertAt n s l@JoinList {} = transform n s l insertAt +insertAt _ _ _ = Nothing