{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ApplicativeDo #-}
module HieDb.Run where

import Prelude hiding (mod)

import GHC
import Compat.HieTypes
import Compat.HieUtils

import qualified Data.Map as M

import qualified Data.Text.IO as T


import System.Environment
import System.Directory
import System.IO
import System.IO.Unsafe (unsafeInterleaveIO)
import System.Exit
import System.Time.Extra

import System.Console.ANSI
import System.Console.Terminal.Size

import Control.Monad
import Control.Monad.IO.Class

import Data.Maybe
import Data.Either
import Data.Foldable
import Data.IORef
import Data.List.Extra

import Numeric.Natural

import qualified Data.ByteString.Char8 as BS

import Options.Applicative

import HieDb
import HieDb.Compat
import HieDb.Dump
import Text.Printf (printf)

hiedbMain :: LibDir -> IO ()
hiedbMain :: LibDir -> IO ()
hiedbMain LibDir
libdir = do
  [Char]
defaultLoc <- XdgDirectory -> [Char] -> IO [Char]
getXdgDirectory XdgDirectory
XdgData ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"default_"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
dB_VERSION [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
".hiedb"
  [Char]
defdb <- [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
defaultLoc (Maybe [Char] -> [Char]) -> IO (Maybe [Char]) -> IO [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"HIEDB"
  Bool
colr <- Handle -> IO Bool
hSupportsANSIColor Handle
stdout
  Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
NoBuffering
  Handle -> BufferMode -> IO ()
hSetBuffering Handle
stderr BufferMode
NoBuffering
  (Options
opts, Command
cmd) <- ParserInfo (Options, Command) -> IO (Options, Command)
forall a. ParserInfo a -> IO a
execParser (ParserInfo (Options, Command) -> IO (Options, Command))
-> ParserInfo (Options, Command) -> IO (Options, Command)
forall a b. (a -> b) -> a -> b
$ [Char] -> Bool -> ParserInfo (Options, Command)
progParseInfo [Char]
defdb Bool
colr
  LibDir -> Options -> Command -> IO ()
runCommand LibDir
libdir Options
opts Command
cmd


{- USAGE
Some default db location overridden by environment var HIEDB
hiedb init <foo.hiedb>
hiedb index [<dir>...] [hiedb]
hiedb name-refs <name> <module> [unitid] [hiedb]
hiedb type-refs <name> <module> [unitid] [hiedb]
hiedb query-pos <file.hie> <row> <col> [hiedb]
hiedb query-pos --hiedir=<dir> <file.hs> <row> <col> [hiedb]
hiedb cat <module> [unitid]
-}

data Options
  = Options
  { Options -> [Char]
database :: FilePath
  , Options -> Bool
trace :: Bool
  , Options -> Bool
quiet :: Bool
  , Options -> Bool
colour :: Bool
  , Options -> Maybe Natural
context :: Maybe Natural
  , Options -> Bool
reindex :: Bool
  , Options -> Bool
keepMissing :: Bool
  , Options -> Maybe [Char]
srcBaseDir :: Maybe FilePath
  , Options -> SkipOptions
skipIndexingOptions :: SkipOptions
  }

data Command
  = Init
  | Index [FilePath]
  | NameRefs String (Maybe ModuleName) (Maybe Unit)
  | TypeRefs String (Maybe ModuleName) (Maybe Unit)
  | NameDef  String (Maybe ModuleName) (Maybe Unit)
  | TypeDef  String (Maybe ModuleName) (Maybe Unit)
  | Cat HieTarget
  | Ls
  | LsExports (Maybe ModuleName)
  | Rm [HieTarget]
  | ModuleUIDs ModuleName
  | LookupHieFile ModuleName (Maybe Unit)
  | RefsAtPoint  HieTarget (Int,Int) (Maybe (Int,Int))
  | TypesAtPoint HieTarget (Int,Int) (Maybe (Int,Int))
  | DefsAtPoint  HieTarget (Int,Int) (Maybe (Int,Int))
  | InfoAtPoint  HieTarget (Int,Int) (Maybe (Int,Int))
  | RefGraph
  | Dump FilePath
  | Reachable [Symbol]
  | Unreachable [Symbol]
  | Html [Symbol]
  | GCTypeNames

progParseInfo :: FilePath -> Bool -> ParserInfo (Options, Command)
progParseInfo :: [Char] -> Bool -> ParserInfo (Options, Command)
progParseInfo [Char]
db Bool
colr = Parser (Options, Command)
-> InfoMod (Options, Command) -> ParserInfo (Options, Command)
forall a. Parser a -> InfoMod a -> ParserInfo a
info ([Char] -> Bool -> Parser (Options, Command)
progParser [Char]
db Bool
colr Parser (Options, Command)
-> Parser ((Options, Command) -> (Options, Command))
-> Parser (Options, Command)
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser ((Options, Command) -> (Options, Command))
forall a. Parser (a -> a)
helper)
  ( InfoMod (Options, Command)
forall a. InfoMod a
fullDesc
  InfoMod (Options, Command)
-> InfoMod (Options, Command) -> InfoMod (Options, Command)
forall a. Semigroup a => a -> a -> a
<> [Char] -> InfoMod (Options, Command)
forall a. [Char] -> InfoMod a
progDesc [Char]
"Query .hie files"
  InfoMod (Options, Command)
-> InfoMod (Options, Command) -> InfoMod (Options, Command)
forall a. Semigroup a => a -> a -> a
<> [Char] -> InfoMod (Options, Command)
forall a. [Char] -> InfoMod a
header [Char]
"hiedb - a tool to query groups of .hie files" )

progParser :: FilePath -> Bool -> Parser (Options,Command)
progParser :: [Char] -> Bool -> Parser (Options, Command)
progParser [Char]
db Bool
colr = (,) (Options -> Command -> (Options, Command))
-> Parser Options -> Parser (Command -> (Options, Command))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Bool -> Parser Options
optParser [Char]
db Bool
colr Parser (Command -> (Options, Command))
-> Parser Command -> Parser (Options, Command)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Command
cmdParser

optParser :: FilePath -> Bool -> Parser Options
optParser :: [Char] -> Bool -> Parser Options
optParser [Char]
defdb Bool
colr
    = [Char]
-> Bool
-> Bool
-> Bool
-> Maybe Natural
-> Bool
-> Bool
-> Maybe [Char]
-> SkipOptions
-> Options
Options
  ([Char]
 -> Bool
 -> Bool
 -> Bool
 -> Maybe Natural
 -> Bool
 -> Bool
 -> Maybe [Char]
 -> SkipOptions
 -> Options)
-> Parser [Char]
-> Parser
     (Bool
      -> Bool
      -> Bool
      -> Maybe Natural
      -> Bool
      -> Bool
      -> Maybe [Char]
      -> SkipOptions
      -> Options)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields [Char] -> Parser [Char]
forall s. IsString s => Mod OptionFields s -> Parser s
strOption ([Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"database" Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'D' Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"DATABASE"
              Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value [Char]
defdb Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields [Char]
forall a (f :: * -> *). Show a => Mod f a
showDefault Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"References Database")
  Parser
  (Bool
   -> Bool
   -> Bool
   -> Maybe Natural
   -> Bool
   -> Bool
   -> Maybe [Char]
   -> SkipOptions
   -> Options)
-> Parser Bool
-> Parser
     (Bool
      -> Bool
      -> Maybe Natural
      -> Bool
      -> Bool
      -> Maybe [Char]
      -> SkipOptions
      -> Options)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch ([Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"trace" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'v' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Print SQL queries being executed")
  Parser
  (Bool
   -> Bool
   -> Maybe Natural
   -> Bool
   -> Bool
   -> Maybe [Char]
   -> SkipOptions
   -> Options)
-> Parser Bool
-> Parser
     (Bool
      -> Maybe Natural
      -> Bool
      -> Bool
      -> Maybe [Char]
      -> SkipOptions
      -> Options)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch ([Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"quiet" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'q' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Don't print progress messages")
  Parser
  (Bool
   -> Maybe Natural
   -> Bool
   -> Bool
   -> Maybe [Char]
   -> SkipOptions
   -> Options)
-> Parser Bool
-> Parser
     (Maybe Natural
      -> Bool -> Bool -> Maybe [Char] -> SkipOptions -> Options)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
colourFlag
  Parser
  (Maybe Natural
   -> Bool -> Bool -> Maybe [Char] -> SkipOptions -> Options)
-> Parser (Maybe Natural)
-> Parser (Bool -> Bool -> Maybe [Char] -> SkipOptions -> Options)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Natural -> Parser (Maybe Natural)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ReadM Natural -> Mod OptionFields Natural -> Parser Natural
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Natural
forall a. Read a => ReadM a
auto ([Char] -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"context" Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'C' Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Natural
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Number of lines of context for source spans - show no context by default"))
  Parser (Bool -> Bool -> Maybe [Char] -> SkipOptions -> Options)
-> Parser Bool
-> Parser (Bool -> Maybe [Char] -> SkipOptions -> Options)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch ([Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"reindex" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'r' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Re-index all files in database before running command, deleting those with missing '.hie' files")
  Parser (Bool -> Maybe [Char] -> SkipOptions -> Options)
-> Parser Bool -> Parser (Maybe [Char] -> SkipOptions -> Options)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch ([Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"keep-missing" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Keep missing files when re-indexing")
  Parser (Maybe [Char] -> SkipOptions -> Options)
-> Parser (Maybe [Char]) -> Parser (SkipOptions -> Options)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Char] -> Parser (Maybe [Char])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields [Char] -> Parser [Char]
forall s. IsString s => Mod OptionFields s -> Parser s
strOption ([Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"src-base-dir" Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Provide a base directory to index src files as real files"))
  Parser (SkipOptions -> Options)
-> Parser SkipOptions -> Parser Options
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SkipOptions
skipFlags
  where
    colourFlag :: Parser Bool
colourFlag = Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> Mod FlagFields a -> Parser a
flag' Bool
True ([Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"colour" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"color" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Force coloured output")
            Parser Bool -> Parser Bool -> Parser Bool
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> Mod FlagFields a -> Parser a
flag' Bool
False ([Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"no-colour" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"no-color" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Force uncoloured ouput")
            Parser Bool -> Parser Bool -> Parser Bool
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser Bool
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
colr
    skipFlags :: Parser SkipOptions
skipFlags = do
        Bool
refs <- Mod FlagFields Bool -> Parser Bool
switch ([Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"skip-refs" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Skip refs table when indexing")
        Bool
decls <- Mod FlagFields Bool -> Parser Bool
switch ([Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"skip-decls" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Skip decls table when indexing")
        Bool
defs <- Mod FlagFields Bool -> Parser Bool
switch ([Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"skip-defs" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Skip defs table when indexing")
        Bool
exports <- Mod FlagFields Bool -> Parser Bool
switch ([Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"skip-exports" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Skip exports table when indexing")
        Bool
imports <- Mod FlagFields Bool -> Parser Bool
switch ([Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"skip-imports" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Skip imports table when indexing")
        Bool
types <- Mod FlagFields Bool -> Parser Bool
switch ([Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"skip-types" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Skip types and typerefs table when indexing")
        Bool
typeRefs <- Mod FlagFields Bool -> Parser Bool
switch ([Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"skip-typerefs" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Skip typerefs table when indexing")
        pure $ SkipOptions
          { skipRefs :: Bool
skipRefs = Bool
refs
          , skipDecls :: Bool
skipDecls = Bool
decls
          , skipDefs :: Bool
skipDefs = Bool
defs
          , skipExports :: Bool
skipExports = Bool
exports
          , skipImports :: Bool
skipImports = Bool
imports
          , skipTypes :: Bool
skipTypes = Bool
types
          , skipTypeRefs :: Bool
skipTypeRefs = Bool
typeRefs
          }

cmdParser :: Parser Command
cmdParser :: Parser Command
cmdParser
   = Mod CommandFields Command -> Parser Command
forall a. Mod CommandFields a -> Parser a
hsubparser
   (Mod CommandFields Command -> Parser Command)
-> Mod CommandFields Command -> Parser Command
forall a b. (a -> b) -> a -> b
$ [Char] -> ParserInfo Command -> Mod CommandFields Command
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"init" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Command -> Parser Command
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
Init) (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ [Char] -> InfoMod Command
forall a. [Char] -> InfoMod a
progDesc [Char]
"Initialize database")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> [Char] -> ParserInfo Command -> Mod CommandFields Command
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"index" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info ([[Char]] -> Command
Index ([[Char]] -> Command) -> Parser [[Char]] -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [Char] -> Parser [[Char]]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod ArgumentFields [Char] -> Parser [Char]
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument ([Char] -> Mod ArgumentFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"DIRECTORY..."))) (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ [Char] -> InfoMod Command
forall a. [Char] -> InfoMod a
progDesc [Char]
"Index files from directory")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> [Char] -> ParserInfo Command -> Mod CommandFields Command
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"name-refs" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info ([Char] -> Maybe ModuleName -> Maybe Unit -> Command
NameRefs ([Char] -> Maybe ModuleName -> Maybe Unit -> Command)
-> Parser [Char]
-> Parser (Maybe ModuleName -> Maybe Unit -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields [Char] -> Parser [Char]
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument ([Char] -> Mod ArgumentFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"NAME")
                                         Parser (Maybe ModuleName -> Maybe Unit -> Command)
-> Parser (Maybe ModuleName) -> Parser (Maybe Unit -> Command)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ModuleName -> Parser (Maybe ModuleName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ([Char] -> ModuleName
mkModuleName ([Char] -> ModuleName) -> Parser [Char] -> Parser ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields [Char] -> Parser [Char]
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument ([Char] -> Mod ArgumentFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"MODULE"))
                                         Parser (Maybe Unit -> Command)
-> Parser (Maybe Unit) -> Parser Command
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Unit)
maybeUnitId)
                         (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ [Char] -> InfoMod Command
forall a. [Char] -> InfoMod a
progDesc [Char]
"Lookup references of value MODULE.NAME")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> [Char] -> ParserInfo Command -> Mod CommandFields Command
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"type-refs" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info ([Char] -> Maybe ModuleName -> Maybe Unit -> Command
TypeRefs ([Char] -> Maybe ModuleName -> Maybe Unit -> Command)
-> Parser [Char]
-> Parser (Maybe ModuleName -> Maybe Unit -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields [Char] -> Parser [Char]
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument ([Char] -> Mod ArgumentFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"NAME")
                                         Parser (Maybe ModuleName -> Maybe Unit -> Command)
-> Parser (Maybe ModuleName) -> Parser (Maybe Unit -> Command)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ModuleName -> Parser (Maybe ModuleName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ModuleName
moduleNameParser
                                         Parser (Maybe Unit -> Command)
-> Parser (Maybe Unit) -> Parser Command
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Unit)
maybeUnitId)
                         (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ [Char] -> InfoMod Command
forall a. [Char] -> InfoMod a
progDesc [Char]
"Lookup references of type MODULE.NAME")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> [Char] -> ParserInfo Command -> Mod CommandFields Command
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"name-def" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info ([Char] -> Maybe ModuleName -> Maybe Unit -> Command
NameDef ([Char] -> Maybe ModuleName -> Maybe Unit -> Command)
-> Parser [Char]
-> Parser (Maybe ModuleName -> Maybe Unit -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields [Char] -> Parser [Char]
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument ([Char] -> Mod ArgumentFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"NAME")
                                       Parser (Maybe ModuleName -> Maybe Unit -> Command)
-> Parser (Maybe ModuleName) -> Parser (Maybe Unit -> Command)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ModuleName -> Parser (Maybe ModuleName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ModuleName
moduleNameParser
                                       Parser (Maybe Unit -> Command)
-> Parser (Maybe Unit) -> Parser Command
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Unit)
maybeUnitId)
                         (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ [Char] -> InfoMod Command
forall a. [Char] -> InfoMod a
progDesc [Char]
"Lookup definition of value MODULE.NAME")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> [Char] -> ParserInfo Command -> Mod CommandFields Command
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"type-def" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info ([Char] -> Maybe ModuleName -> Maybe Unit -> Command
TypeDef ([Char] -> Maybe ModuleName -> Maybe Unit -> Command)
-> Parser [Char]
-> Parser (Maybe ModuleName -> Maybe Unit -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields [Char] -> Parser [Char]
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument ([Char] -> Mod ArgumentFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"NAME")
                                       Parser (Maybe ModuleName -> Maybe Unit -> Command)
-> Parser (Maybe ModuleName) -> Parser (Maybe Unit -> Command)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ModuleName -> Parser (Maybe ModuleName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ModuleName
moduleNameParser
                                       Parser (Maybe Unit -> Command)
-> Parser (Maybe Unit) -> Parser Command
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Unit)
maybeUnitId)
                         (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ [Char] -> InfoMod Command
forall a. [Char] -> InfoMod a
progDesc [Char]
"Lookup definition of type MODULE.NAME")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> [Char] -> ParserInfo Command -> Mod CommandFields Command
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"cat" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (HieTarget -> Command
Cat (HieTarget -> Command) -> Parser HieTarget -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser HieTarget
hieTarget)
                         (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ [Char] -> InfoMod Command
forall a. [Char] -> InfoMod a
progDesc [Char]
"Dump contents of MODULE as stored in the hiefile")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> [Char] -> ParserInfo Command -> Mod CommandFields Command
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"ls" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Command -> Parser Command
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
Ls)
                         (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ [Char] -> InfoMod Command
forall a. [Char] -> InfoMod a
progDesc [Char]
"List all indexed files/modules")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> [Char] -> ParserInfo Command -> Mod CommandFields Command
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"ls-exports" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Maybe ModuleName -> Command
LsExports (Maybe ModuleName -> Command)
-> Parser (Maybe ModuleName) -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ModuleName -> Parser (Maybe ModuleName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ModuleName
moduleNameParser)
                         (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ [Char] -> InfoMod Command
forall a. [Char] -> InfoMod a
progDesc [Char]
"List all exports")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> [Char] -> ParserInfo Command -> Mod CommandFields Command
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"rm" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info ([HieTarget] -> Command
Rm ([HieTarget] -> Command) -> Parser [HieTarget] -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser HieTarget -> Parser [HieTarget]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser HieTarget
hieTarget)
                         (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ [Char] -> InfoMod Command
forall a. [Char] -> InfoMod a
progDesc [Char]
"Remove targets from index")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> [Char] -> ParserInfo Command -> Mod CommandFields Command
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"module-uids" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (ModuleName -> Command
ModuleUIDs (ModuleName -> Command) -> Parser ModuleName -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ModuleName
moduleNameParser)
                         (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ [Char] -> InfoMod Command
forall a. [Char] -> InfoMod a
progDesc [Char]
"List all the UnitIds MODULE is indexed under in the db")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> [Char] -> ParserInfo Command -> Mod CommandFields Command
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"lookup-hie" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (ModuleName -> Maybe Unit -> Command
LookupHieFile (ModuleName -> Maybe Unit -> Command)
-> Parser ModuleName -> Parser (Maybe Unit -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ModuleName
moduleNameParser Parser (Maybe Unit -> Command)
-> Parser (Maybe Unit) -> Parser Command
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Unit)
maybeUnitId)
                         (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ [Char] -> InfoMod Command
forall a. [Char] -> InfoMod a
progDesc [Char]
"Lookup the location of the .hie file corresponding to MODULE")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> [Char] -> ParserInfo Command -> Mod CommandFields Command
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"point-refs"
        (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (HieTarget -> (Int, Int) -> Maybe (Int, Int) -> Command
RefsAtPoint (HieTarget -> (Int, Int) -> Maybe (Int, Int) -> Command)
-> Parser HieTarget
-> Parser ((Int, Int) -> Maybe (Int, Int) -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser HieTarget
hieTarget
                           Parser ((Int, Int) -> Maybe (Int, Int) -> Command)
-> Parser (Int, Int) -> Parser (Maybe (Int, Int) -> Command)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Char -> Parser (Int, Int)
posParser Char
'S'
                           Parser (Maybe (Int, Int) -> Command)
-> Parser (Maybe (Int, Int)) -> Parser Command
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Int, Int) -> Parser (Maybe (Int, Int))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser (Int, Int)
posParser Char
'E'))
              (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ [Char] -> InfoMod Command
forall a. [Char] -> InfoMod a
progDesc [Char]
"Find references for symbol at point/span")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> [Char] -> ParserInfo Command -> Mod CommandFields Command
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"point-types"
        (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (HieTarget -> (Int, Int) -> Maybe (Int, Int) -> Command
TypesAtPoint (HieTarget -> (Int, Int) -> Maybe (Int, Int) -> Command)
-> Parser HieTarget
-> Parser ((Int, Int) -> Maybe (Int, Int) -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser HieTarget
hieTarget
                            Parser ((Int, Int) -> Maybe (Int, Int) -> Command)
-> Parser (Int, Int) -> Parser (Maybe (Int, Int) -> Command)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Char -> Parser (Int, Int)
posParser Char
'S'
                            Parser (Maybe (Int, Int) -> Command)
-> Parser (Maybe (Int, Int)) -> Parser Command
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Int, Int) -> Parser (Maybe (Int, Int))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser (Int, Int)
posParser Char
'E'))
              (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ [Char] -> InfoMod Command
forall a. [Char] -> InfoMod a
progDesc [Char]
"List types of ast at point/span")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> [Char] -> ParserInfo Command -> Mod CommandFields Command
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"point-defs"
        (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (HieTarget -> (Int, Int) -> Maybe (Int, Int) -> Command
DefsAtPoint (HieTarget -> (Int, Int) -> Maybe (Int, Int) -> Command)
-> Parser HieTarget
-> Parser ((Int, Int) -> Maybe (Int, Int) -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser HieTarget
hieTarget
                            Parser ((Int, Int) -> Maybe (Int, Int) -> Command)
-> Parser (Int, Int) -> Parser (Maybe (Int, Int) -> Command)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Char -> Parser (Int, Int)
posParser Char
'S'
                            Parser (Maybe (Int, Int) -> Command)
-> Parser (Maybe (Int, Int)) -> Parser Command
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Int, Int) -> Parser (Maybe (Int, Int))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser (Int, Int)
posParser Char
'E'))
              (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ [Char] -> InfoMod Command
forall a. [Char] -> InfoMod a
progDesc [Char]
"Find definition for symbol at point/span")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> [Char] -> ParserInfo Command -> Mod CommandFields Command
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"point-info"
        (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (HieTarget -> (Int, Int) -> Maybe (Int, Int) -> Command
InfoAtPoint (HieTarget -> (Int, Int) -> Maybe (Int, Int) -> Command)
-> Parser HieTarget
-> Parser ((Int, Int) -> Maybe (Int, Int) -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser HieTarget
hieTarget
                            Parser ((Int, Int) -> Maybe (Int, Int) -> Command)
-> Parser (Int, Int) -> Parser (Maybe (Int, Int) -> Command)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Char -> Parser (Int, Int)
posParser Char
'S'
                            Parser (Maybe (Int, Int) -> Command)
-> Parser (Maybe (Int, Int)) -> Parser Command
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Int, Int) -> Parser (Maybe (Int, Int))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser (Int, Int)
posParser Char
'E'))
              (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ [Char] -> InfoMod Command
forall a. [Char] -> InfoMod a
progDesc [Char]
"Print name, module name, unit id for symbol at point/span")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> [Char] -> ParserInfo Command -> Mod CommandFields Command
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"ref-graph" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Command -> Parser Command
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
RefGraph) (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ [Char] -> InfoMod Command
forall a. [Char] -> InfoMod a
progDesc [Char]
"Generate a reachability graph")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> [Char] -> ParserInfo Command -> Mod CommandFields Command
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"dump" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info ([Char] -> Command
Dump ([Char] -> Command) -> Parser [Char] -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields [Char] -> Parser [Char]
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument ([Char] -> Mod ArgumentFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"HIE")) (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ [Char] -> InfoMod Command
forall a. [Char] -> InfoMod a
progDesc [Char]
"Dump a HIE AST")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> [Char] -> ParserInfo Command -> Mod CommandFields Command
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"reachable" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info ([Symbol] -> Command
Reachable ([Symbol] -> Command) -> Parser [Symbol] -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Symbol -> Parser [Symbol]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Symbol
symbolParser)
                         (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ [Char] -> InfoMod Command
forall a. [Char] -> InfoMod a
progDesc [Char]
"Find all symbols reachable from the given symbols")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> [Char] -> ParserInfo Command -> Mod CommandFields Command
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"unreachable" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info ([Symbol] -> Command
Unreachable ([Symbol] -> Command) -> Parser [Symbol] -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Symbol -> Parser [Symbol]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Symbol
symbolParser)
                           (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ [Char] -> InfoMod Command
forall a. [Char] -> InfoMod a
progDesc [Char]
"Find all symbols unreachable from the given symbols")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> [Char] -> ParserInfo Command -> Mod CommandFields Command
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"html" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info ([Symbol] -> Command
Html ([Symbol] -> Command) -> Parser [Symbol] -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Symbol -> Parser [Symbol]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Symbol
symbolParser)
                    (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ [Char] -> InfoMod Command
forall a. [Char] -> InfoMod a
progDesc [Char]
"generate html files for reachability from the given symbols")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> [Char] -> ParserInfo Command -> Mod CommandFields Command
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"gc" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Command -> Parser Command
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
GCTypeNames) InfoMod Command
forall a. Monoid a => a
mempty)

posParser :: Char -> Parser (Int,Int)
posParser :: Char -> Parser (Int, Int)
posParser Char
c = (,) (Int -> Int -> (Int, Int))
-> Parser Int -> Parser (Int -> (Int, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Int -> Mod ArgumentFields Int -> Parser Int
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM Int
forall a. Read a => ReadM a
auto ([Char] -> Mod ArgumentFields Int
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar ([Char] -> Mod ArgumentFields Int)
-> [Char] -> Mod ArgumentFields Int
forall a b. (a -> b) -> a -> b
$ Char
cChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
"LINE") Parser (Int -> (Int, Int)) -> Parser Int -> Parser (Int, Int)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Int -> Mod ArgumentFields Int -> Parser Int
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM Int
forall a. Read a => ReadM a
auto ([Char] -> Mod ArgumentFields Int
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar ([Char] -> Mod ArgumentFields Int)
-> [Char] -> Mod ArgumentFields Int
forall a b. (a -> b) -> a -> b
$ Char
cChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
"COL")

maybeUnitId :: Parser (Maybe Unit)
maybeUnitId :: Parser (Maybe Unit)
maybeUnitId =
  Parser Unit -> Parser (Maybe Unit)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ([Char] -> Unit
stringToUnit ([Char] -> Unit) -> Parser [Char] -> Parser Unit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields [Char] -> Parser [Char]
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Char -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'u' Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"unit-id" Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"UNITID"))

symbolParser :: Parser Symbol
symbolParser :: Parser Symbol
symbolParser = ReadM Symbol -> Mod ArgumentFields Symbol -> Parser Symbol
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM Symbol
forall a. Read a => ReadM a
auto (Mod ArgumentFields Symbol -> Parser Symbol)
-> Mod ArgumentFields Symbol -> Parser Symbol
forall a b. (a -> b) -> a -> b
$ [Char] -> Mod ArgumentFields Symbol
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"SYMBOL"

moduleNameParser :: Parser ModuleName
moduleNameParser :: Parser ModuleName
moduleNameParser = [Char] -> ModuleName
mkModuleName ([Char] -> ModuleName) -> Parser [Char] -> Parser ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields [Char] -> Parser [Char]
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument ([Char] -> Mod ArgumentFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"MODULE")

hieTarget :: Parser HieTarget
hieTarget :: Parser HieTarget
hieTarget =
      ([Char] -> HieTarget
forall a b. a -> Either a b
Left ([Char] -> HieTarget) -> Parser [Char] -> Parser HieTarget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields [Char] -> Parser [Char]
forall s. IsString s => Mod OptionFields s -> Parser s
strOption ([Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"hiefile" Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'f' Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"HIEFILE"))
  Parser HieTarget -> Parser HieTarget -> Parser HieTarget
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((ModuleName, Maybe Unit) -> HieTarget
forall a b. b -> Either a b
Right ((ModuleName, Maybe Unit) -> HieTarget)
-> Parser (ModuleName, Maybe Unit) -> Parser HieTarget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) (ModuleName -> Maybe Unit -> (ModuleName, Maybe Unit))
-> Parser ModuleName
-> Parser (Maybe Unit -> (ModuleName, Maybe Unit))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ModuleName
moduleNameParser  Parser (Maybe Unit -> (ModuleName, Maybe Unit))
-> Parser (Maybe Unit) -> Parser (ModuleName, Maybe Unit)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Unit)
maybeUnitId))

progress :: Handle -> Int -> Int -> (FilePath -> DbMonad Bool) -> FilePath -> DbMonad Bool
progress :: Handle
-> Int -> Int -> ([Char] -> DbMonad Bool) -> [Char] -> DbMonad Bool
progress Handle
hndl Int
total Int
cur [Char] -> DbMonad Bool
act [Char]
f = do
  Maybe Int
mw <- IO (Maybe Int) -> DbMonadT IO (Maybe Int)
forall a. IO a -> DbMonadT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Int) -> DbMonadT IO (Maybe Int))
-> IO (Maybe Int) -> DbMonadT IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ (Window Int -> Int) -> Maybe (Window Int) -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Window Int -> Int
forall a. Window a -> a
width (Maybe (Window Int) -> Maybe Int)
-> IO (Maybe (Window Int)) -> IO (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe (Window Int))
forall n. Integral n => IO (Maybe (Window n))
size
  let msg' :: [Char]
msg' = [[Char]] -> [Char]
unwords [[Char]
"Processing file", Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
cur Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
total [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":", [Char]
f] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"..."
  [Char]
msg <- IO [Char] -> DbMonadT IO [Char]
forall a. IO a -> DbMonadT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> DbMonadT IO [Char])
-> IO [Char] -> DbMonadT IO [Char]
forall a b. (a -> b) -> a -> b
$ case Maybe Int
mw of
    Maybe Int
Nothing -> Handle -> [Char] -> IO ()
hPutStrLn Handle
hndl [Char]
"" IO () -> IO [Char] -> IO [Char]
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> IO [Char]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
msg'
    Just Int
w -> do
      Handle -> [Char] -> IO ()
hPutStr Handle
hndl ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
w Char
' '
      Handle -> [Char] -> IO ()
hPutStr Handle
hndl [Char]
"\r"
      pure $ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
8) [Char]
msg'
  IO () -> DbMonadT IO ()
forall a. IO a -> DbMonadT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DbMonadT IO ()) -> IO () -> DbMonadT IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStr Handle
hndl [Char]
msg
  Bool
x <- [Char] -> DbMonad Bool
act [Char]
f
  if Bool
x
  then IO () -> DbMonadT IO ()
forall a. IO a -> DbMonadT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DbMonadT IO ()) -> IO () -> DbMonadT IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStr Handle
hndl [Char]
" done\r"
  else IO () -> DbMonadT IO ()
forall a. IO a -> DbMonadT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DbMonadT IO ()) -> IO () -> DbMonadT IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStr Handle
hndl [Char]
" skipped\r"
  return Bool
x

doIndex :: HieDb -> Options -> Handle -> [FilePath] -> IO ()
doIndex :: HieDb -> Options -> Handle -> [[Char]] -> IO ()
doIndex HieDb
_ Options
opts Handle
_ [] | Options -> Bool
reindex Options
opts = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
doIndex HieDb
conn Options
opts Handle
h [[Char]]
files = do
  IORef NameCache
nc <- NameCache -> IO (IORef NameCache)
forall a. a -> IO (IORef a)
newIORef (NameCache -> IO (IORef NameCache))
-> IO NameCache -> IO (IORef NameCache)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO NameCache
makeNc
  let progress' :: Handle
-> Int -> Int -> ([Char] -> DbMonad Bool) -> [Char] -> DbMonad Bool
progress' = if Options -> Bool
quiet Options
opts then (\Handle
_ Int
_ Int
_ [Char] -> DbMonad Bool
k -> [Char] -> DbMonad Bool
k) else Handle
-> Int -> Int -> ([Char] -> DbMonad Bool) -> [Char] -> DbMonad Bool
progress

  IO Seconds
istart <- IO (IO Seconds)
offsetTime
  ([Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length -> Int
done, [Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length -> Int
skipped)<- IORef NameCache -> DbMonad ([Bool], [Bool]) -> IO ([Bool], [Bool])
forall a. IORef NameCache -> DbMonad a -> IO a
runDbM IORef NameCache
nc (DbMonad ([Bool], [Bool]) -> IO ([Bool], [Bool]))
-> DbMonad ([Bool], [Bool]) -> IO ([Bool], [Bool])
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> [Bool] -> ([Bool], [Bool])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Bool -> Bool
forall a. a -> a
id ([Bool] -> ([Bool], [Bool]))
-> DbMonadT IO [Bool] -> DbMonad ([Bool], [Bool])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ([Char] -> Int -> DbMonad Bool)
-> [[Char]] -> [Int] -> DbMonadT IO [Bool]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\[Char]
f Int
n -> Handle
-> Int -> Int -> ([Char] -> DbMonad Bool) -> [Char] -> DbMonad Bool
progress' Handle
h ([[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
files) Int
n (HieDb -> Maybe [Char] -> SkipOptions -> [Char] -> DbMonad Bool
forall (m :: * -> *).
(MonadIO m, NameCacheMonad m) =>
HieDb -> Maybe [Char] -> SkipOptions -> [Char] -> m Bool
addRefsFrom HieDb
conn (Options -> Maybe [Char]
srcBaseDir Options
opts) (Options -> SkipOptions
skipIndexingOptions Options
opts)) [Char]
f) [[Char]]
files [Int
0..]
  Seconds
indexTime <- IO Seconds
istart

  IO Seconds
start <- IO (IO Seconds)
offsetTime
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
done Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO Int -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$ HieDb -> IO Int
garbageCollectTypeNames HieDb
conn
  Seconds
gcTime <- IO Seconds
start

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Options -> Bool
quiet Options
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Handle -> [Char] -> IO ()
hPutStrLn Handle
h ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"\nCompleted! (" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
done [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" indexed, " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
skipped [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" skipped in " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Seconds -> [Char]
showDuration Seconds
indexTime [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" + " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Seconds -> [Char]
showDuration Seconds
gcTime [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" gc)"

runCommand :: LibDir -> Options -> Command -> IO ()
runCommand :: LibDir -> Options -> Command -> IO ()
runCommand LibDir
libdir Options
opts Command
cmd = LibDir -> [Char] -> (DynFlags -> HieDb -> IO ()) -> IO ()
forall a. LibDir -> [Char] -> (DynFlags -> HieDb -> IO a) -> IO a
withHieDbAndFlags LibDir
libdir (Options -> [Char]
database Options
opts) ((DynFlags -> HieDb -> IO ()) -> IO ())
-> (DynFlags -> HieDb -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \DynFlags
dynFlags HieDb
conn -> do
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
trace Options
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    HieDb -> Maybe (Text -> IO ()) -> IO ()
setHieTrace HieDb
conn ((Text -> IO ()) -> Maybe (Text -> IO ())
forall a. a -> Maybe a
Just ((Text -> IO ()) -> Maybe (Text -> IO ()))
-> (Text -> IO ()) -> Maybe (Text -> IO ())
forall a b. (a -> b) -> a -> b
$ Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr (Text -> IO ()) -> (Text -> Text) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"\n****TRACE: "Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>))
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
reindex Options
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    HieDb -> IO ()
initConn HieDb
conn
    [[Char]]
files' <- (HieModuleRow -> [Char]) -> [HieModuleRow] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map HieModuleRow -> [Char]
hieModuleHieFile ([HieModuleRow] -> [[Char]]) -> IO [HieModuleRow] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HieDb -> IO [HieModuleRow]
getAllIndexedMods HieDb
conn
    [[Char]]
files <- ([Maybe [Char]] -> [[Char]]) -> IO [Maybe [Char]] -> IO [[Char]]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe [Char]] -> [[Char]]
forall a. [Maybe a] -> [a]
catMaybes (IO [Maybe [Char]] -> IO [[Char]])
-> IO [Maybe [Char]] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> ([Char] -> IO (Maybe [Char])) -> IO [Maybe [Char]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [[Char]]
files' (([Char] -> IO (Maybe [Char])) -> IO [Maybe [Char]])
-> ([Char] -> IO (Maybe [Char])) -> IO [Maybe [Char]]
forall a b. (a -> b) -> a -> b
$ \[Char]
f -> do
      Bool
exists <- [Char] -> IO Bool
doesFileExist [Char]
f
      if Bool
exists
      then Maybe [Char] -> IO (Maybe [Char])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Char] -> IO (Maybe [Char]))
-> Maybe [Char] -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
f
      else do
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Options -> Bool
keepMissing Options
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          HieDb -> [Char] -> IO ()
deleteFileFromIndex HieDb
conn [Char]
f
        pure Maybe [Char]
forall a. Maybe a
Nothing
    let n :: Int
n = [[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
files
        orig :: Int
orig = [[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
files'
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Options -> Bool
quiet Options
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Re-indexing " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" files, deleting " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
orig) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" files"
    HieDb -> Options -> Handle -> [[Char]] -> IO ()
doIndex HieDb
conn Options
opts Handle
stderr [[Char]]
files
  case Command
cmd of
    Command
Init -> HieDb -> IO ()
initConn HieDb
conn
    Index [[Char]]
dirs -> do
      HieDb -> IO ()
initConn HieDb
conn
      [[Char]]
files <- [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[[Char]]] -> [[Char]]) -> IO [[[Char]]] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> IO [[Char]]) -> [[Char]] -> IO [[[Char]]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Char] -> IO [[Char]]
getHieFilesIn [[Char]]
dirs
      HieDb -> Options -> Handle -> [[Char]] -> IO ()
doIndex HieDb
conn Options
opts Handle
stderr [[Char]]
files
    TypeRefs [Char]
typ Maybe ModuleName
mn Maybe Unit
muid -> do
      let occ :: OccName
occ = NameSpace -> [Char] -> OccName
mkOccName NameSpace
tcClsName [Char]
typ
      [Res RefRow]
refs <- HieDb
-> Bool
-> OccName
-> Maybe ModuleName
-> Maybe Unit
-> [[Char]]
-> IO [Res RefRow]
findReferences HieDb
conn Bool
False OccName
occ Maybe ModuleName
mn Maybe Unit
muid []
      Options -> [Res RefRow] -> IO ()
reportRefs Options
opts [Res RefRow]
refs
    NameRefs [Char]
nm Maybe ModuleName
mn Maybe Unit
muid -> do
      let ns :: NameSpace
ns = if [Char] -> Bool
isCons [Char]
nm then NameSpace
dataName else NameSpace
varName
      let occ :: OccName
occ = NameSpace -> [Char] -> OccName
mkOccName NameSpace
ns [Char]
nm
      [Res RefRow]
refs <- HieDb
-> Bool
-> OccName
-> Maybe ModuleName
-> Maybe Unit
-> [[Char]]
-> IO [Res RefRow]
findReferences HieDb
conn Bool
False OccName
occ Maybe ModuleName
mn Maybe Unit
muid []
      Options -> [Res RefRow] -> IO ()
reportRefs Options
opts [Res RefRow]
refs
    NameDef [Char]
nm Maybe ModuleName
mn Maybe Unit
muid -> do
      let ns :: NameSpace
ns = if [Char] -> Bool
isCons [Char]
nm then NameSpace
dataName else NameSpace
varName
      let occ :: OccName
occ = NameSpace -> [Char] -> OccName
mkOccName NameSpace
ns [Char]
nm
      (DefRow
row:.ModuleInfo
inf) <- Options
-> Either HieDbErr (DefRow :. ModuleInfo)
-> IO (DefRow :. ModuleInfo)
forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts (Either HieDbErr (DefRow :. ModuleInfo)
 -> IO (DefRow :. ModuleInfo))
-> IO (Either HieDbErr (DefRow :. ModuleInfo))
-> IO (DefRow :. ModuleInfo)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HieDb
-> OccName
-> Maybe ModuleName
-> Maybe Unit
-> IO (Either HieDbErr (DefRow :. ModuleInfo))
findOneDef HieDb
conn OccName
occ Maybe ModuleName
mn Maybe Unit
muid
      let mdl :: Module
mdl = Unit -> ModuleName -> Module
forall u. u -> ModuleName -> GenModule u
mkModule (ModuleInfo -> Unit
modInfoUnit ModuleInfo
inf) (ModuleInfo -> ModuleName
modInfoName ModuleInfo
inf)
      Options
-> [(Module, (Int, Int), (Int, Int),
     Maybe (Either [Char] ByteString))]
-> IO ()
reportRefSpans Options
opts [(Module
mdl, (DefRow -> Int
defSLine DefRow
row, DefRow -> Int
defSCol DefRow
row), (DefRow -> Int
defELine DefRow
row, DefRow -> Int
defECol DefRow
row),Either [Char] ByteString -> Maybe (Either [Char] ByteString)
forall a. a -> Maybe a
Just (Either [Char] ByteString -> Maybe (Either [Char] ByteString))
-> Either [Char] ByteString -> Maybe (Either [Char] ByteString)
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] ByteString
forall a b. a -> Either a b
Left (DefRow -> [Char]
defSrc DefRow
row))]
    TypeDef [Char]
nm Maybe ModuleName
mn Maybe Unit
muid -> do
      let occ :: OccName
occ = NameSpace -> [Char] -> OccName
mkOccName NameSpace
tcClsName [Char]
nm
      (DefRow
row:.ModuleInfo
inf) <- Options
-> Either HieDbErr (DefRow :. ModuleInfo)
-> IO (DefRow :. ModuleInfo)
forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts (Either HieDbErr (DefRow :. ModuleInfo)
 -> IO (DefRow :. ModuleInfo))
-> IO (Either HieDbErr (DefRow :. ModuleInfo))
-> IO (DefRow :. ModuleInfo)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HieDb
-> OccName
-> Maybe ModuleName
-> Maybe Unit
-> IO (Either HieDbErr (DefRow :. ModuleInfo))
findOneDef HieDb
conn OccName
occ Maybe ModuleName
mn Maybe Unit
muid
      let mdl :: Module
mdl = Unit -> ModuleName -> Module
forall u. u -> ModuleName -> GenModule u
mkModule (ModuleInfo -> Unit
modInfoUnit ModuleInfo
inf) (ModuleInfo -> ModuleName
modInfoName ModuleInfo
inf)
      Options
-> [(Module, (Int, Int), (Int, Int),
     Maybe (Either [Char] ByteString))]
-> IO ()
reportRefSpans Options
opts [(Module
mdl, (DefRow -> Int
defSLine DefRow
row, DefRow -> Int
defSCol DefRow
row), (DefRow -> Int
defELine DefRow
row, DefRow -> Int
defECol DefRow
row),Either [Char] ByteString -> Maybe (Either [Char] ByteString)
forall a. a -> Maybe a
Just (Either [Char] ByteString -> Maybe (Either [Char] ByteString))
-> Either [Char] ByteString -> Maybe (Either [Char] ByteString)
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] ByteString
forall a b. a -> Either a b
Left (DefRow -> [Char]
defSrc DefRow
row))]
    Cat HieTarget
target -> HieDb -> Options -> HieTarget -> (HieFile -> IO ()) -> IO ()
forall a.
HieDb -> Options -> HieTarget -> (HieFile -> IO a) -> IO a
hieFileCommand HieDb
conn Options
opts HieTarget
target (ByteString -> IO ()
BS.putStrLn (ByteString -> IO ())
-> (HieFile -> ByteString) -> HieFile -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieFile -> ByteString
hie_hs_src)
    Command
Ls -> do
      [HieModuleRow]
mods <- HieDb -> IO [HieModuleRow]
getAllIndexedMods HieDb
conn
      [HieModuleRow] -> (HieModuleRow -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [HieModuleRow]
mods ((HieModuleRow -> IO ()) -> IO ())
-> (HieModuleRow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HieModuleRow
mod -> do
        [Char] -> IO ()
putStr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ HieModuleRow -> [Char]
hieModuleHieFile HieModuleRow
mod
        [Char] -> IO ()
putStr [Char]
"\t"
        [Char] -> IO ()
putStr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ ModuleName -> [Char]
moduleNameString (ModuleName -> [Char]) -> ModuleName -> [Char]
forall a b. (a -> b) -> a -> b
$ ModuleInfo -> ModuleName
modInfoName (ModuleInfo -> ModuleName) -> ModuleInfo -> ModuleName
forall a b. (a -> b) -> a -> b
$ HieModuleRow -> ModuleInfo
hieModInfo HieModuleRow
mod
        [Char] -> IO ()
putStr [Char]
"\t"
        [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Unit -> [Char]
forall u. IsUnitId u => u -> [Char]
unitString (Unit -> [Char]) -> Unit -> [Char]
forall a b. (a -> b) -> a -> b
$ ModuleInfo -> Unit
modInfoUnit (ModuleInfo -> Unit) -> ModuleInfo -> Unit
forall a b. (a -> b) -> a -> b
$ HieModuleRow -> ModuleInfo
hieModInfo HieModuleRow
mod
    LsExports Maybe ModuleName
mn -> do
      [ExportRow]
exports <- IO [ExportRow]
-> (ModuleName -> IO [ExportRow])
-> Maybe ModuleName
-> IO [ExportRow]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (HieDb -> IO [ExportRow]
getAllIndexedExports HieDb
conn) (HieDb -> ModuleName -> IO [ExportRow]
getExportsForModule HieDb
conn) Maybe ModuleName
mn
      [ExportRow] -> (ExportRow -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ExportRow]
exports ((ExportRow -> IO ()) -> IO ()) -> (ExportRow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ExportRow{Bool
[Char]
Maybe ModuleName
Maybe OccName
Maybe Unit
ModuleName
OccName
Unit
exportHieFile :: [Char]
exportName :: OccName
exportMod :: ModuleName
exportUnit :: Unit
exportParent :: Maybe OccName
exportParentMod :: Maybe ModuleName
exportParentUnit :: Maybe Unit
exportIsDatacon :: Bool
exportHieFile :: ExportRow -> [Char]
exportName :: ExportRow -> OccName
exportMod :: ExportRow -> ModuleName
exportUnit :: ExportRow -> Unit
exportParent :: ExportRow -> Maybe OccName
exportParentMod :: ExportRow -> Maybe ModuleName
exportParentUnit :: ExportRow -> Maybe Unit
exportIsDatacon :: ExportRow -> Bool
..} -> do
        [Char] -> IO ()
putStr [Char]
exportHieFile
        [Char] -> IO ()
putStr [Char]
"\t"
        case Maybe OccName
exportParent of
          Maybe OccName
Nothing -> [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ OccName -> [Char]
occNameString OccName
exportName
          Just OccName
p -> [Char] -> [Char] -> [Char] -> IO ()
forall r. PrintfType r => [Char] -> r
printf [Char]
"%s(%s)\n" (OccName -> [Char]
occNameString OccName
p) (OccName -> [Char]
occNameString OccName
exportName)
    Rm [HieTarget]
targets -> do
        [HieTarget] -> (HieTarget -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [HieTarget]
targets ((HieTarget -> IO ()) -> IO ()) -> (HieTarget -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HieTarget
target -> do
          case HieTarget
target of
            Left [Char]
f -> do
              Bool
dir <- [Char] -> IO Bool
doesDirectoryExist [Char]
f
              if Bool
dir
              then do
                [[Char]]
fs <- [Char] -> IO [[Char]]
getHieFilesIn [Char]
f
                ([Char] -> IO ()) -> [[Char]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (HieDb -> [Char] -> IO ()
deleteFileFromIndex HieDb
conn) [[Char]]
fs
              else do
                [Char]
cf <- [Char] -> IO [Char]
canonicalizePath [Char]
f
                HieDb -> [Char] -> IO ()
deleteFileFromIndex HieDb
conn [Char]
cf
            Right (ModuleName
mn,Maybe Unit
muid) -> do
              Unit
uid <- Options -> Either HieDbErr Unit -> IO Unit
forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts (Either HieDbErr Unit -> IO Unit)
-> IO (Either HieDbErr Unit) -> IO Unit
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Either HieDbErr Unit)
-> (Unit -> IO (Either HieDbErr Unit))
-> Maybe Unit
-> IO (Either HieDbErr Unit)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (HieDb -> ModuleName -> IO (Either HieDbErr Unit)
resolveUnitId HieDb
conn ModuleName
mn) (Either HieDbErr Unit -> IO (Either HieDbErr Unit)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either HieDbErr Unit -> IO (Either HieDbErr Unit))
-> (Unit -> Either HieDbErr Unit)
-> Unit
-> IO (Either HieDbErr Unit)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unit -> Either HieDbErr Unit
forall a b. b -> Either a b
Right) Maybe Unit
muid
              Maybe HieModuleRow
mFile <- HieDb -> ModuleName -> Unit -> IO (Maybe HieModuleRow)
lookupHieFile HieDb
conn ModuleName
mn Unit
uid
              case Maybe HieModuleRow
mFile of
                Maybe HieModuleRow
Nothing -> Options -> Either HieDbErr () -> IO ()
forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts (Either HieDbErr () -> IO ()) -> Either HieDbErr () -> IO ()
forall a b. (a -> b) -> a -> b
$ HieDbErr -> Either HieDbErr ()
forall a b. a -> Either a b
Left (ModuleName -> Maybe Unit -> HieDbErr
NotIndexed ModuleName
mn (Maybe Unit -> HieDbErr) -> Maybe Unit -> HieDbErr
forall a b. (a -> b) -> a -> b
$ Unit -> Maybe Unit
forall a. a -> Maybe a
Just Unit
uid)
                Just HieModuleRow
x -> HieDb -> [Char] -> IO ()
deleteFileFromIndex HieDb
conn (HieModuleRow -> [Char]
hieModuleHieFile HieModuleRow
x)
    ModuleUIDs ModuleName
mn ->
      Unit -> IO ()
forall a. Show a => a -> IO ()
print (Unit -> IO ()) -> IO Unit -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Options -> Either HieDbErr Unit -> IO Unit
forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts (Either HieDbErr Unit -> IO Unit)
-> IO (Either HieDbErr Unit) -> IO Unit
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HieDb -> ModuleName -> IO (Either HieDbErr Unit)
resolveUnitId HieDb
conn ModuleName
mn
    LookupHieFile ModuleName
mn Maybe Unit
muid -> Options -> Either HieDbErr () -> IO ()
forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts (Either HieDbErr () -> IO ()) -> IO (Either HieDbErr ()) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
      Either HieDbErr Unit
euid <- IO (Either HieDbErr Unit)
-> (Unit -> IO (Either HieDbErr Unit))
-> Maybe Unit
-> IO (Either HieDbErr Unit)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (HieDb -> ModuleName -> IO (Either HieDbErr Unit)
resolveUnitId HieDb
conn ModuleName
mn) (Either HieDbErr Unit -> IO (Either HieDbErr Unit)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either HieDbErr Unit -> IO (Either HieDbErr Unit))
-> (Unit -> Either HieDbErr Unit)
-> Unit
-> IO (Either HieDbErr Unit)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unit -> Either HieDbErr Unit
forall a b. b -> Either a b
Right) Maybe Unit
muid
      case Either HieDbErr Unit
euid of
        Left HieDbErr
err -> Either HieDbErr () -> IO (Either HieDbErr ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either HieDbErr () -> IO (Either HieDbErr ()))
-> Either HieDbErr () -> IO (Either HieDbErr ())
forall a b. (a -> b) -> a -> b
$ HieDbErr -> Either HieDbErr ()
forall a b. a -> Either a b
Left HieDbErr
err
        Right Unit
uid -> do
          Maybe HieModuleRow
mFile <- HieDb -> ModuleName -> Unit -> IO (Maybe HieModuleRow)
lookupHieFile HieDb
conn ModuleName
mn Unit
uid
          case Maybe HieModuleRow
mFile of
            Maybe HieModuleRow
Nothing -> Either HieDbErr () -> IO (Either HieDbErr ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either HieDbErr () -> IO (Either HieDbErr ()))
-> Either HieDbErr () -> IO (Either HieDbErr ())
forall a b. (a -> b) -> a -> b
$ HieDbErr -> Either HieDbErr ()
forall a b. a -> Either a b
Left (ModuleName -> Maybe Unit -> HieDbErr
NotIndexed ModuleName
mn (Maybe Unit -> HieDbErr) -> Maybe Unit -> HieDbErr
forall a b. (a -> b) -> a -> b
$ Unit -> Maybe Unit
forall a. a -> Maybe a
Just Unit
uid)
            Just HieModuleRow
x -> () -> Either HieDbErr ()
forall a b. b -> Either a b
Right (() -> Either HieDbErr ()) -> IO () -> IO (Either HieDbErr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO ()
putStrLn (HieModuleRow -> [Char]
hieModuleHieFile HieModuleRow
x)
    RefsAtPoint HieTarget
target (Int, Int)
sp Maybe (Int, Int)
mep -> HieDb -> Options -> HieTarget -> (HieFile -> IO ()) -> IO ()
forall a.
HieDb -> Options -> HieTarget -> (HieFile -> IO a) -> IO a
hieFileCommand HieDb
conn Options
opts HieTarget
target ((HieFile -> IO ()) -> IO ()) -> (HieFile -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HieFile
hf -> do
      let names :: [Name]
names = [[Name]] -> [Name]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Name]] -> [Name]) -> [[Name]] -> [Name]
forall a b. (a -> b) -> a -> b
$ HieFile
-> (Int, Int)
-> Maybe (Int, Int)
-> (HieAST Int -> [Name])
-> [[Name]]
forall a.
HieFile
-> (Int, Int) -> Maybe (Int, Int) -> (HieAST Int -> a) -> [a]
pointCommand HieFile
hf (Int, Int)
sp Maybe (Int, Int)
mep ((HieAST Int -> [Name]) -> [[Name]])
-> (HieAST Int -> [Name]) -> [[Name]]
forall a b. (a -> b) -> a -> b
$ [Either ModuleName Name] -> [Name]
forall a b. [Either a b] -> [b]
rights ([Either ModuleName Name] -> [Name])
-> (HieAST Int -> [Either ModuleName Name]) -> HieAST Int -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (Either ModuleName Name) (IdentifierDetails Int)
-> [Either ModuleName Name]
forall k a. Map k a -> [k]
M.keys (Map (Either ModuleName Name) (IdentifierDetails Int)
 -> [Either ModuleName Name])
-> (HieAST Int
    -> Map (Either ModuleName Name) (IdentifierDetails Int))
-> HieAST Int
-> [Either ModuleName Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInfo Int
-> Map (Either ModuleName Name) (IdentifierDetails Int)
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers (NodeInfo Int
 -> Map (Either ModuleName Name) (IdentifierDetails Int))
-> (HieAST Int -> NodeInfo Int)
-> HieAST Int
-> Map (Either ModuleName Name) (IdentifierDetails Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST Int -> NodeInfo Int
nodeInfo'
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
names) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Options -> Either HieDbErr () -> IO ()
forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts (HieDbErr -> Either HieDbErr ()
forall a b. a -> Either a b
Left (HieDbErr -> Either HieDbErr ()) -> HieDbErr -> Either HieDbErr ()
forall a b. (a -> b) -> a -> b
$ HieTarget -> (Int, Int) -> HieDbErr
NoNameAtPoint HieTarget
target (Int, Int)
sp)
      [Name] -> (Name -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Name]
names ((Name -> IO ()) -> IO ()) -> (Name -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Name
name -> do
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Options -> Bool
quiet Options
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords [[Char]
"Name", Options -> OccName -> [Char]
ppName Options
opts (Name -> OccName
nameOccName Name
name),[Char]
"at",Options -> (Int, Int) -> [Char]
ppSpan Options
opts (Int, Int)
sp,[Char]
"is used at:"]
          Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
""
        case Name -> Maybe Module
nameModule_maybe Name
name of
          Just Module
mod -> do
            Options -> [Res RefRow] -> IO ()
reportRefs Options
opts ([Res RefRow] -> IO ()) -> IO [Res RefRow] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HieDb
-> Bool
-> OccName
-> Maybe ModuleName
-> Maybe Unit
-> [[Char]]
-> IO [Res RefRow]
findReferences HieDb
conn Bool
False (Name -> OccName
nameOccName Name
name) (ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just (ModuleName -> Maybe ModuleName) -> ModuleName -> Maybe ModuleName
forall a b. (a -> b) -> a -> b
$ Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod) (Unit -> Maybe Unit
forall a. a -> Maybe a
Just (Unit -> Maybe Unit) -> Unit -> Maybe Unit
forall a b. (a -> b) -> a -> b
$ Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
mod) []
          Maybe Module
Nothing -> do
            let refmap :: RefMap Int
refmap = Map HiePath (HieAST Int) -> RefMap Int
forall (f :: * -> *) a. Foldable f => f (HieAST a) -> RefMap a
generateReferencesMap (HieASTs Int -> Map HiePath (HieAST Int)
forall a. HieASTs a -> Map HiePath (HieAST a)
getAsts (HieASTs Int -> Map HiePath (HieAST Int))
-> HieASTs Int -> Map HiePath (HieAST Int)
forall a b. (a -> b) -> a -> b
$ HieFile -> HieASTs Int
hie_asts HieFile
hf)
                refs :: [(Module, (Int, Int), (Int, Int), Maybe (Either a ByteString))]
refs = ((RealSrcSpan, IdentifierDetails Int)
 -> (Module, (Int, Int), (Int, Int), Maybe (Either a ByteString)))
-> [(RealSrcSpan, IdentifierDetails Int)]
-> [(Module, (Int, Int), (Int, Int), Maybe (Either a ByteString))]
forall a b. (a -> b) -> [a] -> [b]
map (RealSrcSpan
-> (Module, (Int, Int), (Int, Int), Maybe (Either a ByteString))
forall {a}.
RealSrcSpan
-> (Module, (Int, Int), (Int, Int), Maybe (Either a ByteString))
toRef (RealSrcSpan
 -> (Module, (Int, Int), (Int, Int), Maybe (Either a ByteString)))
-> ((RealSrcSpan, IdentifierDetails Int) -> RealSrcSpan)
-> (RealSrcSpan, IdentifierDetails Int)
-> (Module, (Int, Int), (Int, Int), Maybe (Either a ByteString))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RealSrcSpan, IdentifierDetails Int) -> RealSrcSpan
forall a b. (a, b) -> a
fst) ([(RealSrcSpan, IdentifierDetails Int)]
 -> [(Module, (Int, Int), (Int, Int), Maybe (Either a ByteString))])
-> [(RealSrcSpan, IdentifierDetails Int)]
-> [(Module, (Int, Int), (Int, Int), Maybe (Either a ByteString))]
forall a b. (a -> b) -> a -> b
$ [(RealSrcSpan, IdentifierDetails Int)]
-> Either ModuleName Name
-> RefMap Int
-> [(RealSrcSpan, IdentifierDetails Int)]
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault [] (Name -> Either ModuleName Name
forall a b. b -> Either a b
Right Name
name) RefMap Int
refmap
                toRef :: RealSrcSpan
-> (Module, (Int, Int), (Int, Int), Maybe (Either a ByteString))
toRef RealSrcSpan
spn = (HieFile -> Module
hie_module HieFile
hf
                            ,(RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
spn , RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
spn)
                            ,(RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
spn , RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
spn)
                            ,Either a ByteString -> Maybe (Either a ByteString)
forall a. a -> Maybe a
Just (Either a ByteString -> Maybe (Either a ByteString))
-> Either a ByteString -> Maybe (Either a ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either a ByteString
forall a b. b -> Either a b
Right (HieFile -> ByteString
hie_hs_src HieFile
hf))
            Options
-> [(Module, (Int, Int), (Int, Int),
     Maybe (Either [Char] ByteString))]
-> IO ()
reportRefSpans Options
opts [(Module, (Int, Int), (Int, Int),
  Maybe (Either [Char] ByteString))]
forall {a}.
[(Module, (Int, Int), (Int, Int), Maybe (Either a ByteString))]
refs
    TypesAtPoint HieTarget
target (Int, Int)
sp Maybe (Int, Int)
mep -> HieDb -> Options -> HieTarget -> (HieFile -> IO ()) -> IO ()
forall a.
HieDb -> Options -> HieTarget -> (HieFile -> IO a) -> IO a
hieFileCommand HieDb
conn Options
opts HieTarget
target ((HieFile -> IO ()) -> IO ()) -> (HieFile -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HieFile
hf -> do
      let types' :: [Int]
types' = [[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Int]] -> [Int]) -> [[Int]] -> [Int]
forall a b. (a -> b) -> a -> b
$ HieFile
-> (Int, Int)
-> Maybe (Int, Int)
-> (HieAST Int -> [Int])
-> [[Int]]
forall a.
HieFile
-> (Int, Int) -> Maybe (Int, Int) -> (HieAST Int -> a) -> [a]
pointCommand HieFile
hf (Int, Int)
sp Maybe (Int, Int)
mep ((HieAST Int -> [Int]) -> [[Int]])
-> (HieAST Int -> [Int]) -> [[Int]]
forall a b. (a -> b) -> a -> b
$ NodeInfo Int -> [Int]
forall a. NodeInfo a -> [a]
nodeType (NodeInfo Int -> [Int])
-> (HieAST Int -> NodeInfo Int) -> HieAST Int -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST Int -> NodeInfo Int
nodeInfo'
          types :: [HieTypeFix]
types = (Int -> HieTypeFix) -> [Int] -> [HieTypeFix]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Array Int HieTypeFlat -> HieTypeFix)
-> Array Int HieTypeFlat -> Int -> HieTypeFix
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Array Int HieTypeFlat -> HieTypeFix
recoverFullType (Array Int HieTypeFlat -> Int -> HieTypeFix)
-> Array Int HieTypeFlat -> Int -> HieTypeFix
forall a b. (a -> b) -> a -> b
$ HieFile -> Array Int HieTypeFlat
hie_types HieFile
hf) [Int]
types'
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([HieTypeFix] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HieTypeFix]
types) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Options -> Either HieDbErr () -> IO ()
forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts (HieDbErr -> Either HieDbErr ()
forall a b. a -> Either a b
Left (HieDbErr -> Either HieDbErr ()) -> HieDbErr -> Either HieDbErr ()
forall a b. (a -> b) -> a -> b
$ HieTarget -> (Int, Int) -> HieDbErr
NoNameAtPoint HieTarget
target (Int, Int)
sp)
      [HieTypeFix] -> (HieTypeFix -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [HieTypeFix]
types ((HieTypeFix -> IO ()) -> IO ()) -> (HieTypeFix -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HieTypeFix
typ -> do
        [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> HieTypeFix -> [Char]
renderHieType DynFlags
dynFlags HieTypeFix
typ
    DefsAtPoint HieTarget
target (Int, Int)
sp Maybe (Int, Int)
mep -> HieDb -> Options -> HieTarget -> (HieFile -> IO ()) -> IO ()
forall a.
HieDb -> Options -> HieTarget -> (HieFile -> IO a) -> IO a
hieFileCommand HieDb
conn Options
opts HieTarget
target ((HieFile -> IO ()) -> IO ()) -> (HieFile -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HieFile
hf -> do
      let names :: [Name]
names = [[Name]] -> [Name]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Name]] -> [Name]) -> [[Name]] -> [Name]
forall a b. (a -> b) -> a -> b
$ HieFile
-> (Int, Int)
-> Maybe (Int, Int)
-> (HieAST Int -> [Name])
-> [[Name]]
forall a.
HieFile
-> (Int, Int) -> Maybe (Int, Int) -> (HieAST Int -> a) -> [a]
pointCommand HieFile
hf (Int, Int)
sp Maybe (Int, Int)
mep ((HieAST Int -> [Name]) -> [[Name]])
-> (HieAST Int -> [Name]) -> [[Name]]
forall a b. (a -> b) -> a -> b
$ [Either ModuleName Name] -> [Name]
forall a b. [Either a b] -> [b]
rights ([Either ModuleName Name] -> [Name])
-> (HieAST Int -> [Either ModuleName Name]) -> HieAST Int -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (Either ModuleName Name) (IdentifierDetails Int)
-> [Either ModuleName Name]
forall k a. Map k a -> [k]
M.keys (Map (Either ModuleName Name) (IdentifierDetails Int)
 -> [Either ModuleName Name])
-> (HieAST Int
    -> Map (Either ModuleName Name) (IdentifierDetails Int))
-> HieAST Int
-> [Either ModuleName Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInfo Int
-> Map (Either ModuleName Name) (IdentifierDetails Int)
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers (NodeInfo Int
 -> Map (Either ModuleName Name) (IdentifierDetails Int))
-> (HieAST Int -> NodeInfo Int)
-> HieAST Int
-> Map (Either ModuleName Name) (IdentifierDetails Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST Int -> NodeInfo Int
nodeInfo'
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
names) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Options -> Either HieDbErr () -> IO ()
forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts (HieDbErr -> Either HieDbErr ()
forall a b. a -> Either a b
Left (HieDbErr -> Either HieDbErr ()) -> HieDbErr -> Either HieDbErr ()
forall a b. (a -> b) -> a -> b
$ HieTarget -> (Int, Int) -> HieDbErr
NoNameAtPoint HieTarget
target (Int, Int)
sp)
      [Name] -> (Name -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Name]
names ((Name -> IO ()) -> IO ()) -> (Name -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Name
name -> do
        case Name -> SrcSpan
nameSrcSpan Name
name of
          RealSrcSpan RealSrcSpan
dsp Maybe BufSpan
_ -> do
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Options -> Bool
quiet Options
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
              Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords [[Char]
"Name", Options -> OccName -> [Char]
ppName Options
opts (Name -> OccName
nameOccName Name
name),[Char]
"at",Options -> (Int, Int) -> [Char]
ppSpan Options
opts (Int, Int)
sp,[Char]
"is defined at:"]
            Maybe (Either [Char] ByteString)
contents <- case Name -> Maybe Module
nameModule_maybe Name
name of
              Maybe Module
Nothing -> Maybe (Either [Char] ByteString)
-> IO (Maybe (Either [Char] ByteString))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Either [Char] ByteString)
 -> IO (Maybe (Either [Char] ByteString)))
-> Maybe (Either [Char] ByteString)
-> IO (Maybe (Either [Char] ByteString))
forall a b. (a -> b) -> a -> b
$ Either [Char] ByteString -> Maybe (Either [Char] ByteString)
forall a. a -> Maybe a
Just (Either [Char] ByteString -> Maybe (Either [Char] ByteString))
-> Either [Char] ByteString -> Maybe (Either [Char] ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either [Char] ByteString
forall a b. b -> Either a b
Right (ByteString -> Either [Char] ByteString)
-> ByteString -> Either [Char] ByteString
forall a b. (a -> b) -> a -> b
$ HieFile -> ByteString
hie_hs_src HieFile
hf
              Just Module
mod
                | Module
mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== HieFile -> Module
hie_module HieFile
hf -> Maybe (Either [Char] ByteString)
-> IO (Maybe (Either [Char] ByteString))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Either [Char] ByteString)
 -> IO (Maybe (Either [Char] ByteString)))
-> Maybe (Either [Char] ByteString)
-> IO (Maybe (Either [Char] ByteString))
forall a b. (a -> b) -> a -> b
$ Either [Char] ByteString -> Maybe (Either [Char] ByteString)
forall a. a -> Maybe a
Just (Either [Char] ByteString -> Maybe (Either [Char] ByteString))
-> Either [Char] ByteString -> Maybe (Either [Char] ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either [Char] ByteString
forall a b. b -> Either a b
Right (ByteString -> Either [Char] ByteString)
-> ByteString -> Either [Char] ByteString
forall a b. (a -> b) -> a -> b
$ HieFile -> ByteString
hie_hs_src HieFile
hf
                | Bool
otherwise -> IO (Maybe (Either [Char] ByteString))
-> IO (Maybe (Either [Char] ByteString))
forall a. IO a -> IO a
unsafeInterleaveIO (IO (Maybe (Either [Char] ByteString))
 -> IO (Maybe (Either [Char] ByteString)))
-> IO (Maybe (Either [Char] ByteString))
-> IO (Maybe (Either [Char] ByteString))
forall a b. (a -> b) -> a -> b
$ do
                    Either HieDbErr (DefRow :. ModuleInfo)
loc <- HieDb
-> OccName
-> Maybe ModuleName
-> Maybe Unit
-> IO (Either HieDbErr (DefRow :. ModuleInfo))
findOneDef HieDb
conn (Name -> OccName
nameOccName Name
name) (ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just (ModuleName -> Maybe ModuleName) -> ModuleName -> Maybe ModuleName
forall a b. (a -> b) -> a -> b
$ Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod) (Unit -> Maybe Unit
forall a. a -> Maybe a
Just (Unit -> Maybe Unit) -> Unit -> Maybe Unit
forall a b. (a -> b) -> a -> b
$ Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
mod)
                    pure $ case Either HieDbErr (DefRow :. ModuleInfo)
loc of
                      Left HieDbErr
_ -> Maybe (Either [Char] ByteString)
forall a. Maybe a
Nothing
                      Right (DefRow
row:.ModuleInfo
_) -> Either [Char] ByteString -> Maybe (Either [Char] ByteString)
forall a. a -> Maybe a
Just (Either [Char] ByteString -> Maybe (Either [Char] ByteString))
-> Either [Char] ByteString -> Maybe (Either [Char] ByteString)
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] ByteString
forall a b. a -> Either a b
Left ([Char] -> Either [Char] ByteString)
-> [Char] -> Either [Char] ByteString
forall a b. (a -> b) -> a -> b
$ DefRow -> [Char]
defSrc DefRow
row

            Options
-> [(Module, (Int, Int), (Int, Int),
     Maybe (Either [Char] ByteString))]
-> IO ()
reportRefSpans Options
opts
              [(Module -> Maybe Module -> Module
forall a. a -> Maybe a -> a
fromMaybe (HieFile -> Module
hie_module HieFile
hf) (Name -> Maybe Module
nameModule_maybe Name
name)
               ,(RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
dsp,RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
dsp)
               ,(RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
dsp, RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
dsp)
               ,Maybe (Either [Char] ByteString)
contents
               )]
          UnhelpfulSpan UnhelpfulSpanReason
msg -> do
            case Name -> Maybe Module
nameModule_maybe Name
name of
              Just Module
mod -> do
                (DefRow
row:.ModuleInfo
inf) <- Options
-> Either HieDbErr (DefRow :. ModuleInfo)
-> IO (DefRow :. ModuleInfo)
forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts
                    (Either HieDbErr (DefRow :. ModuleInfo)
 -> IO (DefRow :. ModuleInfo))
-> IO (Either HieDbErr (DefRow :. ModuleInfo))
-> IO (DefRow :. ModuleInfo)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HieDb
-> OccName
-> Maybe ModuleName
-> Maybe Unit
-> IO (Either HieDbErr (DefRow :. ModuleInfo))
findOneDef HieDb
conn (Name -> OccName
nameOccName Name
name) (ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just (ModuleName -> Maybe ModuleName) -> ModuleName -> Maybe ModuleName
forall a b. (a -> b) -> a -> b
$ Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod) (Unit -> Maybe Unit
forall a. a -> Maybe a
Just (Unit -> Maybe Unit) -> Unit -> Maybe Unit
forall a b. (a -> b) -> a -> b
$ Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
mod)
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Options -> Bool
quiet Options
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                  Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords [[Char]
"Name", Options -> OccName -> [Char]
ppName Options
opts (Name -> OccName
nameOccName Name
name),[Char]
"at",Options -> (Int, Int) -> [Char]
ppSpan Options
opts (Int, Int)
sp,[Char]
"is defined at:"]
                Options
-> [(Module, (Int, Int), (Int, Int),
     Maybe (Either [Char] ByteString))]
-> IO ()
reportRefSpans Options
opts
                  [(Unit -> ModuleName -> Module
forall u. u -> ModuleName -> GenModule u
mkModule (ModuleInfo -> Unit
modInfoUnit ModuleInfo
inf) (ModuleInfo -> ModuleName
modInfoName ModuleInfo
inf)
                   ,(DefRow -> Int
defSLine DefRow
row,DefRow -> Int
defSCol DefRow
row)
                   ,(DefRow -> Int
defELine DefRow
row,DefRow -> Int
defECol DefRow
row)
                   ,Either [Char] ByteString -> Maybe (Either [Char] ByteString)
forall a. a -> Maybe a
Just (Either [Char] ByteString -> Maybe (Either [Char] ByteString))
-> Either [Char] ByteString -> Maybe (Either [Char] ByteString)
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] ByteString
forall a b. a -> Either a b
Left ([Char] -> Either [Char] ByteString)
-> [Char] -> Either [Char] ByteString
forall a b. (a -> b) -> a -> b
$ DefRow -> [Char]
defSrc DefRow
row
                   )]
              Maybe Module
Nothing -> do
                Options -> Either HieDbErr () -> IO ()
forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts (Either HieDbErr () -> IO ()) -> Either HieDbErr () -> IO ()
forall a b. (a -> b) -> a -> b
$ HieDbErr -> Either HieDbErr ()
forall a b. a -> Either a b
Left (HieDbErr -> Either HieDbErr ()) -> HieDbErr -> Either HieDbErr ()
forall a b. (a -> b) -> a -> b
$ Name -> [Char] -> HieDbErr
NameUnhelpfulSpan Name
name (FastString -> [Char]
unpackFS (FastString -> [Char]) -> FastString -> [Char]
forall a b. (a -> b) -> a -> b
$ UnhelpfulSpanReason -> FastString
unhelpfulSpanFS UnhelpfulSpanReason
msg)
    InfoAtPoint HieTarget
target (Int, Int)
sp Maybe (Int, Int)
mep -> HieDb -> Options -> HieTarget -> (HieFile -> IO ()) -> IO ()
forall a.
HieDb -> Options -> HieTarget -> (HieFile -> IO a) -> IO a
hieFileCommand HieDb
conn Options
opts HieTarget
target ((HieFile -> IO ()) -> IO ()) -> (HieFile -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HieFile
hf -> do
      ((NodeInfo IfaceType, RealSrcSpan) -> IO ())
-> [(NodeInfo IfaceType, RealSrcSpan)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((NodeInfo IfaceType -> RealSrcSpan -> IO ())
-> (NodeInfo IfaceType, RealSrcSpan) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((NodeInfo IfaceType -> RealSrcSpan -> IO ())
 -> (NodeInfo IfaceType, RealSrcSpan) -> IO ())
-> (NodeInfo IfaceType -> RealSrcSpan -> IO ())
-> (NodeInfo IfaceType, RealSrcSpan)
-> IO ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> NodeInfo IfaceType -> RealSrcSpan -> IO ()
printInfo DynFlags
dynFlags) ([(NodeInfo IfaceType, RealSrcSpan)] -> IO ())
-> [(NodeInfo IfaceType, RealSrcSpan)] -> IO ()
forall a b. (a -> b) -> a -> b
$ HieFile
-> (Int, Int)
-> Maybe (Int, Int)
-> (HieAST Int -> (NodeInfo IfaceType, RealSrcSpan))
-> [(NodeInfo IfaceType, RealSrcSpan)]
forall a.
HieFile
-> (Int, Int) -> Maybe (Int, Int) -> (HieAST Int -> a) -> [a]
pointCommand HieFile
hf (Int, Int)
sp Maybe (Int, Int)
mep ((HieAST Int -> (NodeInfo IfaceType, RealSrcSpan))
 -> [(NodeInfo IfaceType, RealSrcSpan)])
-> (HieAST Int -> (NodeInfo IfaceType, RealSrcSpan))
-> [(NodeInfo IfaceType, RealSrcSpan)]
forall a b. (a -> b) -> a -> b
$ \HieAST Int
ast ->
        (HieTypeFix -> IfaceType
hieTypeToIface (HieTypeFix -> IfaceType)
-> (Int -> HieTypeFix) -> Int -> IfaceType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Array Int HieTypeFlat -> HieTypeFix)
-> Array Int HieTypeFlat -> Int -> HieTypeFix
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Array Int HieTypeFlat -> HieTypeFix
recoverFullType (HieFile -> Array Int HieTypeFlat
hie_types HieFile
hf) (Int -> IfaceType) -> NodeInfo Int -> NodeInfo IfaceType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HieAST Int -> NodeInfo Int
nodeInfo' HieAST Int
ast, HieAST Int -> RealSrcSpan
forall a. HieAST a -> RealSrcSpan
nodeSpan HieAST Int
ast)
    Command
RefGraph -> HieDb -> IO ()
declRefs HieDb
conn
    Dump [Char]
path -> do
      IORef NameCache
nc <- NameCache -> IO (IORef NameCache)
forall a. a -> IO (IORef a)
newIORef (NameCache -> IO (IORef NameCache))
-> IO NameCache -> IO (IORef NameCache)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO NameCache
makeNc
      IORef NameCache -> DbMonadT IO () -> IO ()
forall a. IORef NameCache -> DbMonad a -> IO a
runDbM IORef NameCache
nc (DbMonadT IO () -> IO ()) -> DbMonadT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> [Char] -> DbMonadT IO ()
forall (m :: * -> *).
(NameCacheMonad m, MonadIO m) =>
DynFlags -> [Char] -> m ()
dump DynFlags
dynFlags [Char]
path
    Reachable [Symbol]
s -> HieDb -> [Symbol] -> IO [Vertex]
getReachable HieDb
conn [Symbol]
s IO [Vertex] -> ([Vertex] -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Vertex -> IO ()) -> [Vertex] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Vertex -> IO ()
forall a. Show a => a -> IO ()
print
    Unreachable [Symbol]
s -> HieDb -> [Symbol] -> IO [Vertex]
getUnreachable HieDb
conn [Symbol]
s IO [Vertex] -> ([Vertex] -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Vertex -> IO ()) -> [Vertex] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Vertex -> IO ()
forall a. Show a => a -> IO ()
print
    Html [Symbol]
s -> do
      IORef NameCache
nc <- NameCache -> IO (IORef NameCache)
forall a. a -> IO (IORef a)
newIORef (NameCache -> IO (IORef NameCache))
-> IO NameCache -> IO (IORef NameCache)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO NameCache
makeNc
      IORef NameCache -> DbMonadT IO () -> IO ()
forall a. IORef NameCache -> DbMonad a -> IO a
runDbM IORef NameCache
nc (DbMonadT IO () -> IO ()) -> DbMonadT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ HieDb -> [Symbol] -> DbMonadT IO ()
forall (m :: * -> *).
(NameCacheMonad m, MonadIO m) =>
HieDb -> [Symbol] -> m ()
html HieDb
conn [Symbol]
s
    Command
GCTypeNames -> do
      IO Seconds
start <- IO (IO Seconds)
offsetTime
      Int
n <- HieDb -> IO Int
garbageCollectTypeNames HieDb
conn
      Seconds
end <- IO Seconds
start
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Options -> Bool
quiet Options
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"GCed " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" types in " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Seconds -> [Char]
showDuration Seconds
end

printInfo :: DynFlags -> NodeInfo IfaceType -> RealSrcSpan -> IO ()
printInfo :: DynFlags -> NodeInfo IfaceType -> RealSrcSpan -> IO ()
printInfo DynFlags
dynFlags NodeInfo IfaceType
x RealSrcSpan
sp = do
  [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Span: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ DynFlags -> SDoc -> [Char]
showSDoc DynFlags
dynFlags (RealSrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr RealSrcSpan
sp)
  [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Constructors: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ DynFlags -> SDoc -> [Char]
showSDoc DynFlags
dynFlags (Set NodeAnnotation -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Set NodeAnnotation -> SDoc) -> Set NodeAnnotation -> SDoc
forall a b. (a -> b) -> a -> b
$ NodeInfo IfaceType -> Set NodeAnnotation
forall a. NodeInfo a -> Set NodeAnnotation
nodeAnnotations NodeInfo IfaceType
x)
  [Char] -> IO ()
putStrLn [Char]
"Identifiers:"
  let idents :: [(Either ModuleName Name, IdentifierDetails IfaceType)]
idents = Map (Either ModuleName Name) (IdentifierDetails IfaceType)
-> [(Either ModuleName Name, IdentifierDetails IfaceType)]
forall k a. Map k a -> [(k, a)]
M.toList (Map (Either ModuleName Name) (IdentifierDetails IfaceType)
 -> [(Either ModuleName Name, IdentifierDetails IfaceType)])
-> Map (Either ModuleName Name) (IdentifierDetails IfaceType)
-> [(Either ModuleName Name, IdentifierDetails IfaceType)]
forall a b. (a -> b) -> a -> b
$ NodeInfo IfaceType
-> Map (Either ModuleName Name) (IdentifierDetails IfaceType)
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers NodeInfo IfaceType
x
  [(Either ModuleName Name, IdentifierDetails IfaceType)]
-> ((Either ModuleName Name, IdentifierDetails IfaceType) -> IO ())
-> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Either ModuleName Name, IdentifierDetails IfaceType)]
idents (((Either ModuleName Name, IdentifierDetails IfaceType) -> IO ())
 -> IO ())
-> ((Either ModuleName Name, IdentifierDetails IfaceType) -> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ \(Either ModuleName Name
ident,IdentifierDetails IfaceType
inf) -> do
    case Either ModuleName Name
ident of
      Left ModuleName
mdl -> [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Module: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ModuleName -> [Char]
moduleNameString ModuleName
mdl
      Right Name
nm -> do
        case Name -> Maybe Module
nameModule_maybe Name
nm of
          Maybe Module
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Just Module
m -> do
            [Char] -> IO ()
putStr [Char]
"Symbol:"
            Symbol -> IO ()
forall a. Show a => a -> IO ()
print (Symbol -> IO ()) -> Symbol -> IO ()
forall a b. (a -> b) -> a -> b
$ OccName -> Module -> Symbol
Symbol (Name -> OccName
nameOccName Name
nm) Module
m
        [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> SDoc -> [Char]
showSDoc DynFlags
dynFlags (SDoc -> [Char]) -> SDoc -> [Char]
forall a b. (a -> b) -> a -> b
$
          SDoc -> Int -> SDoc -> SDoc
hang (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
nm SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Char] -> SDoc
forall doc. IsLine doc => [Char] -> doc
text [Char]
"defined at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> SrcSpan
nameSrcSpan Name
nm)) Int
4 (IdentifierDetails IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IdentifierDetails IfaceType
inf)
  [Char] -> IO ()
putStrLn [Char]
"Types:"
  let types :: [IfaceType]
types = NodeInfo IfaceType -> [IfaceType]
forall a. NodeInfo a -> [a]
nodeType NodeInfo IfaceType
x
  [IfaceType] -> (IfaceType -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [IfaceType]
types ((IfaceType -> IO ()) -> IO ()) -> (IfaceType -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \IfaceType
typ -> do
    [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> SDoc -> [Char]
showSDoc DynFlags
dynFlags (IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
typ)
  [Char] -> IO ()
putStrLn [Char]
""

hieFileCommand :: HieDb -> Options -> HieTarget -> (HieFile -> IO a) -> IO a
hieFileCommand :: forall a.
HieDb -> Options -> HieTarget -> (HieFile -> IO a) -> IO a
hieFileCommand HieDb
conn Options
opts HieTarget
target HieFile -> IO a
f = IO (IO a) -> IO a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (IO a) -> IO a) -> IO (IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ Options -> Either HieDbErr (IO a) -> IO (IO a)
forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts (Either HieDbErr (IO a) -> IO (IO a))
-> IO (Either HieDbErr (IO a)) -> IO (IO a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HieDb
-> HieTarget -> (HieFile -> IO a) -> IO (Either HieDbErr (IO a))
forall a.
HieDb -> HieTarget -> (HieFile -> a) -> IO (Either HieDbErr a)
withTarget HieDb
conn HieTarget
target HieFile -> IO a
f

reportAmbiguousErr :: Options -> Either HieDbErr a -> IO a
reportAmbiguousErr :: forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
_ (Right a
x) = a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
reportAmbiguousErr Options
o (Left HieDbErr
e) = do
  Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Options -> HieDbErr -> [Char]
showHieDbErr Options
o HieDbErr
e
  IO a
forall a. IO a
exitFailure

showHieDbErr :: Options -> HieDbErr -> String
showHieDbErr :: Options -> HieDbErr -> [Char]
showHieDbErr Options
opts HieDbErr
e = case HieDbErr
e of
  NoNameAtPoint HieTarget
t (Int, Int)
spn -> [[Char]] -> [Char]
unwords [[Char]
"No symbols found at",Options -> (Int, Int) -> [Char]
ppSpan Options
opts (Int, Int)
spn,[Char]
"in",([Char] -> [Char])
-> ((ModuleName, Maybe Unit) -> [Char]) -> HieTarget -> [Char]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> [Char]
forall a. a -> a
id (\(ModuleName
mn,Maybe Unit
muid) -> Options -> ModuleName -> [Char]
ppMod Options
opts ModuleName
mn [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> (Unit -> [Char]) -> Maybe Unit -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" (\Unit
uid -> [Char]
"("[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Options -> Unit -> [Char]
ppUnit Options
opts Unit
uid[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
")") Maybe Unit
muid) HieTarget
t]
  NotIndexed ModuleName
mn Maybe Unit
muid -> [[Char]] -> [Char]
unwords [[Char]
"Module", Options -> ModuleName -> [Char]
ppMod Options
opts ModuleName
mn [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> (Unit -> [Char]) -> Maybe Unit -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" (\Unit
uid -> [Char]
"("[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Options -> Unit -> [Char]
ppUnit Options
opts Unit
uid[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
")") Maybe Unit
muid, [Char]
"not indexed."]
  AmbiguousUnitId NonEmpty ModuleInfo
xs -> [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"Unit could be any of:" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: (ModuleInfo -> [Char]) -> [ModuleInfo] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (([Char]
" - "[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<>) ([Char] -> [Char])
-> (ModuleInfo -> [Char]) -> ModuleInfo -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unit -> [Char]
forall u. IsUnitId u => u -> [Char]
unitString (Unit -> [Char]) -> (ModuleInfo -> Unit) -> ModuleInfo -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleInfo -> Unit
modInfoUnit) (NonEmpty ModuleInfo -> [ModuleInfo]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty ModuleInfo
xs)
    [[Char]] -> [[Char]] -> [[Char]]
forall a. Semigroup a => a -> a -> a
<> [[Char]
"Use --unit-id to disambiguate"]
  NameNotFound OccName
occ Maybe ModuleName
mn Maybe Unit
muid -> [[Char]] -> [Char]
unwords
    [[Char]
"Couldn't find name:", Options -> OccName -> [Char]
ppName Options
opts OccName
occ, [Char] -> (ModuleName -> [Char]) -> Maybe ModuleName -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" (([Char]
"from module " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([Char] -> [Char])
-> (ModuleName -> [Char]) -> ModuleName -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> [Char]
moduleNameString) Maybe ModuleName
mn [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> (Unit -> [Char]) -> Maybe Unit -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" (\Unit
uid ->[Char]
"("[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Options -> Unit -> [Char]
ppUnit Options
opts Unit
uid[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
")") Maybe Unit
muid]
  NameUnhelpfulSpan Name
nm [Char]
msg -> [[Char]] -> [Char]
unwords
    [[Char]
"Got no helpful spans for:", OccName -> [Char]
occNameString (Name -> OccName
nameOccName Name
nm), [Char]
"\nMsg:", [Char]
msg]

reportRefSpans :: Options -> [(Module,(Int,Int),(Int,Int),Maybe (Either FilePath BS.ByteString))] -> IO ()
reportRefSpans :: Options
-> [(Module, (Int, Int), (Int, Int),
     Maybe (Either [Char] ByteString))]
-> IO ()
reportRefSpans Options
opts [(Module, (Int, Int), (Int, Int),
  Maybe (Either [Char] ByteString))]
xs = do
  IORef NameCache
nc <- NameCache -> IO (IORef NameCache)
forall a. a -> IO (IORef a)
newIORef (NameCache -> IO (IORef NameCache))
-> IO NameCache -> IO (IORef NameCache)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO NameCache
makeNc
  IORef NameCache -> DbMonadT IO () -> IO ()
forall a. IORef NameCache -> DbMonad a -> IO a
runDbM IORef NameCache
nc (DbMonadT IO () -> IO ()) -> DbMonadT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [(Module, (Int, Int), (Int, Int),
  Maybe (Either [Char] ByteString))]
-> ((Module, (Int, Int), (Int, Int),
     Maybe (Either [Char] ByteString))
    -> DbMonadT IO ())
-> DbMonadT IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Module, (Int, Int), (Int, Int),
  Maybe (Either [Char] ByteString))]
xs (((Module, (Int, Int), (Int, Int),
   Maybe (Either [Char] ByteString))
  -> DbMonadT IO ())
 -> DbMonadT IO ())
-> ((Module, (Int, Int), (Int, Int),
     Maybe (Either [Char] ByteString))
    -> DbMonadT IO ())
-> DbMonadT IO ()
forall a b. (a -> b) -> a -> b
$ \(Module
mn,(Int
sl,Int
sc),(Int
el,Int
ec),Maybe (Either [Char] ByteString)
hie_f) -> do
      IO () -> DbMonadT IO ()
forall a. IO a -> DbMonadT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DbMonadT IO ()) -> IO () -> DbMonadT IO ()
forall a b. (a -> b) -> a -> b
$ do
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
colour Options
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          [SGR] -> IO ()
setSGR [Underlining -> SGR
SetUnderlining Underlining
SingleUnderline]
        [Char] -> IO ()
putStr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Options -> ModuleName -> [Char]
ppMod Options
opts (ModuleName -> [Char]) -> ModuleName -> [Char]
forall a b. (a -> b) -> a -> b
$ Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mn
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
colour Options
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          [SGR] -> IO ()
setSGR [Underlining -> SGR
SetUnderlining Underlining
SingleUnderline]
        [Char] -> IO ()
putStr [Char]
":"
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
colour Options
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          [SGR] -> IO ()
setSGR [Underlining -> SGR
SetUnderlining Underlining
SingleUnderline]
        [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Color -> ([Char] -> [Char]) -> Options -> [Char] -> [Char]
forall a. Color -> (a -> [Char]) -> Options -> a -> [Char]
colouredPP Color
Magenta [Char] -> [Char]
forall a. a -> a
id Options
opts ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
sl
          , Char
':'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Int -> [Char]
forall a. Show a => a -> [Char]
show Int
sc
          , Char
'-'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Int -> [Char]
forall a. Show a => a -> [Char]
show Int
el
          , Char
':'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Int -> [Char]
forall a. Show a => a -> [Char]
show Int
ec
          ]
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
colour Options
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          [SGR] -> IO ()
setSGR []
      case Options -> Maybe Natural
context Options
opts of
        Maybe Natural
Nothing -> () -> DbMonadT IO ()
forall a. a -> DbMonadT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
n) -> do
          Maybe ByteString
msrc <- Maybe (Either [Char] ByteString)
-> (Either [Char] ByteString -> DbMonadT IO ByteString)
-> DbMonadT IO (Maybe ByteString)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe (Either [Char] ByteString)
hie_f ((Either [Char] ByteString -> DbMonadT IO ByteString)
 -> DbMonadT IO (Maybe ByteString))
-> (Either [Char] ByteString -> DbMonadT IO ByteString)
-> DbMonadT IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \case
            Left [Char]
loc -> [Char]
-> (HieFile -> DbMonadT IO ByteString) -> DbMonadT IO ByteString
forall (m :: * -> *) a.
(NameCacheMonad m, MonadIO m) =>
[Char] -> (HieFile -> m a) -> m a
withHieFile [Char]
loc ((HieFile -> DbMonadT IO ByteString) -> DbMonadT IO ByteString)
-> (HieFile -> DbMonadT IO ByteString) -> DbMonadT IO ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> DbMonadT IO ByteString
forall a. a -> DbMonadT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> DbMonadT IO ByteString)
-> (HieFile -> ByteString) -> HieFile -> DbMonadT IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieFile -> ByteString
hie_hs_src
            Right ByteString
src -> ByteString -> DbMonadT IO ByteString
forall a. a -> DbMonadT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
src
          IO () -> DbMonadT IO ()
forall a. IO a -> DbMonadT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DbMonadT IO ()) -> IO () -> DbMonadT IO ()
forall a b. (a -> b) -> a -> b
$ case Maybe ByteString
msrc of
            Maybe ByteString
Nothing -> [Char] -> IO ()
putStrLn [Char]
"<source unavailable>"
            Just ByteString
src -> do
              let ls :: [ByteString]
ls = ByteString -> [ByteString]
BS.lines ByteString
src

                  ([ByteString]
beforeLines',[ByteString]
duringLines') = Int -> [ByteString] -> ([ByteString], [ByteString])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
slInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [ByteString]
ls
                  ([ByteString]
duringLines,[ByteString]
afterLines')   = Int -> [ByteString] -> ([ByteString], [ByteString])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
elInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
slInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [ByteString]
duringLines'

                  beforeLines :: [ByteString]
beforeLines = Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
takeEnd Int
n [ByteString]
beforeLines'
                  afterLines :: [ByteString]
afterLines  = Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
take    Int
n [ByteString]
afterLines'

                  (ByteString
beforeChars,ByteString
during') = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt (Int
scInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (ByteString -> (ByteString, ByteString))
-> ByteString -> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
intersperse ByteString
"\n" [ByteString]
duringLines
                  (ByteString
during,ByteString
afterChars) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt (ByteString -> Int
BS.length ByteString
during' Int -> Int -> Int
forall a. Num a => a -> a -> a
- (ByteString -> Int
BS.length ([ByteString] -> ByteString
forall a. HasCallStack => [a] -> a
last [ByteString]
duringLines) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ec) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ByteString
during'

                  before :: ByteString
before = [ByteString] -> ByteString
BS.unlines [ByteString]
beforeLines ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
beforeChars
                  after :: ByteString
after  = ByteString
afterChars ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [ByteString] -> ByteString
BS.unlines [ByteString]
afterLines

              ByteString -> IO ()
BS.putStr ByteString
before
              Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
colour Options
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                [SGR] -> IO ()
setSGR [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
Red, ConsoleIntensity -> SGR
SetConsoleIntensity ConsoleIntensity
BoldIntensity]
              ByteString -> IO ()
BS.putStr ByteString
during
              Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
colour Options
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                [SGR] -> IO ()
setSGR []
              ByteString -> IO ()
BS.putStrLn ByteString
after

reportRefs :: Options -> [Res RefRow] -> IO ()
reportRefs :: Options -> [Res RefRow] -> IO ()
reportRefs Options
opts [Res RefRow]
xs = Options
-> [(Module, (Int, Int), (Int, Int),
     Maybe (Either [Char] ByteString))]
-> IO ()
reportRefSpans Options
opts
  [ (Module
mdl,(RefRow -> Int
refSLine RefRow
x, RefRow -> Int
refSCol RefRow
x),(RefRow -> Int
refELine RefRow
x, RefRow -> Int
refECol RefRow
x),Either [Char] ByteString -> Maybe (Either [Char] ByteString)
forall a. a -> Maybe a
Just (Either [Char] ByteString -> Maybe (Either [Char] ByteString))
-> Either [Char] ByteString -> Maybe (Either [Char] ByteString)
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] ByteString
forall a b. a -> Either a b
Left ([Char] -> Either [Char] ByteString)
-> [Char] -> Either [Char] ByteString
forall a b. (a -> b) -> a -> b
$ RefRow -> [Char]
refSrc RefRow
x)
  | (RefRow
x:.ModuleInfo
inf) <- [Res RefRow]
xs
  , let mdl :: Module
mdl = Unit -> ModuleName -> Module
forall u. u -> ModuleName -> GenModule u
mkModule (ModuleInfo -> Unit
modInfoUnit ModuleInfo
inf) (ModuleInfo -> ModuleName
modInfoName ModuleInfo
inf)
  ]

colouredPP :: Color -> (a -> String) -> Options -> a -> String
colouredPP :: forall a. Color -> (a -> [Char]) -> Options -> a -> [Char]
colouredPP Color
c a -> [Char]
pp Options
opts a
x = [Char]
pre [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> a -> [Char]
pp a
x [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
post
  where
    ([Char]
pre,[Char]
post)
      | Options -> Bool
colour Options
opts = ([SGR] -> [Char]
setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
c], [SGR] -> [Char]
setSGRCode [])
      | Bool
otherwise = ([Char]
"",[Char]
"")


ppName :: Options -> OccName -> String
ppName :: Options -> OccName -> [Char]
ppName = Color -> (OccName -> [Char]) -> Options -> OccName -> [Char]
forall a. Color -> (a -> [Char]) -> Options -> a -> [Char]
colouredPP Color
Red OccName -> [Char]
occNameString

ppMod :: Options -> ModuleName -> String
ppMod :: Options -> ModuleName -> [Char]
ppMod = Color -> (ModuleName -> [Char]) -> Options -> ModuleName -> [Char]
forall a. Color -> (a -> [Char]) -> Options -> a -> [Char]
colouredPP Color
Green ModuleName -> [Char]
moduleNameString

ppUnit :: Options -> Unit -> String
ppUnit :: Options -> Unit -> [Char]
ppUnit = Color -> (Unit -> [Char]) -> Options -> Unit -> [Char]
forall a. Color -> (a -> [Char]) -> Options -> a -> [Char]
colouredPP Color
Yellow Unit -> [Char]
forall a. Show a => a -> [Char]
show

ppSpan :: Options -> (Int,Int) -> String
ppSpan :: Options -> (Int, Int) -> [Char]
ppSpan = Color -> ((Int, Int) -> [Char]) -> Options -> (Int, Int) -> [Char]
forall a. Color -> (a -> [Char]) -> Options -> a -> [Char]
colouredPP Color
Magenta (Int, Int) -> [Char]
forall a. Show a => a -> [Char]
show