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
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
let isTest :: p -> Bool
isTest p
_ = Bool
False
let isSourceFile :: Bool
isSourceFile = Bool
False
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
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
#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
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