-- | @debug.synhash.term@ input handler.
module Unison.Codebase.Editor.HandleInput.DebugSynhashTerm
  ( handleDebugSynhashTerm,
  )
where

import Control.Monad.Reader (ask)
import Data.Text qualified as Text
import Data.Text.IO qualified as Text
import U.Util.Base32Hex qualified as Base32Hex
import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.MonadUtils qualified as Cli
import Unison.Cli.Pretty (prettyBase32Hex, prettyHash)
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch.Names qualified as Branch
import Unison.Codebase.Editor.Output (Output (..))
import Unison.Hash (Hash)
import Unison.Hashable qualified as Hashable
import Unison.Merge.Synhash (hashBuiltinTermTokens, hashDerivedTermTokens)
import Unison.Name (Name)
import Unison.Names qualified as Names
import Unison.Prelude
import Unison.PrettyPrintEnv.Names qualified as PPE
import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..))
import Unison.PrettyPrintEnvDecl.Names qualified as PPED
import Unison.Reference qualified as Reference
import Unison.Syntax.Name qualified as Name
import Unison.Util.Pretty (ColorText, Pretty)
import Unison.Util.Pretty qualified as Pretty

handleDebugSynhashTerm :: Name -> Cli ()
handleDebugSynhashTerm :: Name -> Cli ()
handleDebugSynhashTerm Name
name = do
  Branch0 IO
namespace <- Cli (Branch0 IO)
Cli.getCurrentBranch0
  let names :: Names
names = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
namespace
  let pped :: PrettyPrintEnvDecl
pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
names) (Names -> Suffixifier
PPE.suffixifyByHash Names
names)

  Set TermReference -> (TermReference -> Cli ()) -> Cli ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Names -> Name -> Set TermReference
Names.refTermsNamed Names
names Name
name) \TermReference
ref -> do
    Maybe [Token]
maybeTokens <-
      case TermReference
ref of
        Reference.Builtin Text
builtin -> Maybe [Token] -> Cli (Maybe [Token])
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Token] -> Maybe [Token]
forall a. a -> Maybe a
Just (Text -> [Token]
hashBuiltinTermTokens Text
builtin))
        Reference.DerivedId Id' Hash
refId -> do
          Env
env <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
          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 Env
env.codebase Id' Hash
refId) Cli (Maybe (Term Symbol Ann))
-> (Maybe (Term Symbol Ann) -> Maybe [Token])
-> Cli (Maybe [Token])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
            Maybe (Term Symbol Ann)
Nothing -> Maybe [Token]
forall a. Maybe a
Nothing
            Just Term Symbol Ann
term -> [Token] -> Maybe [Token]
forall a. a -> Maybe a
Just (PrettyPrintEnv -> Term Symbol Ann -> [Token]
forall a v. Var v => PrettyPrintEnv -> Term v a -> [Token]
hashDerivedTermTokens PrettyPrintEnvDecl
pped.unsuffixifiedPPE Term Symbol Ann
term)
    Maybe [Token] -> ([Token] -> Cli ()) -> Cli ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe [Token]
maybeTokens \[Token]
tokens -> do
      let filename :: Text
filename = Name -> Text
Name.toText Name
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TermReference -> Text
Reference.toText TermReference
ref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-synhash-tokens.txt"
      let renderedTokens :: Text
renderedTokens =
            [Token]
tokens
              [Token] -> ([Token] -> [Pretty ColorText]) -> [Pretty ColorText]
forall a b. a -> (a -> b) -> b
& (Token -> Pretty ColorText) -> [Token] -> [Pretty ColorText]
forall a b. (a -> b) -> [a] -> [b]
map Token -> Pretty ColorText
prettyToken
              [Pretty ColorText]
-> ([Pretty ColorText] -> Pretty ColorText) -> Pretty ColorText
forall a b. a -> (a -> b) -> b
& [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pretty.lines
              Pretty ColorText -> (Pretty ColorText -> String) -> String
forall a b. a -> (a -> b) -> b
& Pretty ColorText -> String
Pretty.toAnsiUnbroken
              String -> (String -> Text) -> Text
forall a b. a -> (a -> b) -> b
& String -> Text
Text.pack
      IO () -> Cli ()
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> Text -> IO ()
Text.writeFile (Text -> String
Text.unpack Text
filename) Text
renderedTokens)
      Output -> Cli ()
Cli.respond (TermReference -> Hash -> Text -> Output
Output'DebugSynhashTerm TermReference
ref ([Token] -> Hash
forall h. Accumulate h => [Token h] -> h
Hashable.accumulate [Token]
tokens) Text
filename)

prettyToken :: Hashable.Token Hash -> Pretty ColorText
prettyToken :: Token -> Pretty ColorText
prettyToken = \case
  Hashable.Bytes ByteString
bytes -> Pretty ColorText
"0x" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Base32Hex -> Pretty ColorText
forall s. IsString s => Base32Hex -> Pretty s
prettyBase32Hex (ByteString -> Base32Hex
Base32Hex.fromByteString ByteString
bytes)
  Hashable.Double Double
n -> String -> Pretty ColorText
forall s. IsString s => String -> Pretty s
Pretty.string (Double -> String
forall a. Show a => a -> String
show Double
n)
  Hashable.Hashed Hash
h -> Hash -> Pretty ColorText
forall s. IsString s => Hash -> Pretty s
prettyHash Hash
h
  Hashable.Int Int64
n -> (if Int64
n Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
0 then Pretty ColorText
"+" else Pretty ColorText
forall a. Monoid a => a
mempty) Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> String -> Pretty ColorText
forall s. IsString s => String -> Pretty s
Pretty.string (Int64 -> String
forall a. Show a => a -> String
show Int64
n)
  Hashable.Nat Word64
n -> String -> Pretty ColorText
forall s. IsString s => String -> Pretty s
Pretty.string (Word64 -> String
forall a. Show a => a -> String
show Word64
n)
  Hashable.Tag Word8
n -> Pretty ColorText
"@" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> String -> Pretty ColorText
forall s. IsString s => String -> Pretty s
Pretty.string (Word8 -> String
forall a. Show a => a -> String
show Word8
n)
  Hashable.Text Text
s -> String -> Pretty ColorText
forall s. IsString s => String -> Pretty s
Pretty.string (Text -> String
forall a. Show a => a -> String
show Text
s)