packages feed

zipper 0.3.1 → 0.4

raw patch · 6 files changed

+63/−11 lines, 6 filesdep ~multirec

Dependency ranges changed: multirec

Files

examples/AST.hs view
@@ -22,7 +22,7 @@   deriving Show  data Decl   =  Var := Expr-            |  Seq    Decl  Decl+            |  Seq    [Decl]             |  None   deriving Show
examples/ASTEditor.hs view
@@ -23,13 +23,13 @@  -- | Call this to start the navigation demo. startEditor :: IO ()-startEditor = +startEditor =   do     intro     hSetBuffering stdin NoBuffering     loop $ enter Expr example -example = Let (Seq (Seq ("x" := Mul (Const 6) (Const 9)) ("y" := Const (-12))) None)+example = Let (Seq ["x" := Mul (Const 6) (Const 9), "y" := Const (-12)])               (Add (EVar "x") (EVar "y"))  -- | Show the current location, with the focus being highlighted in red.
examples/ASTUse.hs view
@@ -58,7 +58,7 @@        :+:  C Let     (I Decl :*: I Expr)       ) :>: Expr   :+: (     C Assign  (I Var  :*: I Expr)-       :+:  C Seq     (I Decl :*: I Decl)+       :+:  C Seq     ([] :.: I Decl)        :+:  C None    U       ) :>: Decl   :+: (               (K String)@@ -81,7 +81,7 @@   from Expr (Let d e)  =  L (Tag (R (R (R (R (C (I (I0 d) :*: I (I0 e))))))))    from Decl (x := e)   =  R (L (Tag (L    (C (I (I0 x) :*: I (I0 e))))))-  from Decl (Seq c d)  =  R (L (Tag (R (L (C (I (I0 c) :*: I (I0 d)))))))+  from Decl (Seq ds)   =  R (L (Tag (R (L (C (D (map (I . I0) ds)))))))   from Decl (None)     =  R (L (Tag (R (R (C U)))))    from Var  x          =  R (R (Tag (K x)))@@ -93,8 +93,15 @@   to Expr (L (Tag (R (R (R (R (C (I (I0 d) :*: I (I0 e)))))))))  =  Let d e    to Decl (R (L (Tag (L    (C (I (I0 x) :*: I (I0 e)))))))       =  x := e-  to Decl (R (L (Tag (R (L (C (I (I0 c) :*: I (I0 d))))))))      =  Seq c d+  to Decl (R (L (Tag (R (L (C (D ds)))))))                       =  Seq (map (unI0 . unI) ds)   to Decl (R (L (Tag (R (R (C U))))))                            =  None    to Var  (R (R (Tag (K x))))                                    =  x +-- ** EqS instance++instance EqS AST where+  eqS Expr Expr = Just Refl+  eqS Decl Decl = Just Refl+  eqS Var  Var  = Just Refl+  eqS _    _    = Nothing
examples/ASTZipper.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs            #-}  module ASTZipper where
src/Generics/MultiRec/Zipper.hs view
@@ -41,6 +41,7 @@ import Control.Monad import Control.Applicative import Data.Maybe+import Data.Traversable  import Generics.MultiRec.Base import Generics.MultiRec.Fold@@ -64,7 +65,7 @@ -- | Abstract type of context frames. Not required for the high-level -- navigation functions. -data family Ctx f :: * -> (* -> *) -> * -> *+data family Ctx (f :: (* -> *) -> * -> *) :: * -> (* -> *) -> * -> *  data instance Ctx (K a) b r ix data instance Ctx U b r ix@@ -73,6 +74,9 @@ data instance Ctx (f :*: g) b r ix  = C1 (Ctx f b r ix) (g r ix)                                     | C2 (f r ix) (Ctx g b r ix) +data instance Ctx ([] :.: g) b r ix = CCL [g r ix] (Ctx g b r ix) [g r ix]+data instance Ctx (Maybe :.: g) b r ix = CCM (Ctx g b r ix)+ -- The equality constraints simulate GADTs. GHC currently -- does not allow us to use GADTs as data family instances. @@ -167,6 +171,42 @@   prev  f p (C2 x c) y =                 prev  (\p' z c' -> f p' z (C2 x            c')) p c y `mplus`                 last  (\p' z c' -> f p' z (C1 c' (fill p c y)))     x++-- For the time being, we support just [] and Maybe. I think we+-- might be able to support a whole class (Foldable).+instance (Zipper phi g) => Zipper phi ([] :.: g) where+  cmapA f p (CCL pb c pe)   =+    CCL <$> traverse (hmapA f p) pb <*> cmapA f p c <*> traverse (hmapA f p) pe+  fill    p (CCL pb c pe) x =+    D (reverse pb ++ fill p c x : pe)+  first f (D [])            = Nothing+  first f (D (x : xs))      = first (\p z c -> f p z (CCL [] c xs)) x+  last  f (D xs)            =+    case reverse xs of+      []     -> Nothing+      y : ys -> last (\p z c -> f p z (CCL ys c [])) y+  next  f p (CCL pb c pe) x =+    next (\p z c -> f p z (CCL pb c pe)) p c x `mplus`+    case pe of+      []     -> Nothing+      y : ys -> first (\p' z c' -> f p' z (CCL (fill p c x : pb) c' ys)) y+  prev  f p (CCL pb c pe) x =+    prev (\p z c -> f p z (CCL pb c pe)) p c x `mplus`+    case pb of+      []     -> Nothing+      y : ys -> last  (\p' z c' -> f p' z (CCL ys c' (fill p c x : pe))) y++instance (Zipper phi g) => Zipper phi (Maybe :.: g) where+  cmapA f p (CCM c)    =+    CCM <$> cmapA f p c+  fill p (CCM c) x     =+    D (Just (fill p c x))+  first f (D Nothing)  = Nothing+  first f (D (Just x)) = first (\p z -> f p z . CCM) x+  last  f (D Nothing)  = Nothing+  last  f (D (Just x)) = last  (\p z -> f p z . CCM) x+  next  f p (CCM c) x  = next  (\p z -> f p z . CCM) p c x+  prev  f p (CCM c) x  = prev  (\p z -> f p z . CCM) p c x  instance Zipper phi f => Zipper phi (f :>: xi) where   cmapA f p (CTag prf c)   = liftA (CTag prf) (cmapA f p c)
zipper.cabal view
@@ -1,5 +1,5 @@ name:                   zipper-version:                0.3.1+version:                0.4 license:                BSD3 license-file:           LICENSE author:	                Alexey Rodriguez,@@ -25,17 +25,21 @@   stability:              experimental build-type:             Simple-cabal-version:          >= 1.2.1-tested-with:            GHC == 6.10.4, GHC == 7.0.1+cabal-version:          >= 1.6+tested-with:            GHC == 7.0.4 extra-source-files:     examples/AST.hs                         examples/ASTUse.hs                         examples/ASTZipper.hs                         examples/ASTEditor.hs                         CREDITS +source-repository head+  type:                 git+  location:             https://github.com/kosmikus/zipper+ library   hs-source-dirs:       src   exposed-modules:      Generics.MultiRec.Zipper    build-depends:        base >= 3 && < 5,-                        multirec >= 0.4 && < 0.6+                        multirec >= 0.4 && < 0.8