{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE PatternSynonyms #-}

import ZipperDeriv hiding (Node, zip)
import Data.Tree
import Diagrams.Prelude
import Diagrams.Backend.Cairo
import Diagrams.TwoD.Layout.Tree
import Control.Monad

toTree :: Paren a -> Tree (Maybe a)
toTree (Leaf x) = Node (Just x) []
toTree (Pair t1 t2) = Node Nothing [toTree t1, toTree t2]

renderParen node p =
    renderTree toNode
               (~~)
               (symmLayout' (with & slHSep .~ 4 & slVSep .~ 4) (toTree p))
    # centerXY # pad 1.1
  where
    toNode Nothing = mempty
    toNode (Just Nothing) = square 1.8 # fc yellow
    toNode (Just (Just c)) = node c <> (circle 1 # fc yellow)

main = do
    render "paren-orig.pdf" 400 $ toDiag p
    render "paren-zippers.pdf" 800 $
      zline 4 $ map toDiag zippers
  where
    toDiag p = renderParen (text . (:[])) p :: Diagram B

    render filename w = renderCairo filename (mkWidth w)
    zippers = probe Nothing p

zline n xs = case splitAt n xs of
    ([], _) -> mempty
    (here, there) -> foldr1 (|||) (map frame here)
                     ===
                     zline n there
  where
    frame = atop (square 10 # lcA transparent)