Clean way to do rewrite rules - haskell

Question

I have the following toy language:
module Lang where
data Op = Move Int -- Move the pointer N steps
| Add Int -- Add N to the value under the pointer
| Skip -- Skip next op if the value under the pointer is 0
| Halt -- End execution
deriving (Show, Eq)
type Program = [Op]
The language has a finite tape of memory cells that wraps around, and a pointer that points at some cell. All the cells are initially zero. The program is executed repeatedly until the halt instruction is read.
Now I would like to write a function that optimizes a given program. Here is the optimizations that I would like to perform:
| Original code | Optimization |
|---------------------|----------------|
| Move a : Move b : x | Move (a+b) : x |
| Add a : Add b : x | Add (a+b) : x |
| Move 0 : x | x |
| Add 0 : x | x |
| Skip : Skip : x : y | x : y |
| Halt : _ | Halt |
Additionally, I can only do an optimization on code that is not directly after a skip, because doing that would change the meaning of the program.
Is repeatedly pattern matching on the list until no more optimizations can be performed really the best/cleanest way to do this?
What if I decide that I also want to perform more advanced rewrites like these:
| Original code | Optimization |
|--------------------------------------------------------|------------------------------------------------|
| if the program begins with (Skip : a) | move it to the end of the program |
| Move x ++ no_skips : Move -x ++ no_skips' : Move w : q | Move x ++ no_skips ++ no_skips' : Move w-x : q |

Answer 1

Use Maybe's!
#user2407038 told me that I could use Maybe in a comment
module MaybeProg where
import Lang
import Control.Monad
type Opt = Program -> Maybe Program
optimize = untilFail step
where step p | p' <- atEveryButSkipNextWhen (==Skip) rewrite
. atEvery delNopSkip
$ untilFail moveSkips p
, p /= p' = Just p'
| otherwise = Nothing
rewrite = tryAll [joinMoves, joinAdds, delNopMov, delNopAdd, termHalt, reorder]
joinMoves p = do (Move a : Move b : x) <- pure p; Just $ Move (a+b) : x
joinAdds p = do (Add a : Add b : x) <- pure p; Just $ Add (a+b) : x
delNopMov p = do (Move 0 : x) <- pure p; Just x
delNopAdd p = do (Add 0 : x) <- pure p; Just x
delNopSkip p = do (Skip : Skip : x) <- pure p; Just x
termHalt p = do (Halt : _) <- pure p; Just [Halt]
moveSkips p = do (Skip : x : y : z) <- pure p; Just $ y : z ++ [Skip, x]
reorder p = do
(Move x : rst) <- pure p
(as, Move y : rst') <- break' isMove rst
guard $ x == -y && all (/=Skip) as
(bs, Move w : q ) <- break' isMove rst'
guard $ all (/=Skip) bs
return $ Move x : as ++ bs ++ Move (w-x) : q
where isMove (Move _) = True
isMove _ = False
--------
untilFail :: Opt -> Program -> Program
untilFail o p | Just p' <- o p = untilFail o p'
| otherwise = p
atEvery :: Opt -> Program -> Program
atEvery o p | (x:xs) <- untilFail o p = x : atEvery o xs
| otherwise = []
atEveryButSkipNextWhen c o p#(h:_)
| not $ c h
, (x:xs) <- untilFail o p = x : atEveryButSkipNextWhen c o xs
| (p1:p2:ps) <- p = p1:p2:atEveryButSkipNextWhen c o ps
| otherwise = p
atEveryButSkipNextWhen _ _ [] = []
tryAll :: [Opt] -> Opt
tryAll os p = do
Just x : _ <- pure . dropWhile (==Nothing) $ ($p) <$> os
return x
break' f p | (x, y) <- break f p
, not $ null y = Just (x, y)
| otherwise = Nothing

Answer 2

Use pattern matching!
This is what I wanted to avoid, I am posting it for reference
module Pattern where
import Lang
optimize :: Program -> Program
optimize p
| p' <- reorder $ rewrite $ moveSkip p
, p /= p' = optimize p'
| otherwise = p
rewrite :: Program -> Program
rewrite (Move a : Move b : x) = rewrite $ Move (a+b) : x
rewrite (Add a : Add b : x) = rewrite $ Add (a+b) : x
rewrite (Move 0 : x) = rewrite x
rewrite (Add 0 : x) = rewrite x
rewrite (Skip : Skip : x) = rewrite x
rewrite (Halt : _) = [Halt]
rewrite (Skip : x : xs) = Skip : x : rewrite xs
rewrite (x : xs) = x : rewrite xs
rewrite [] = []
moveSkip :: Program -> Program
moveSkip (Skip : a : x) = x ++ [Skip, a]
moveSkip x = x
reorder :: Program -> Program
reorder (Move x : xs)
| (no_skips , Move y : xs') <- break isMove xs
, (no_skips' , Move w : q ) <- break isMove xs'
, x == -y
, all (/=Skip) no_skips
, all (/=Skip) no_skips'
= Move x : no_skips ++ no_skips' ++ Move (w-x) : reorder q
| otherwise = Move x : reorder xs
reorder (Skip : x : xs) = Skip : x : reorder xs
reorder (x:xs) = x : reorder xs
reorder [] = []
isMove (Move _) = True
isMove _ = False