egison / egison-pattern-src

Manipulating Egison patterns: abstract syntax, parser, and pretty-printer

Home Page:https://hackage.haskell.org/package/egison-pattern-src

Geek Repo:Geek Repo

Github PK Tool:Github PK Tool

implement 'mapName' and 'mapValueExpr' by adding newtype wrapper for them

coord-e opened this issue · comments

newtype Names e n = Names { unNames :: Expr n e }

instance Functor (Names e) where
  fmap f = Names . cata go . unNames
    where
      go (VariableF n  ) = Variable (f n)
      go (InfixF n a b ) = Infix (f n) a b
      go (PatternF n ps) = Pattern (f n) ps
      -- TODO: omit these verbose matches
      go WildcardF       = Wildcard
      go (ValueF     e)  = Value e
      go (PredicateF e)  = Predicate e
      go (AndF p1 p2  )  = And p1 p2
      go (OrF  p1 p2  )  = Or p1 p2
      go (NotF p1     )  = Not p1

instance Foldable (Names e) where
  foldMap f = cata go . unNames
    where
      go (VariableF n) = f n
      go (InfixF n a b) = f n `mappend` a `mappend` b
      go (PatternF n ps) = f n `mappend` fold ps
      go _ = mempty

instance Traversable (Names e) where
  traverse f = fmap Names . cata go . unNames
    where
      go (VariableF n  ) = Variable <$> f n
      go (InfixF n a b ) = Infix <$> f n <*> a <*> b
      go (PatternF n ps) = Pattern <$> f n <*> sequenceA ps
      -- TODO: omit these verbose matches
      go WildcardF       = pure Wildcard
      go (ValueF     e)  = pure $ Value e
      go (PredicateF e)  = pure $ Predicate e
      go (AndF p1 p2  )  = And <$> p1 <*> p2
      go (OrF  p1 p2  )  = Or <$> p1 <*> p2
      go (NotF p1     )  = Not <$> p1

newtype ValueExprs n e = ValueExprs { unValueExprs :: Expr n e }

instance Functor (ValueExprs n) where
  fmap f = ValueExprs . cata go . unValueExprs
   where
    go (ValueF     e)   = Value (f e)
    go (PredicateF e)   = Predicate (f e)
    -- TODO: omit these verbose matches
    go WildcardF        = Wildcard
    go (VariableF n   ) = Variable n
    go (InfixF n p1 p2) = Infix n p1 p2
    go (PatternF n  ps) = Pattern n ps
    go (AndF     p1 p2) = And p1 p2
    go (OrF      p1 p2) = Or p1 p2
    go (NotF p1       ) = Not p1

-- | Map over @n@ in @Expr n e@.
mapName :: (n -> n') -> Expr n e -> Expr n' e
mapName f = unNames . fmap f . Names

-- | Map over @e@ in @Expr n e@.
mapValueExpr :: (e -> e') -> Expr n e -> Expr n e'
mapValueExpr f = unValueExprs . fmap f . ValueExprs