Plated scope

PlatedScope.hs

{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
module Pact.Types.Plated where

import Control.Lens.Plated
import Bound.Scope
import Bound
import Control.Monad
import Text.Show.Deriving
import Data.Eq.Deriving


data Expr n =
  Var n |
  List [Expr n] |
  Sco (Scope () Expr n)
  deriving (Functor,Foldable,Traversable)

instance Applicative Expr where
  pure = return
  (<*>) = ap

instance Monad Expr where
  (Var n) >>= f = f n
  (List ls) >>= f = List (fmap (>>= f) ls)
  (Sco s) >>= f = Sco (s >>>= f)
  return = Var

deriveShow1 ''Expr
deriveEq1 ''Expr

deriving instance Show n => Show (Expr n)
deriving instance Eq n => Eq (Expr n)

instance Plated (Expr Int) where
  plate _ (Var n) = pure $ Var n
  plate f (List l) = List <$> traverse f l
  plate f (Sco (Scope s)) = Sco . Scope <$> traverse (traverse f) s


_test :: IO ()
_test = do
  let a = List [List [Var (1 :: Int)], Var 2]
  putStrLn "Expr:"
  print a
  putStrLn "Universe:"
  mapM_ print $ universe a
  let b = Sco (abstract (const Nothing) (List [Var (1 :: Int)]))
  putStrLn "Expr:"
  print b
  putStrLn "Universe:"
  mapM_ print $ universe b
  
{- Output:

λ> _test
Expr:
List [List [Var 1],Var 2]
Universe:
List [List [Var 1],Var 2]
List [Var 1]
Var 1
Var 2
Expr:
Sco (Scope (List [Var (F (Var 1))]))
Universe:
Sco (Scope (List [Var (F (Var 1))]))
Var 1

Note how the abstracted List is lost ...

-}