ZipperAG.hs

{-|
Module      : ZipperAG
Description : Zipper-based Attribute Grammars in Haskell 
Copyright   : (c) Pedro Martins, 2013
                  José Nuno Macedo, 2020
License     : BSD3
Maintainer  : José Nuno Macedo <zenunomacedo@gmail.com>
Stability   : Experimental
Portability : Portable
-}
module Language.ZipperAG where

import Data.Generics.Zipper
import Data.Generics.Aliases (mkQ)
import Data.Maybe
import Data.Data (Data)

-- |Navigate to the n'th child
(.$) :: Zipper a -> Int -> Zipper a
z .$ 1 = fromJust (down' z)
z .$ n = fromJust (right ( z.$(n-1) ))

-- |Navigate to the parent node
parent = fromJust.up

-- |Tests if z is the n'th sibling
(.|) :: Zipper a -> Int -> Bool
z .| 1 = case left z of
  Nothing -> False
  _ -> True
z .| n = case left z of
  Nothing -> False
  Just x ->  x .| (n-1)

-- |Move N positions to the right on the zipper
(.$>) :: Zipper a -> Int -> Zipper a
zipper .$> n = let current = arity zipper
               in  (parent zipper).$(current+n)

-- |Move N positions to the left on the zipper
(.$<) :: Zipper a -> Int -> Zipper a
zipper .$< n = let current = arity zipper
               in  (parent zipper).$(current-n)

-- |Computes the arity of a zipper node. 
-- Arity refers to its position amongst its siblings. 
-- For example, the first sibling, with no nodes to the left, has arity 1. Move to the right once with @.$>1@ and its arity is now 2. 
arity :: Zipper a -> Int 
arity m = arity' m 1
 where arity' :: Zipper a -> Int -> Int
       arity' m n = case left m of
                     Nothing  -> n                     
                     Just m'  -> arity' m' (n+1)

-- |Prepare data for Attribute-Grammar manipulation. Alias for 'toZipper'. 
mkAG :: Data x => x -> Zipper x
mkAG = toZipper

-- |compute attribute __f__ of parent of zipper __z__ 
(.^) :: (Zipper a -> b) -> Zipper a -> b 
(.^) f z = f $ parent z 

-- |compute attribute __f__ at the root of zipper __z__ 
(.^^) :: (Zipper a -> b) -> Zipper a -> b
(.^^) f z = moveQ up (f z) (f.^^) z

-- |compute attribute __f__ of node navigating upwards in zipper __z__. Traverses upwards in the zipper and queries the first node that satisfies __p__
inherit :: Data n => (n -> Bool) -> (Zipper a -> b) -> Zipper a -> b 
inherit p f z = if query (mkQ False p) z then f z else (inherit p f).^ z