Render.hs

module Tricorder.CLI.Render
    ( -- * Plain-text formatting
      diagnosticLine
    , diagnosticLineIndexed
    , diagnosticBlock
    , formatDuration
    , renderSourceResults
    ) where

import Atelier.Effects.Console (Console)
import Atelier.Time (Millisecond, toMicroseconds)

import Atelier.Effects.Console qualified as Console
import Data.Text qualified as T

import Tricorder.BuildState
    ( Diagnostic (..)
    , Severity (..)
    )
import Tricorder.GhcPkg.Types (ModuleName (..), PackageId (..))
import Tricorder.SourceLookup (ModuleSourceResult (..), ReExport (..), SourceQuery (..))


formatDuration :: Millisecond -> Text
formatDuration d =
    let ms = toMicroseconds d `div` 1000
    in  if ms < 1000 then
            show ms <> "ms"
        else
            show (ms `div` 1000) <> "." <> show ((ms `mod` 1000) `div` 100) <> "s"


-- | Single-line diagnostic for plain-text / shell output.
--
-- Format: @E src\/Foo\/Bar.hs:42 \`something\` not in scope@
diagnosticLine :: Diagnostic -> Text
diagnosticLine d =
    prefix d.severity <> " " <> toText d.file <> ":" <> show d.line <> " " <> d.title
  where
    prefix SError = "E"
    prefix SWarning = "W"


-- | Like 'diagnosticLine' but prefixed with a 1-based index.
--
-- Format: @[N] E src\/Foo\/Bar.hs:42 \`something\` not in scope@
diagnosticLineIndexed :: Int -> Diagnostic -> Text
diagnosticLineIndexed n d = "[" <> show n <> "] " <> diagnosticLine d


-- | One-liner followed by the full GHC message body (verbose mode).
diagnosticBlock :: Diagnostic -> Text
diagnosticBlock d = diagnosticLine d <> "\n" <> d.text


renderSourceResults :: (Console :> es) => [ModuleSourceResult] -> Eff es ()
renderSourceResults results = mapM_ renderOne results
  where
    renderOne (SourceFound query src reExports) = do
        when (length results > 1) $ Console.putTextLn $ header query
        Console.putText src
        unless (null reExports || isJust query.function)
            $ Console.putTextLn
            $ "\n-- Re-exports: " <> T.intercalate ", " (map renderReExport reExports)
        when (length results > 1) $ Console.putStrLn ""
    renderOne (SourceNotFound query) =
        Console.putTextLn
            $ "Not found: "
                <> unModuleName query.moduleName
                <> " (module not in any installed package)"
    renderOne (SourceNoHaddock query pkgId) =
        Console.putTextLn
            $ "No source available: "
                <> unModuleName query.moduleName
                <> " (package "
                <> unPackageId pkgId
                <> " was built without documentation; try `cabal get "
                <> unPackageId pkgId
                <> "`)"
    renderOne (FunctionNotFound query) =
        Console.putTextLn
            $ "tricorder: "
                <> unModuleName query.moduleName
                <> "#"
                <> fromMaybe "" query.function
                <> ": function not found in module source"

    header query =
        "-- "
            <> unModuleName query.moduleName
            <> maybe "" ("#" <>) query.function

    renderReExport (ReExportModule m) = "module " <> m
    renderReExport (ReExportName name src) = name <> " (from " <> src <> ")"