module Unison.Codebase.Editor.HandleInput.ShowDefinition (showDefinitions) where

import Control.Lens
import Control.Monad.Reader (ask)
import Control.Monad.State qualified as State
import Data.Map qualified as Map
import Data.Set qualified as Set
import Data.Text qualified as Text
import Unison.Builtin.Decls qualified as DD
import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.Pretty qualified as Pretty
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Editor.DisplayObject (DisplayObject)
import Unison.Codebase.Editor.Input
import Unison.Codebase.Editor.Output
import Unison.DataDeclaration (Decl)
import Unison.HashQualified qualified as HQ
import Unison.Name (Name)
import Unison.Parser.Ann (Ann)
import Unison.Prelude
import Unison.PrettyPrintEnvDecl qualified as PPED
import Unison.Reference qualified as Reference
import Unison.Symbol (Symbol)
import Unison.Term (Term)
import Unison.Type (Type)
import Unison.Util.Pretty qualified as Pretty
import Unison.Util.Set qualified as Set

-- | Show the provided definitions to console or scratch file.
-- The caller is responsible for ensuring that the definitions include cycles if that's
-- the desired behavior.
showDefinitions ::
  OutputLocation ->
  PPED.PrettyPrintEnvDecl ->
  (Map Reference.Reference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))) ->
  ( Map
      Reference.Reference
      (DisplayObject () (Decl Symbol Ann))
  ) ->
  [HQ.HashQualified Name] ->
  Cli ()
showDefinitions :: OutputLocation
-> PrettyPrintEnvDecl
-> Map
     Reference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Map Reference (DisplayObject () (Decl Symbol Ann))
-> [HashQualified Name]
-> Cli ()
showDefinitions OutputLocation
outputLoc PrettyPrintEnvDecl
pped Map Reference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms Map Reference (DisplayObject () (Decl Symbol Ann))
types [HashQualified Name]
misses = do
  Cli.Env {Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase, SourceName -> SourceName -> IO ()
writeSource :: SourceName -> SourceName -> IO ()
$sel:writeSource:Env :: Env -> SourceName -> SourceName -> IO ()
writeSource} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  Maybe FilePath
outputPath <- Cli (Maybe FilePath)
getOutputPath
  case Maybe FilePath
outputPath of
    Maybe FilePath
_ | Map Reference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Bool
forall a. Map Reference a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Reference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms Bool -> Bool -> Bool
&& Map Reference (DisplayObject () (Decl Symbol Ann)) -> Bool
forall a. Map Reference a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Reference (DisplayObject () (Decl Symbol Ann))
types -> () -> Cli ()
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Maybe FilePath
Nothing -> do
      -- If we're writing to console we don't add test-watch syntax
      let isTest :: p -> Bool
isTest p
_ = Bool
False
      let isSourceFile :: Bool
isSourceFile = Bool
False
      -- No filepath, render code to console.
      let renderedCodePretty :: Pretty ColorText
renderedCodePretty = PrettyPrintEnvDecl
-> Bool
-> (TermReferenceId -> Bool)
-> Map
     Reference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Map Reference (DisplayObject () (Decl Symbol Ann))
-> Pretty ColorText
renderCodePretty PrettyPrintEnvDecl
pped Bool
isSourceFile TermReferenceId -> Bool
forall {p}. p -> Bool
isTest Map Reference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms Map Reference (DisplayObject () (Decl Symbol Ann))
types
      Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$ Pretty ColorText -> Output
DisplayDefinitions Pretty ColorText
renderedCodePretty
    Just FilePath
fp -> do
      -- We build an 'isTest' check to prepend "test>" to tests in a scratch file.
      Set TermReferenceId
testRefs <- Transaction (Set TermReferenceId) -> Cli (Set TermReferenceId)
forall a. Transaction a -> Cli a
Cli.runTransaction (Codebase IO Symbol Ann
-> Type Symbol Ann
-> Set TermReferenceId
-> Transaction (Set TermReferenceId)
forall v (m :: * -> *) a.
Var v =>
Codebase m v a
-> Type v a
-> Set TermReferenceId
-> Transaction (Set TermReferenceId)
Codebase.filterTermsByReferenceIdHavingType Codebase IO Symbol Ann
codebase (Ann -> Type Symbol Ann
forall v a. Ord v => a -> Type v a
DD.testResultListType Ann
forall a. Monoid a => a
mempty) (Map Reference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Set Reference
forall k a. Map k a -> Set k
Map.keysSet Map Reference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms Set Reference
-> (Set Reference -> Set TermReferenceId) -> Set TermReferenceId
forall a b. a -> (a -> b) -> b
& (Reference -> Maybe TermReferenceId)
-> Set Reference -> Set TermReferenceId
forall b a. Ord b => (a -> Maybe b) -> Set a -> Set b
Set.mapMaybe Reference -> Maybe TermReferenceId
Reference.toId))
      let isTest :: TermReferenceId -> Bool
isTest TermReferenceId
r = TermReferenceId -> Set TermReferenceId -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member TermReferenceId
r Set TermReferenceId
testRefs
      let isSourceFile :: Bool
isSourceFile = Bool
True
      let renderedCodePretty :: Pretty ColorText
renderedCodePretty = PrettyPrintEnvDecl
-> Bool
-> (TermReferenceId -> Bool)
-> Map
     Reference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Map Reference (DisplayObject () (Decl Symbol Ann))
-> Pretty ColorText
renderCodePretty PrettyPrintEnvDecl
pped Bool
isSourceFile TermReferenceId -> Bool
isTest Map Reference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms Map Reference (DisplayObject () (Decl Symbol Ann))
types
      let renderedCodeText :: SourceName
renderedCodeText = FilePath -> SourceName
Text.pack (FilePath -> SourceName) -> FilePath -> SourceName
forall a b. (a -> b) -> a -> b
$ Width -> Pretty ColorText -> FilePath
Pretty.toPlain Width
80 Pretty ColorText
renderedCodePretty

      -- We set latestFile to be programmatically generated, if we
      -- are viewing these definitions to a file - this will skip the
      -- next update for that file (which will happen immediately)
      #latestFile ?= (fp, True)
      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
$ SourceName -> SourceName -> IO ()
writeSource (FilePath -> SourceName
Text.pack FilePath
fp) SourceName
renderedCodeText
      let numDefinitions :: Int
numDefinitions = Map Reference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Int
forall k a. Map k a -> Int
Map.size Map Reference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Map Reference (DisplayObject () (Decl Symbol Ann)) -> Int
forall k a. Map k a -> Int
Map.size Map Reference (DisplayObject () (Decl Symbol Ann))
types
      Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Int -> Output
LoadedDefinitionsToSourceFile FilePath
fp Int
numDefinitions
  Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([HashQualified Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HashQualified Name]
misses)) (Output -> Cli ()
Cli.respond ([HashQualified Name] -> Output
SearchTermsNotFound [HashQualified Name]
misses))
  where
    -- Get the file path to send the definition(s) to. `Nothing` means the terminal.
    getOutputPath :: Cli (Maybe FilePath)
    getOutputPath :: Cli (Maybe FilePath)
getOutputPath =
      case OutputLocation
outputLoc of
        OutputLocation
ConsoleLocation -> Maybe FilePath -> Cli (Maybe FilePath)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
        FileLocation FilePath
path -> Maybe FilePath -> Cli (Maybe FilePath)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
path)
        OutputLocation
LatestFileLocation -> do
          LoopState
loopState <- Cli LoopState
forall s (m :: * -> *). MonadState s m => m s
State.get
          pure case LoopState
loopState LoopState
-> Getting
     (Maybe (FilePath, Bool)) LoopState (Maybe (FilePath, Bool))
-> Maybe (FilePath, Bool)
forall s a. s -> Getting a s a -> a
^. Getting (Maybe (FilePath, Bool)) LoopState (Maybe (FilePath, Bool))
#latestFile of
            Maybe (FilePath, Bool)
Nothing -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"scratch.u"
            Just (FilePath
path, Bool
_) -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
path

    renderCodePretty :: PrettyPrintEnvDecl
-> Bool
-> (TermReferenceId -> Bool)
-> Map
     Reference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Map Reference (DisplayObject () (Decl Symbol Ann))
-> Pretty ColorText
renderCodePretty PrettyPrintEnvDecl
pped Bool
isSourceFile TermReferenceId -> Bool
isTest Map Reference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms Map Reference (DisplayObject () (Decl Symbol Ann))
types =
      Pretty (SyntaxText' Reference) -> Pretty ColorText
forall r. Pretty (SyntaxText' r) -> Pretty ColorText
Pretty.syntaxToColor (Pretty (SyntaxText' Reference) -> Pretty ColorText)
-> ([Pretty (SyntaxText' Reference)]
    -> Pretty (SyntaxText' Reference))
-> [Pretty (SyntaxText' Reference)]
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty (SyntaxText' Reference)
-> [Pretty (SyntaxText' Reference)]
-> Pretty (SyntaxText' Reference)
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
Pretty.sep Pretty (SyntaxText' Reference)
"\n\n" ([Pretty (SyntaxText' Reference)] -> Pretty ColorText)
-> [Pretty (SyntaxText' Reference)] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
        PrettyPrintEnvDecl
-> Map Reference (DisplayObject () (Decl Symbol Ann))
-> [Pretty (SyntaxText' Reference)]
Pretty.prettyTypeDisplayObjects PrettyPrintEnvDecl
pped Map Reference (DisplayObject () (Decl Symbol Ann))
types [Pretty (SyntaxText' Reference)]
-> [Pretty (SyntaxText' Reference)]
-> [Pretty (SyntaxText' Reference)]
forall a. Semigroup a => a -> a -> a
<> PrettyPrintEnvDecl
-> Bool
-> (TermReferenceId -> Bool)
-> Map
     Reference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> [Pretty (SyntaxText' Reference)]
Pretty.prettyTermDisplayObjects PrettyPrintEnvDecl
pped Bool
isSourceFile TermReferenceId -> Bool
isTest Map Reference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms