module Unison.Codebase.Editor.HandleInput.FindAndReplace
  ( handleStructuredFindReplaceI,
    handleStructuredFindI,
    handleTextFindI,
  )
where

import Control.Lens hiding (at)
import Control.Monad.Reader (ask)
import Control.Monad.State
import Data.Set qualified as Set
import Data.Text qualified as Text
import Unison.ABT qualified as ABT
import Unison.Builtin.Decls qualified as DD
import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.MonadUtils qualified as Cli
import Unison.Cli.Pretty qualified as P
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch.Names qualified as Branch
import Unison.Codebase.Editor.Output
import Unison.Codebase.Editor.StructuredArgument qualified as SA
import Unison.HashQualified qualified as HQ
import Unison.HashQualifiedPrime qualified as HQ'
import Unison.Name (Name)
import Unison.Name qualified as Name
import Unison.NameSegment qualified as NameSegment
import Unison.Names (Names)
import Unison.Names qualified as Names
import Unison.NamesWithHistory qualified as Names
import Unison.Parser.Ann (Ann (..))
import Unison.Pattern qualified as Pattern
import Unison.Prelude
import Unison.PrettyPrintEnv qualified as PPE
import Unison.PrettyPrintEnv.Names qualified as PPE
import Unison.PrettyPrintEnvDecl qualified as PPE hiding (biasTo, empty)
import Unison.PrettyPrintEnvDecl qualified as PPED
import Unison.Reference qualified as Reference
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.Symbol (Symbol)
import Unison.Syntax.HashQualified qualified as HQ (toVar)
import Unison.Term (Term)
import Unison.Term qualified as Term
import Unison.UnisonFile qualified as UF
import Unison.Util.Alphabetical qualified as Alphabetical
import Unison.Util.Pretty qualified as P
import Unison.Util.Relation qualified as Relation
import Unison.Var (Var)
import Unison.Var qualified as Var

handleStructuredFindReplaceI :: HQ.HashQualified Name -> Cli ()
handleStructuredFindReplaceI :: HashQualified Name -> Cli ()
handleStructuredFindReplaceI HashQualified Name
rule = do
  env <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  uf0 <- Cli.expectLatestParsedFile
  let (prepare, uf, finish) = UF.prepareRewrite uf0
  (ppe, _ns, rules) <- lookupRewrite InvalidStructuredFindReplace prepare rule
  (dest, _) <- Cli.expectLatestFile
  #latestFile ?= (dest, True)
  let go Int
n t
tm [] = if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
0 :: Int) then Maybe t
forall a. Maybe a
Nothing else t -> Maybe t
forall a. a -> Maybe a
Just t
tm
      go Int
n t
tm ((t -> Maybe t
r, b
_) : [(t -> Maybe t, b)]
rules) = case t -> Maybe t
r t
tm of
        Maybe t
Nothing -> Int -> t -> [(t -> Maybe t, b)] -> Maybe t
go Int
n t
tm [(t -> Maybe t, b)]
rules
        Just t
tm -> Int -> t -> [(t -> Maybe t, b)] -> Maybe t
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) t
tm [(t -> Maybe t, b)]
rules
      (vs, uf0') = UF.rewrite (Set.singleton (HQ.toVar rule)) (\Term Symbol Ann
tm -> Int
-> Term Symbol Ann
-> [(Term Symbol Ann -> Maybe (Term Symbol Ann),
     Term Symbol Ann -> Bool)]
-> Maybe (Term Symbol Ann)
forall {t} {b}. Int -> t -> [(t -> Maybe t, b)] -> Maybe t
go Int
0 Term Symbol Ann
tm [(Term Symbol Ann -> Maybe (Term Symbol Ann),
  Term Symbol Ann -> Bool)]
rules) uf
      uf' = ([Symbol]
vs, UnisonFile Symbol Ann -> UnisonFile Symbol Ann
finish UnisonFile Symbol Ann
uf0')
  #latestTypecheckedFile .= Just (Left . snd $ uf')
  let msg = FilePath
"| Rewrote using: "
  let rendered = Width -> Pretty ColorText -> Text
P.toPlain Width
80 (Pretty ColorText -> Text) -> Pretty ColorText -> Text
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnvDecl
-> FilePath
-> ([Symbol], UnisonFile Symbol Ann)
-> Pretty ColorText
forall a v.
(Ord a, Var v) =>
PrettyPrintEnvDecl
-> FilePath -> ([v], UnisonFile v a) -> Pretty ColorText
renderRewrittenFile PrettyPrintEnvDecl
ppe FilePath
msg ([Symbol], UnisonFile Symbol Ann)
uf'
  liftIO $ env.writeSource (Text.pack dest) rendered True
  Cli.respond $ OutputRewrittenFile dest vs

handleStructuredFindI :: HQ.HashQualified Name -> Cli ()
handleStructuredFindI :: HashQualified Name -> Cli ()
handleStructuredFindI HashQualified Name
rule = do
  Cli.Env {codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  (ppe, names, rules0) <- lookupRewrite InvalidStructuredFind (\[Symbol]
_ Term Symbol Ann
tm -> Term Symbol Ann
tm) rule
  let rules = (Term Symbol Ann -> Maybe (Term Symbol Ann),
 Term Symbol Ann -> Bool)
-> Term Symbol Ann -> Bool
forall a b. (a, b) -> b
snd ((Term Symbol Ann -> Maybe (Term Symbol Ann),
  Term Symbol Ann -> Bool)
 -> Term Symbol Ann -> Bool)
-> [(Term Symbol Ann -> Maybe (Term Symbol Ann),
     Term Symbol Ann -> Bool)]
-> [Term Symbol Ann -> Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Term Symbol Ann -> Maybe (Term Symbol Ann),
  Term Symbol Ann -> Bool)]
rules0
  let fqppe = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.unsuffixifiedPPE PrettyPrintEnvDecl
ppe
  results :: [(HQ.HashQualified Name, Referent)] <- pure $ do
    r <- Set.toList (Relation.ran $ Names.terms names)
    Just hq <- [PPE.terms fqppe r]
    fullName <- [HQ'.toName hq]
    guard (not (Name.beginsWithSegment fullName NameSegment.libSegment))
    Referent.Ref _ <- pure r
    Just shortName <- [PPE.terms (PPED.suffixifiedPPE ppe) r]
    pure (HQ'.toHQ shortName, r)
  let ok (HashQualified Name
hq, Referent.Ref (Reference.DerivedId Id' Hash
r)) = do
        oe <- Transaction (Maybe (Term Symbol Ann))
-> Cli (Maybe (Term Symbol Ann))
forall a. Transaction a -> Cli a
Cli.runTransaction (Codebase IO Symbol Ann
-> Id' Hash -> Transaction (Maybe (Term Symbol Ann))
forall (m :: * -> *) v a.
Codebase m v a -> Id' Hash -> Transaction (Maybe (Term v a))
Codebase.getTerm Codebase IO Symbol Ann
codebase Id' Hash
r)
        pure $ (hq, maybe False (\Term Symbol Ann
e -> ((Term Symbol Ann -> Bool) -> Bool)
-> [Term Symbol Ann -> Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Term Symbol Ann -> Bool) -> Term Symbol Ann -> Bool
forall a b. (a -> b) -> a -> b
$ Term Symbol Ann
e) [Term Symbol Ann -> Bool]
rules) oe)
      ok (HashQualified Name
hq, Referent
_) = (HashQualified Name, Bool) -> Cli (HashQualified Name, Bool)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashQualified Name
hq, Bool
False)
  results0 <- traverse ok results
  let results = [HashQualified Name] -> [HashQualified Name]
forall a. Alphabetical a => [a] -> [a]
Alphabetical.sortAlphabetically [HashQualified Name
hq | (HashQualified Name
hq, Bool
True) <- [(HashQualified Name, Bool)]
results0]
  Cli.setNumberedArgs $ map SA.HashQualified results
  Cli.respond (ListStructuredFind results)

handleTextFindI :: Bool -> [String] -> Cli ()
handleTextFindI :: Bool -> [FilePath] -> Cli ()
handleTextFindI Bool
allowLib [FilePath]
tokens = do
  Cli.Env {codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  currentBranch <- Cli.getCurrentBranch0
  hqLength <- Cli.runTransaction Codebase.hashLength
  let names = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
currentBranch
  let ppe = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
hqLength Names
names) (Names -> Suffixifier
PPE.suffixifyByHash Names
names)
  let fqppe = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.unsuffixifiedPPE PrettyPrintEnvDecl
ppe
  results :: [(HQ.HashQualified Name, Referent)] <- pure $ do
    r <- Set.toList (Relation.ran $ Names.terms names)
    Just hq <- [PPE.terms fqppe r]
    fullName <- [HQ'.toName hq]
    guard (allowLib || not (Name.beginsWithSegment fullName NameSegment.libSegment))
    Referent.Ref _ <- pure r
    Just shortName <- [PPE.terms (PPED.suffixifiedPPE ppe) r]
    pure (HQ'.toHQ shortName, r)
  let ok (HashQualified Name
hq, Referent.Ref (Reference.DerivedId Id' Hash
r)) = do
        oe <- Transaction (Maybe (Term Symbol Ann))
-> Cli (Maybe (Term Symbol Ann))
forall a. Transaction a -> Cli a
Cli.runTransaction (Codebase IO Symbol Ann
-> Id' Hash -> Transaction (Maybe (Term Symbol Ann))
forall (m :: * -> *) v a.
Codebase m v a -> Id' Hash -> Transaction (Maybe (Term v a))
Codebase.getTerm Codebase IO Symbol Ann
codebase Id' Hash
r)
        pure $ (hq, maybe False containsTokens oe)
      ok (HashQualified Name
hq, Referent
_) = (HashQualified Name, Bool) -> Cli (HashQualified Name, Bool)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashQualified Name
hq, Bool
False)
  results0 <- traverse ok results
  let results = [HashQualified Name] -> [HashQualified Name]
forall a. Alphabetical a => [a] -> [a]
Alphabetical.sortAlphabetically [HashQualified Name
hq | (HashQualified Name
hq, Bool
True) <- [(HashQualified Name, Bool)]
results0]
  Cli.setNumberedArgs $ map SA.HashQualified results
  Cli.respond (ListTextFind allowLib results)
  where
    tokensTxt :: [Text]
tokensTxt = FilePath -> Text
Text.pack (FilePath -> Text) -> [FilePath] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath]
tokens
    containsTokens :: Term Symbol Ann -> Bool
containsTokens Term Symbol Ann
tm =
      [Text] -> Bool
hasAll ([Text] -> Bool) -> ([[Text]] -> [Text]) -> [[Text]] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Text]] -> [Text]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Text]] -> Bool) -> [[Text]] -> Bool
forall a b. (a -> b) -> a -> b
$ (Term Symbol Ann -> FindAction [Text])
-> Term Symbol Ann -> [[Text]]
forall v (f :: * -> *) a x.
(Ord v, Foldable f, Functor f) =>
(Term f v a -> FindAction x) -> Term f v a -> [x]
ABT.find Term Symbol Ann -> FindAction [Text]
forall {typeVar} {typeAnn} {loc} {v} {a}.
Term (F typeVar typeAnn loc) v a -> FindAction [Text]
txts Term Symbol Ann
tm
      where
        hasAll :: [Text] -> Bool
hasAll [Text]
txts = (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Text
tok -> (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Text
haystack -> Text -> Text -> Bool
Text.isInfixOf Text
tok Text
haystack) [Text]
txts) [Text]
tokensTxt
        txts :: Term (F typeVar typeAnn loc) v a -> FindAction [Text]
txts (Term.Text' Text
haystack) = [Text] -> FindAction [Text]
forall x. x -> FindAction x
ABT.Found [Text
haystack]
        txts (Term.Nat' Word64
haystack) = [Text] -> FindAction [Text]
forall x. x -> FindAction x
ABT.Found [FilePath -> Text
Text.pack (Word64 -> FilePath
forall a. Show a => a -> FilePath
show Word64
haystack)]
        txts (Term.Int' Int64
haystack) = [Text] -> FindAction [Text]
forall x. x -> FindAction x
ABT.Found [FilePath -> Text
Text.pack (Int64 -> FilePath
forall a. Show a => a -> FilePath
show Int64
haystack)]
        txts (Term.Float' Double
haystack) = [Text] -> FindAction [Text]
forall x. x -> FindAction x
ABT.Found [FilePath -> Text
Text.pack (Double -> FilePath
forall a. Show a => a -> FilePath
show Double
haystack)]
        txts (Term.Char' Char
haystack) = [Text] -> FindAction [Text]
forall x. x -> FindAction x
ABT.Found [FilePath -> Text
Text.pack [Char
haystack]]
        txts (Term.Match' Term (F typeVar typeAnn loc) v a
_ [MatchCase loc (Term (F typeVar typeAnn loc) v a)]
cases) = [Text] -> FindAction [Text]
forall x. x -> FindAction x
ABT.Found [Text]
r
          where
            r :: [Text]
r = [[Text]] -> [Text]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Text]] -> [Text]) -> [[Text]] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Pattern loc -> [Text]) -> Pattern loc -> [Text]
forall m loc. Monoid m => (Pattern loc -> m) -> Pattern loc -> m
Pattern.foldMap' Pattern loc -> [Text]
forall {loc}. Pattern loc -> [Text]
txtPattern (Pattern loc -> [Text])
-> (MatchCase loc (Term (F typeVar typeAnn loc) v a)
    -> Pattern loc)
-> MatchCase loc (Term (F typeVar typeAnn loc) v a)
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchCase loc (Term (F typeVar typeAnn loc) v a) -> Pattern loc
forall loc a. MatchCase loc a -> Pattern loc
Term.matchPattern (MatchCase loc (Term (F typeVar typeAnn loc) v a) -> [Text])
-> [MatchCase loc (Term (F typeVar typeAnn loc) v a)] -> [[Text]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [MatchCase loc (Term (F typeVar typeAnn loc) v a)]
cases
        txts Term (F typeVar typeAnn loc) v a
_ = FindAction [Text]
forall x. FindAction x
ABT.Continue
        txtPattern :: Pattern loc -> [Text]
txtPattern (Pattern.Text loc
_ Text
txt) = [Text
txt]
        txtPattern (Pattern.Nat loc
_ Word64
n) = [FilePath -> Text
Text.pack (Word64 -> FilePath
forall a. Show a => a -> FilePath
show Word64
n)]
        txtPattern (Pattern.Int loc
_ Int64
n) = [FilePath -> Text
Text.pack (Int64 -> FilePath
forall a. Show a => a -> FilePath
show Int64
n)]
        txtPattern (Pattern.Float loc
_ Double
n) = [FilePath -> Text
Text.pack (Double -> FilePath
forall a. Show a => a -> FilePath
show Double
n)]
        txtPattern (Pattern.Char loc
_ Char
c) = [FilePath -> Text
Text.pack [Char
c]]
        txtPattern Pattern loc
_ = []

lookupRewrite ::
  (HQ.HashQualified Name -> Output) ->
  ([Symbol] -> Term Symbol Ann -> Term Symbol Ann) ->
  HQ.HashQualified Name ->
  Cli (PPED.PrettyPrintEnvDecl, Names, [(Term Symbol Ann -> Maybe (Term Symbol Ann), Term Symbol Ann -> Bool)])
lookupRewrite :: (HashQualified Name -> Output)
-> ([Symbol] -> Term Symbol Ann -> Term Symbol Ann)
-> HashQualified Name
-> Cli
     (PrettyPrintEnvDecl, Names,
      [(Term Symbol Ann -> Maybe (Term Symbol Ann),
        Term Symbol Ann -> Bool)])
lookupRewrite HashQualified Name -> Output
onErr [Symbol] -> Term Symbol Ann -> Term Symbol Ann
prepare HashQualified Name
rule = do
  Cli.Env {codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  currentBranch <- Cli.getCurrentBranch0
  hqLength <- Cli.runTransaction Codebase.hashLength
  fileNames <- Cli.getNamesFromLatestFile
  let currentNames = Names
fileNames Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
currentBranch
  let ppe = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
hqLength Names
currentNames) (Names -> Suffixifier
PPE.suffixifyByHash Names
currentNames)
  ot <- Cli.getTermFromLatestParsedFile rule
  ot <- case ot of
    Just Term Symbol Ann
_ -> Maybe (Term Symbol Ann) -> Cli (Maybe (Term Symbol Ann))
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Term Symbol Ann)
ot
    Maybe (Term Symbol Ann)
Nothing -> do
      case SearchType -> HashQualified Name -> Names -> Set Referent
Names.lookupHQTerm SearchType
Names.IncludeSuffixes HashQualified Name
rule Names
currentNames of
        Set Referent
s
          | Set Referent -> Int
forall a. Set a -> Int
Set.size Set Referent
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1,
            Referent.Ref (Reference.DerivedId Id' Hash
r) <- Set Referent -> Referent
forall a. Set a -> a
Set.findMin Set Referent
s ->
              Transaction (Maybe (Term Symbol Ann))
-> Cli (Maybe (Term Symbol Ann))
forall a. Transaction a -> Cli a
Cli.runTransaction (Codebase IO Symbol Ann
-> Id' Hash -> Transaction (Maybe (Term Symbol Ann))
forall (m :: * -> *) v a.
Codebase m v a -> Id' Hash -> Transaction (Maybe (Term v a))
Codebase.getTerm Codebase IO Symbol Ann
codebase Id' Hash
r)
        Set Referent
s -> Output -> Cli (Maybe (Term Symbol Ann))
forall a. Output -> Cli a
Cli.returnEarly (PrettyPrintEnv -> HashQualified Name -> Set Referent -> Output
TermAmbiguous (PrettyPrintEnvDecl -> PrettyPrintEnv
PPE.suffixifiedPPE PrettyPrintEnvDecl
ppe) HashQualified Name
rule Set Referent
s)
  tm <- maybe (Cli.returnEarly (TermAmbiguous (PPE.suffixifiedPPE ppe) rule mempty)) pure ot
  let extract [Symbol]
vs Term Symbol Ann
tm = case Term Symbol Ann
tm of
        Term.Ann' Term Symbol Ann
tm Type Symbol Ann
_typ -> [Symbol]
-> Term Symbol Ann
-> Cli
     (Term Symbol Ann -> Maybe (Term Symbol Ann),
      Term Symbol Ann -> Bool)
extract [Symbol]
vs Term Symbol Ann
tm
        (DD.RewriteTerm' Term Symbol Ann
lhs Term Symbol Ann
rhs) ->
          (Term Symbol Ann -> Maybe (Term Symbol Ann),
 Term Symbol Ann -> Bool)
-> Cli
     (Term Symbol Ann -> Maybe (Term Symbol Ann),
      Term Symbol Ann -> Bool)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            ( Term Symbol Ann
-> Term Symbol Ann -> Term Symbol Ann -> Maybe (Term Symbol Ann)
forall (f :: * -> *) v a.
(Var v, Show v, forall a1. Eq a1 => Eq (f a1),
 forall a1. Show a1 => Show (f a1), Traversable f) =>
Term f v a -> Term f v a -> Term f v a -> Maybe (Term f v a)
ABT.rewriteExpression Term Symbol Ann
lhs Term Symbol Ann
rhs,
              Term Symbol Ann -> Term Symbol Ann -> Bool
forall (f :: * -> *) v a.
(Var v, forall a1. Eq a1 => Eq (f a1), Traversable f) =>
Term f v a -> Term f v a -> Bool
ABT.containsExpression Term Symbol Ann
lhs
            )
        (DD.RewriteCase' Term Symbol Ann
lhs Term Symbol Ann
rhs) ->
          (Term Symbol Ann -> Maybe (Term Symbol Ann),
 Term Symbol Ann -> Bool)
-> Cli
     (Term Symbol Ann -> Maybe (Term Symbol Ann),
      Term Symbol Ann -> Bool)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            ( Term Symbol Ann
-> Term Symbol Ann -> Term Symbol Ann -> Maybe (Term Symbol Ann)
forall v typeVar typeAnn a.
(Var v, Var typeVar, Ord v, Show typeVar, Eq typeAnn,
 Semigroup a) =>
Term2 typeVar typeAnn a v a
-> Term2 typeVar typeAnn a v a
-> Term2 typeVar typeAnn a v a
-> Maybe (Term2 typeVar typeAnn a v a)
Term.rewriteCasesLHS Term Symbol Ann
lhs Term Symbol Ann
rhs,
              Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool)
-> (Term Symbol Ann -> Maybe Bool) -> Term Symbol Ann -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term Symbol Ann -> Term Symbol Ann -> Maybe Bool
forall v1 tv ta tb loc typeVar typeAnn v2 a.
Var v1 =>
Term2 tv ta tb v1 loc
-> Term2 typeVar typeAnn loc v2 a -> Maybe Bool
Term.containsCaseTerm Term Symbol Ann
lhs
            )
        (DD.RewriteSignature' [Symbol]
_vs Type Symbol Ann
lhs Type Symbol Ann
rhs) ->
          (Term Symbol Ann -> Maybe (Term Symbol Ann),
 Term Symbol Ann -> Bool)
-> Cli
     (Term Symbol Ann -> Maybe (Term Symbol Ann),
      Term Symbol Ann -> Bool)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type Symbol Ann
-> Type Symbol Ann -> Term Symbol Ann -> Maybe (Term Symbol Ann)
forall v vt at ap a.
(Ord v, Var vt, Show vt) =>
Type vt at
-> Type vt at -> Term2 vt at ap v a -> Maybe (Term2 vt at ap v a)
Term.rewriteSignatures Type Symbol Ann
lhs Type Symbol Ann
rhs, Type Symbol Ann -> Term Symbol Ann -> Bool
forall v vt at ap a.
(Ord v, Var vt, Show vt) =>
Type vt at -> Term2 vt at ap v a -> Bool
Term.containsSignature Type Symbol Ann
lhs)
        Term Symbol Ann
_ -> Output
-> Cli
     (Term Symbol Ann -> Maybe (Term Symbol Ann),
      Term Symbol Ann -> Bool)
forall a. Output -> Cli a
Cli.returnEarly (HashQualified Name -> Output
onErr HashQualified Name
rule)
      extractOuter [Symbol]
vs0 Term Symbol Ann
tm = case Term Symbol Ann
tm of
        Term.Ann' Term Symbol Ann
tm Type Symbol Ann
_typ -> [Symbol]
-> Term Symbol Ann
-> Cli
     [(Term Symbol Ann -> Maybe (Term Symbol Ann),
       Term Symbol Ann -> Bool)]
extractOuter [Symbol]
vs0 Term Symbol Ann
tm
        Term.LamsNamed' [Symbol]
vs Term Symbol Ann
tm -> [Symbol]
-> Term Symbol Ann
-> Cli
     [(Term Symbol Ann -> Maybe (Term Symbol Ann),
       Term Symbol Ann -> Bool)]
extractOuter ([Symbol]
vs0 [Symbol] -> [Symbol] -> [Symbol]
forall a. [a] -> [a] -> [a]
++ [Symbol]
vs) Term Symbol Ann
tm
        Term Symbol Ann
tm -> case [Symbol] -> Term Symbol Ann -> Term Symbol Ann
prepare [Symbol]
vs0 Term Symbol Ann
tm of
          DD.Rewrites' [Term Symbol Ann]
rules -> (Term Symbol Ann
 -> Cli
      (Term Symbol Ann -> Maybe (Term Symbol Ann),
       Term Symbol Ann -> Bool))
-> [Term Symbol Ann]
-> Cli
     [(Term Symbol Ann -> Maybe (Term Symbol Ann),
       Term Symbol Ann -> Bool)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ([Symbol]
-> Term Symbol Ann
-> Cli
     (Term Symbol Ann -> Maybe (Term Symbol Ann),
      Term Symbol Ann -> Bool)
extract [Symbol]
vs0) [Term Symbol Ann]
rules
          Term Symbol Ann
_ -> Output
-> Cli
     [(Term Symbol Ann -> Maybe (Term Symbol Ann),
       Term Symbol Ann -> Bool)]
forall a. Output -> Cli a
Cli.returnEarly (HashQualified Name -> Output
onErr HashQualified Name
rule)
  rules <- extractOuter [] tm
  pure (ppe, currentNames, rules)

renderRewrittenFile :: (Ord a, Var v) => PPED.PrettyPrintEnvDecl -> String -> ([v], UF.UnisonFile v a) -> P.Pretty P.ColorText
renderRewrittenFile :: forall a v.
(Ord a, Var v) =>
PrettyPrintEnvDecl
-> FilePath -> ([v], UnisonFile v a) -> Pretty ColorText
renderRewrittenFile PrettyPrintEnvDecl
ppe FilePath
msg ([v]
vs, UnisonFile v a
uf) = do
  let prettyVar :: v -> Pretty ColorText
prettyVar = Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty ColorText) -> (v -> Text) -> v -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Text
forall v. Var v => v -> Text
Var.name
      modifiedDefs :: Pretty ColorText
modifiedDefs = Pretty ColorText -> [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sep Pretty ColorText
" " (Pretty ColorText -> Pretty ColorText
P.blue (Pretty ColorText -> Pretty ColorText)
-> (v -> Pretty ColorText) -> v -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Pretty ColorText
prettyVar (v -> Pretty ColorText) -> [v] -> [Pretty ColorText]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v]
vs)
      header :: Pretty ColorText
header = Pretty ColorText
"-- " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> FilePath -> Pretty ColorText
forall s. IsString s => FilePath -> Pretty s
P.string FilePath
msg Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"\n" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"-- | Modified definition(s): " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
modifiedDefs
   in (Pretty ColorText
header Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"\n\n" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> PrettyPrintEnvDecl -> UnisonFile v a -> Pretty ColorText
forall v a.
(Var v, Ord a) =>
PrettyPrintEnvDecl -> UnisonFile v a -> Pretty ColorText
P.prettyUnisonFile PrettyPrintEnvDecl
ppe UnisonFile v a
uf)