Andy Melnikov (nponeccop) wrote,
Andy Melnikov
nponeccop

Хуеморфизмы to the rescue

Я тут изобрёл ужасно генерическую функцию reprocess2, которая кмк решит все проблемы:
{-# LANGUAGE DeriveFunctor #-}
import Data.Functor.Fixedpoint
import Control.Applicative

type Rewrite a = a -> Maybe a

data TermF a = Cons String a | Nil deriving (Functor, Show)

type Term = Fix TermF

-- reprocess2 :: Functor f => (f b -> Fix f -> b) -> Fix f -> b
reprocess2 :: (TermF (Maybe Term) -> Rewrite Term) -> Rewrite Term
reprocess2 f t = f (reprocess2 f <$> unFix t) t
Оказалось неудобно, так что я сделал вариант с "соединителем" j. В нашем случае это будет (,):
reprocess3 j f = self
	where self = f . fmap (\x -> j x (self x)) . unFix
Всё равно, кажется, есть пространство для улучшения.

Вот текущая версия реврайта:
fromList = foldr (\x y -> Fix $ Cons x y) (Fix Nil)

x = fromList ["foo", "bar", "foo", "baz"] 

clientRewrite :: Rewrite Term
clientRewrite (Fix (Cons "foo" a)) = Just $ Fix $ Cons "bar" a
clientRewrite (Fix (Cons "bar" a)) = Just $ Fix $ Cons "quux" a
clientRewrite _ = Nothing

rewriteMany x = clientRewrite x >>= rewriteAfterChange where
	rewriteAfterChange x = (clientRewrite x >>= rewriteAfterChange) <|> return x

process Nil = rewriteMany (Fix Nil)
process (Cons a (oldB, newB)) = rewriteMany f <|> fmap (const f) newB where
	f = Fix (Cons a (fromMaybe oldB newB))
	
result = reprocess3 (,) process x
Subscribe

  • Post a new comment

    Error

    default userpic

    Your reply will be screened

    Your IP address will be recorded 

    When you submit the form an invisible reCAPTCHA check will be performed.
    You must follow the Privacy Policy and Google Terms of use.
  • 0 comments