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.PrettyPrintEnvDecl.Names 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
env <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  UnisonFile Symbol Ann
uf0 <- Cli (UnisonFile Symbol Ann)
Cli.expectLatestParsedFile
  let ([Symbol] -> Term Symbol Ann -> Term Symbol Ann
prepare, UnisonFile Symbol Ann
uf, UnisonFile Symbol Ann -> UnisonFile Symbol Ann
finish) = UnisonFile Symbol Ann
-> ([Symbol] -> Term Symbol Ann -> Term Symbol Ann,
    UnisonFile Symbol Ann,
    UnisonFile Symbol Ann -> UnisonFile Symbol Ann)
forall a v.
(Monoid a, Var v) =>
UnisonFile v a
-> ([v] -> Term v a -> Term v a, UnisonFile v a,
    UnisonFile v a -> UnisonFile v a)
UF.prepareRewrite UnisonFile Symbol Ann
uf0
  (PrettyPrintEnvDecl
ppe, Names
_ns, [(Term Symbol Ann -> Maybe (Term Symbol Ann),
  Term Symbol Ann -> Bool)]
rules) <- (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
InvalidStructuredFindReplace [Symbol] -> Term Symbol Ann -> Term Symbol Ann
prepare HashQualified Name
rule
  (FilePath
dest, Bool
_) <- Cli (FilePath, Bool)
Cli.expectLatestFile
  #latestFile ?= (dest, True)
  let go :: Int -> t -> [(t -> Maybe t, b)] -> Maybe t
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
      ([Symbol]
vs, UnisonFile Symbol Ann
uf0') = Set Symbol
-> (Term Symbol Ann -> Maybe (Term Symbol Ann))
-> UnisonFile Symbol Ann
-> ([Symbol], UnisonFile Symbol Ann)
forall v a.
(Var v, Eq a) =>
Set v
-> (Term v a -> Maybe (Term v a))
-> UnisonFile v a
-> ([v], UnisonFile v a)
UF.rewrite (Symbol -> Set Symbol
forall a. a -> Set a
Set.singleton (HashQualified Name -> Symbol
forall v. Var v => HashQualified Name -> v
HQ.toVar HashQualified Name
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) UnisonFile Symbol Ann
uf
      uf' :: ([Symbol], UnisonFile Symbol Ann)
uf' = ([Symbol]
vs, UnisonFile Symbol Ann -> UnisonFile Symbol Ann
finish UnisonFile Symbol Ann
uf0')
  #latestTypecheckedFile .= Just (Left . snd $ uf')
  let msg :: FilePath
msg = FilePath
"| Rewrote using: "
  let rendered :: Text
rendered = FilePath -> Text
Text.pack (FilePath -> Text)
-> (Pretty ColorText -> FilePath) -> Pretty ColorText -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Width -> Pretty ColorText -> FilePath
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'
  IO () -> Cli ()
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Cli ()) -> IO () -> Cli ()
forall a b. (a -> b) -> a -> b
$ Env
env.writeSource (FilePath -> Text
Text.pack FilePath
dest) Text
rendered Bool
True
  Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$ FilePath -> [Symbol] -> Output
OutputRewrittenFile FilePath
dest [Symbol]
vs

handleStructuredFindI :: HQ.HashQualified Name -> Cli ()
handleStructuredFindI :: HashQualified Name -> Cli ()
handleStructuredFindI HashQualified Name
rule = do
  Cli.Env {Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  (PrettyPrintEnvDecl
ppe, Names
names, [(Term Symbol Ann -> Maybe (Term Symbol Ann),
  Term Symbol Ann -> Bool)]
rules0) <- (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
InvalidStructuredFind (\[Symbol]
_ Term Symbol Ann
tm -> Term Symbol Ann
tm) HashQualified Name
rule
  let rules :: [Term Symbol Ann -> Bool]
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 :: PrettyPrintEnv
fqppe = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.unsuffixifiedPPE PrettyPrintEnvDecl
ppe
  [(HashQualified Name, Referent)]
results :: [(HQ.HashQualified Name, Referent)] <- [(HashQualified Name, Referent)]
-> Cli [(HashQualified Name, Referent)]
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(HashQualified Name, Referent)]
 -> Cli [(HashQualified Name, Referent)])
-> [(HashQualified Name, Referent)]
-> Cli [(HashQualified Name, Referent)]
forall a b. (a -> b) -> a -> b
$ do
    Referent
r <- Set Referent -> [Referent]
forall a. Set a -> [a]
Set.toList (Relation Name Referent -> Set Referent
forall a b. Relation a b -> Set b
Relation.ran (Relation Name Referent -> Set Referent)
-> Relation Name Referent -> Set Referent
forall a b. (a -> b) -> a -> b
$ Names -> Relation Name Referent
Names.terms Names
names)
    Just HashQualified Name
hq <- [PrettyPrintEnv -> Referent -> Maybe (HashQualified Name)
PPE.terms PrettyPrintEnv
fqppe Referent
r]
    Name
fullName <- [HashQualified Name -> Name
forall n. HashQualified n -> n
HQ'.toName HashQualified Name
hq]
    Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Name -> NameSegment -> Bool
Name.beginsWithSegment Name
fullName NameSegment
NameSegment.libSegment))
    Referent.Ref Reference' Text Hash
_ <- Referent -> [Referent]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Referent
r
    Just HashQualified Name
shortName <- [PrettyPrintEnv -> Referent -> Maybe (HashQualified Name)
PPE.terms (PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE PrettyPrintEnvDecl
ppe) Referent
r]
    pure (HashQualified Name -> HashQualified Name
forall n. HashQualified n -> HashQualified n
HQ'.toHQ HashQualified Name
shortName, Referent
r)
  let ok :: (HashQualified Name, Referent) -> Cli (HashQualified Name, Bool)
ok (HashQualified Name
hq, Referent.Ref (Reference.DerivedId Id' Hash
r)) = do
        Maybe (Term Symbol Ann)
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 $ (HashQualified Name
hq, Bool
-> (Term Symbol Ann -> Bool) -> Maybe (Term Symbol Ann) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
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) Maybe (Term Symbol Ann)
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)
  [(HashQualified Name, Bool)]
results0 <- ((HashQualified Name, Referent) -> Cli (HashQualified Name, Bool))
-> [(HashQualified Name, Referent)]
-> Cli [(HashQualified Name, 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 (HashQualified Name, Referent) -> Cli (HashQualified Name, Bool)
ok [(HashQualified Name, Referent)]
results
  let results :: [HashQualified Name]
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]
  NumberedArgs -> Cli ()
Cli.setNumberedArgs (NumberedArgs -> Cli ()) -> NumberedArgs -> Cli ()
forall a b. (a -> b) -> a -> b
$ (HashQualified Name -> StructuredArgument)
-> [HashQualified Name] -> NumberedArgs
forall a b. (a -> b) -> [a] -> [b]
map HashQualified Name -> StructuredArgument
SA.HashQualified [HashQualified Name]
results
  Output -> Cli ()
Cli.respond ([HashQualified Name] -> Output
ListStructuredFind [HashQualified Name]
results)

handleTextFindI :: Bool -> [String] -> Cli ()
handleTextFindI :: Bool -> [FilePath] -> Cli ()
handleTextFindI Bool
allowLib [FilePath]
tokens = do
  Cli.Env {Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  Branch0 IO
currentBranch <- Cli (Branch0 IO)
Cli.getCurrentBranch0
  Int
hqLength <- Transaction Int -> Cli Int
forall a. Transaction a -> Cli a
Cli.runTransaction Transaction Int
Codebase.hashLength
  let names :: Names
names = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
currentBranch
  let ppe :: PrettyPrintEnvDecl
ppe = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
hqLength Names
names) (Names -> Suffixifier
PPE.suffixifyByHash Names
names)
  let fqppe :: PrettyPrintEnv
fqppe = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.unsuffixifiedPPE PrettyPrintEnvDecl
ppe
  [(HashQualified Name, Referent)]
results :: [(HQ.HashQualified Name, Referent)] <- [(HashQualified Name, Referent)]
-> Cli [(HashQualified Name, Referent)]
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(HashQualified Name, Referent)]
 -> Cli [(HashQualified Name, Referent)])
-> [(HashQualified Name, Referent)]
-> Cli [(HashQualified Name, Referent)]
forall a b. (a -> b) -> a -> b
$ do
    Referent
r <- Set Referent -> [Referent]
forall a. Set a -> [a]
Set.toList (Relation Name Referent -> Set Referent
forall a b. Relation a b -> Set b
Relation.ran (Relation Name Referent -> Set Referent)
-> Relation Name Referent -> Set Referent
forall a b. (a -> b) -> a -> b
$ Names -> Relation Name Referent
Names.terms Names
names)
    Just HashQualified Name
hq <- [PrettyPrintEnv -> Referent -> Maybe (HashQualified Name)
PPE.terms PrettyPrintEnv
fqppe Referent
r]
    Name
fullName <- [HashQualified Name -> Name
forall n. HashQualified n -> n
HQ'.toName HashQualified Name
hq]
    Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool
allowLib Bool -> Bool -> Bool
|| Bool -> Bool
not (Name -> NameSegment -> Bool
Name.beginsWithSegment Name
fullName NameSegment
NameSegment.libSegment))
    Referent.Ref Reference' Text Hash
_ <- Referent -> [Referent]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Referent
r
    Just HashQualified Name
shortName <- [PrettyPrintEnv -> Referent -> Maybe (HashQualified Name)
PPE.terms (PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE PrettyPrintEnvDecl
ppe) Referent
r]
    pure (HashQualified Name -> HashQualified Name
forall n. HashQualified n -> HashQualified n
HQ'.toHQ HashQualified Name
shortName, Referent
r)
  let ok :: (HashQualified Name, Referent) -> Cli (HashQualified Name, Bool)
ok (HashQualified Name
hq, Referent.Ref (Reference.DerivedId Id' Hash
r)) = do
        Maybe (Term Symbol Ann)
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 $ (HashQualified Name
hq, Bool
-> (Term Symbol Ann -> Bool) -> Maybe (Term Symbol Ann) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Term Symbol Ann -> Bool
containsTokens Maybe (Term Symbol Ann)
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)
  [(HashQualified Name, Bool)]
results0 <- ((HashQualified Name, Referent) -> Cli (HashQualified Name, Bool))
-> [(HashQualified Name, Referent)]
-> Cli [(HashQualified Name, 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 (HashQualified Name, Referent) -> Cli (HashQualified Name, Bool)
ok [(HashQualified Name, Referent)]
results
  let results :: [HashQualified Name]
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]
  NumberedArgs -> Cli ()
Cli.setNumberedArgs (NumberedArgs -> Cli ()) -> NumberedArgs -> Cli ()
forall a b. (a -> b) -> a -> b
$ (HashQualified Name -> StructuredArgument)
-> [HashQualified Name] -> NumberedArgs
forall a b. (a -> b) -> [a] -> [b]
map HashQualified Name -> StructuredArgument
SA.HashQualified [HashQualified Name]
results
  Output -> Cli ()
Cli.respond (Bool -> [HashQualified Name] -> Output
ListTextFind Bool
allowLib [HashQualified Name]
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 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 IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  Branch0 IO
currentBranch <- Cli (Branch0 IO)
Cli.getCurrentBranch0
  Int
hqLength <- Transaction Int -> Cli Int
forall a. Transaction a -> Cli a
Cli.runTransaction Transaction Int
Codebase.hashLength
  Names
fileNames <- Cli Names
Cli.getNamesFromLatestFile
  let currentNames :: Names
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 :: PrettyPrintEnvDecl
ppe = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
hqLength Names
currentNames) (Names -> Suffixifier
PPE.suffixifyByHash Names
currentNames)
  Maybe (Term Symbol Ann)
ot <- HashQualified Name -> Cli (Maybe (Term Symbol Ann))
Cli.getTermFromLatestParsedFile HashQualified Name
rule
  Maybe (Term Symbol Ann)
ot <- case Maybe (Term Symbol Ann)
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)
  Term Symbol Ann
tm <- Cli (Term Symbol Ann)
-> (Term Symbol Ann -> Cli (Term Symbol Ann))
-> Maybe (Term Symbol Ann)
-> Cli (Term Symbol Ann)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Output -> Cli (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
forall a. Monoid a => a
mempty)) Term Symbol Ann -> Cli (Term Symbol Ann)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Term Symbol Ann)
ot
  let extract :: [Symbol]
-> Term Symbol Ann
-> Cli
     (Term Symbol Ann -> Maybe (Term Symbol Ann),
      Term Symbol Ann -> Bool)
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]
-> Term Symbol Ann
-> Cli
     [(Term Symbol Ann -> Maybe (Term Symbol Ann),
       Term Symbol Ann -> Bool)]
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)
  [(Term Symbol Ann -> Maybe (Term Symbol Ann),
  Term Symbol Ann -> Bool)]
rules <- [Symbol]
-> Term Symbol Ann
-> Cli
     [(Term Symbol Ann -> Maybe (Term Symbol Ann),
       Term Symbol Ann -> Bool)]
extractOuter [] Term Symbol Ann
tm
  pure (PrettyPrintEnvDecl
ppe, Names
currentNames, [(Term Symbol Ann -> Maybe (Term Symbol Ann),
  Term Symbol Ann -> Bool)]
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)