retrie-1.2.0.0: demo/Main.hs

-- Copyright (c) Facebook, Inc. and its affiliates.
--
-- This source code is licensed under the MIT license found in the
-- LICENSE file in the root directory of this source tree.
--
{-# LANGUAGE OverloadedStrings #-}
module Main where

import qualified GHC.Paths as GHC.Paths
import Retrie

-- | A script for rewriting calls to a function that takes a string to be
-- calls to a new function that takes an enumeration. See the README for
-- details. Running this would result in the following diff:
--
--  module MyModule where
--
--  baz, bar, quux :: IO ()
-- -baz = fooOld "foo"
-- +baz = fooNew Foo
-- -bar = fooOld "bar"
-- +bar = fooNew Bar
-- -quux = fooOld "quux"
-- +quux = fooNew (error "invalid argument: quux")
--

main :: IO ()
main = runScript GHC.Paths.libdir $ \opts -> do
  [rewrite] <- parseRewrites GHC.Paths.libdir opts [Adhoc "forall arg. fooOld arg = fooNew arg"]
  return $ apply [setRewriteTransformer stringToFooArg rewrite]

argMapping :: [(FastString, String)]
argMapping = [("foo", "Foo"), ("bar", "Bar")]

-- | This 'transform' receives the result of matching the left-hand side of the
-- equation. The returned 'MatchResult' is used to instantiate the right-hand
-- side of the equation. In this example we are just modifying the
-- substitution, but you can also modify the template, which contains the
-- right-hand side itself.
stringToFooArg :: MatchResultTransformer
stringToFooArg _ctxt match
  | MatchResult substitution template <- match
  , Just (HoleExpr expr) <- lookupSubst "arg" substitution
  , L _ (HsLit _ (HsString _ str)) <- astA expr = do
    newExpr <- case lookup str argMapping of
      Nothing ->
        parseExpr GHC.Paths.libdir $ "error \"invalid argument: " ++ unpackFS str ++ "\""
      Just constructor -> parseExpr GHC.Paths.libdir constructor
    return $
      MatchResult (extendSubst substitution "arg" (HoleExpr newExpr)) template
  | otherwise = return NoMatch