From 6b476d0eb7a0d333fba230aa32f8a2eba3d845a5 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Tue, 30 Oct 2018 11:01:28 -0400
Subject: [PATCH] Add 'purely' combinator to Matching and rename it.

@tclem and I found ourselves wanting an arrow-like combinator that
promotes a given function to a Matcher. While I think an Arrow
instance is going a little overboard, there's no harm in adding a
'purely' function, the naming of which is commensurate with the
rewriting DSL.

This also renames the module, since there's not anything really
abstract about matching (indeed, it is quite concrete).
---
 semantic.cabal                         | 4 ++--
 src/Control/{Abstract => }/Matching.hs | 7 ++++++-
 src/Control/Rewriting.hs               | 2 +-
 src/Matching/Core.hs                   | 2 +-
 src/Semantic/Util/Rewriting.hs         | 2 +-
 test/Control/Rewriting/Spec.hs         | 4 ++--
 test/Matching/Go/Spec.hs               | 2 +-
 7 files changed, 14 insertions(+), 9 deletions(-)
 rename src/Control/{Abstract => }/Matching.hs (97%)

diff --git a/semantic.cabal b/semantic.cabal
index 0d0d5dfef..99e0a6ddb 100644
--- a/semantic.cabal
+++ b/semantic.cabal
@@ -41,14 +41,14 @@ library
                      , Control.Abstract.Evaluator
                      , Control.Abstract.Heap
                      , Control.Abstract.Hole
-                     , Control.Abstract.Matching
                      , Control.Abstract.Modules
                      , Control.Abstract.Primitive
                      , Control.Abstract.PythonPackage
                      , Control.Abstract.Roots
                      , Control.Abstract.ScopeGraph
                      , Control.Abstract.Value
-                     -- Rewriting
+                     -- Matching and rewriting DSLs
+                     , Control.Matching
                      , Control.Rewriting
                      -- Datatypes for abstract interpretation
                      , Data.Abstract.Address.Hole
diff --git a/src/Control/Abstract/Matching.hs b/src/Control/Matching.hs
similarity index 97%
rename from src/Control/Abstract/Matching.hs
rename to src/Control/Matching.hs
index eeb4b8b4e..a25c2c23d 100644
--- a/src/Control/Abstract/Matching.hs
+++ b/src/Control/Matching.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE GADTs, TypeOperators #-}
 
-module Control.Abstract.Matching
+module Control.Matching
   ( Matcher
   , TermMatcher
   , target
@@ -9,6 +9,7 @@ module Control.Abstract.Matching
   , matchM
   , narrow
   , narrow'
+  , purely
   , succeeds
   , fails
   , runMatcher
@@ -71,6 +72,10 @@ target = Target
 ensure :: (t -> Bool) -> Matcher t ()
 ensure f = target >>= \c -> guard (f c)
 
+-- | Promote a pure function to a 'Matcher'.
+purely :: (a -> b) -> Matcher a b
+purely f = fmap f target
+
 -- | 'matchm' takes a modification function and a new matcher action the target parameter of which
 --   is the result of the modification function. If the modification function returns 'Just' when
 --   applied to the current 'target', the given matcher is executed with the result of that 'Just'
diff --git a/src/Control/Rewriting.hs b/src/Control/Rewriting.hs
index 65ed12286..2758028ea 100644
--- a/src/Control/Rewriting.hs
+++ b/src/Control/Rewriting.hs
@@ -74,7 +74,7 @@ import           Data.Profunctor
 import qualified Data.Sum as Sum hiding (apply)
 import           Data.Text (pack)
 
-import Control.Abstract.Matching (Matcher, stepMatcher)
+import Control.Matching (Matcher, stepMatcher)
 import Data.History as History
 import Data.Term
 
diff --git a/src/Matching/Core.hs b/src/Matching/Core.hs
index c0b08e747..8fb5b31af 100644
--- a/src/Matching/Core.hs
+++ b/src/Matching/Core.hs
@@ -8,7 +8,7 @@ module Matching.Core
 
 import Prologue
 
-import           Control.Abstract.Matching
+import           Control.Matching
 import qualified Data.Syntax.Literal as Literal
 import           Data.Term
 
diff --git a/src/Semantic/Util/Rewriting.hs b/src/Semantic/Util/Rewriting.hs
index 0188d664b..6824c4d4f 100644
--- a/src/Semantic/Util/Rewriting.hs
+++ b/src/Semantic/Util/Rewriting.hs
@@ -9,7 +9,7 @@ import           Control.Category
 import qualified Data.ByteString.Char8 as BC
 import           Text.Show.Pretty (pPrint)
 
-import           Control.Abstract.Matching
+import           Control.Matching
 import           Control.Rewriting hiding (fromMatcher, target)
 import           Data.Blob
 import           Data.File
diff --git a/test/Control/Rewriting/Spec.hs b/test/Control/Rewriting/Spec.hs
index 05b9b7d98..a7ff72ca5 100644
--- a/test/Control/Rewriting/Spec.hs
+++ b/test/Control/Rewriting/Spec.hs
@@ -8,7 +8,7 @@ import qualified Data.ByteString as B
 import           Data.Either
 import           Data.Text (Text)
 
-import           Control.Abstract.Matching as Matching
+import           Control.Matching as Matching
 import           Control.Rewriting as Rewriting
 import           Data.History as History
 import qualified Data.Source as Source
@@ -21,7 +21,7 @@ import           Reprinting.Pipeline
 onTrees :: ( Literal.TextElement :< syn
            , Literal.KeyValue :< syn
            , Apply Functor syn
-           , term ~ Term (Sum syn) History 
+           , term ~ Term (Sum syn) History
            ) => Rewrite (env, term) (Literal.Hash term)
 onTrees = do
   Literal.Hash els <- Rewriting.target
diff --git a/test/Matching/Go/Spec.hs b/test/Matching/Go/Spec.hs
index a4fdc1e68..76e7fa6ef 100644
--- a/test/Matching/Go/Spec.hs
+++ b/test/Matching/Go/Spec.hs
@@ -2,7 +2,7 @@
 
 module Matching.Go.Spec (spec) where
 
-import           Control.Abstract.Matching
+import           Control.Matching
 import           Data.Abstract.Module
 import           Data.List
 import           Data.Sum