{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BlockArguments #-}
module HieDb.Run where

import Prelude hiding (mod)

import GHC
import Compat.HieTypes
import Compat.HieUtils
import Name
import Module
import Outputable ((<+>),hang,showSDoc,ppr,text)

import qualified FastString as FS

import qualified Data.Map as M

import qualified Data.Text.IO as T


import System.Environment
import System.Directory
import System.IO
import System.Exit

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 qualified Data.ByteString.Char8 as BS

import Options.Applicative

import HieDb
import HieDb.Dump

hiedbMain :: LibDir -> IO ()
hiedbMain :: LibDir -> IO ()
hiedbMain LibDir
libdir = do
  FilePath
defaultLoc <- XdgDirectory -> FilePath -> IO FilePath
getXdgDirectory XdgDirectory
XdgData (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"default_"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
dB_VERSION FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
".hiedb"
  FilePath
defdb <- FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
defaultLoc (Maybe FilePath -> FilePath) -> IO (Maybe FilePath) -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"HIEDB"
  Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout 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
$ FilePath -> ParserInfo (Options, Command)
progParseInfo FilePath
defdb
  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 -> FilePath
database :: FilePath
  , Options -> Bool
trace :: Bool
  , Options -> Bool
quiet :: Bool
  , Options -> Bool
virtualFile :: Bool
  }

data Command
  = Init
  | Index [FilePath]
  | NameRefs String (Maybe ModuleName) (Maybe UnitId)
  | TypeRefs String (Maybe ModuleName) (Maybe UnitId)
  | NameDef  String (Maybe ModuleName) (Maybe UnitId)
  | TypeDef  String (Maybe ModuleName) (Maybe UnitId)
  | Cat HieTarget
  | Ls
  | Rm [HieTarget]
  | ModuleUIDs ModuleName
  | LookupHieFile ModuleName (Maybe UnitId)
  | 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]

progParseInfo :: FilePath -> ParserInfo (Options, Command)
progParseInfo :: FilePath -> ParserInfo (Options, Command)
progParseInfo FilePath
db = Parser (Options, Command)
-> InfoMod (Options, Command) -> ParserInfo (Options, Command)
forall a. Parser a -> InfoMod a -> ParserInfo a
info (FilePath -> Parser (Options, Command)
progParser FilePath
db 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
<> FilePath -> InfoMod (Options, Command)
forall a. FilePath -> InfoMod a
progDesc FilePath
"Query .hie files"
  InfoMod (Options, Command)
-> InfoMod (Options, Command) -> InfoMod (Options, Command)
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod (Options, Command)
forall a. FilePath -> InfoMod a
header FilePath
"hiedb - a tool to query groups of .hie files" )

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

optParser :: FilePath -> Parser Options
optParser :: FilePath -> Parser Options
optParser FilePath
defdb
    = FilePath -> Bool -> Bool -> Bool -> Options
Options
  (FilePath -> Bool -> Bool -> Bool -> Options)
-> Parser FilePath -> Parser (Bool -> Bool -> Bool -> Options)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"database" Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'D' Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"DATABASE"
              Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value FilePath
defdb Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields FilePath
forall a (f :: * -> *). Show a => Mod f a
showDefault Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"References Database")
  Parser (Bool -> Bool -> Bool -> Options)
-> Parser Bool -> Parser (Bool -> Bool -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"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
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Print SQL queries being executed")
  Parser (Bool -> Bool -> Options)
-> Parser Bool -> Parser (Bool -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"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
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Don't print progress messages")
  Parser (Bool -> Options) -> Parser Bool -> Parser Options
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"virtual-file" 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
'f' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields Bool
forall (f :: * -> *) a. Mod f a
internal)

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
$ FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"init" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Command -> Parser Command
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
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"Initialize database")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"index" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info ([FilePath] -> Command
Index ([FilePath] -> Command) -> Parser [FilePath] -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FilePath -> Parser [FilePath]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"DIRECTORY..."))) (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"Index database")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"name-refs" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (FilePath -> Maybe ModuleName -> Maybe UnitId -> Command
NameRefs (FilePath -> Maybe ModuleName -> Maybe UnitId -> Command)
-> Parser FilePath
-> Parser (Maybe ModuleName -> Maybe UnitId -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"NAME")
                                         Parser (Maybe ModuleName -> Maybe UnitId -> Command)
-> Parser (Maybe ModuleName) -> Parser (Maybe UnitId -> Command)
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 (FilePath -> ModuleName
mkModuleName (FilePath -> ModuleName) -> Parser FilePath -> Parser ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"MODULE"))
                                         Parser (Maybe UnitId -> Command)
-> Parser (Maybe UnitId) -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe UnitId)
maybeUnitId)
                         (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"Lookup references of value MODULE.NAME")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"type-refs" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (FilePath -> Maybe ModuleName -> Maybe UnitId -> Command
TypeRefs (FilePath -> Maybe ModuleName -> Maybe UnitId -> Command)
-> Parser FilePath
-> Parser (Maybe ModuleName -> Maybe UnitId -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"NAME")
                                         Parser (Maybe ModuleName -> Maybe UnitId -> Command)
-> Parser (Maybe ModuleName) -> Parser (Maybe UnitId -> Command)
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 UnitId -> Command)
-> Parser (Maybe UnitId) -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe UnitId)
maybeUnitId)
                         (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"Lookup references of type MODULE.NAME")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"name-def" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (FilePath -> Maybe ModuleName -> Maybe UnitId -> Command
NameDef (FilePath -> Maybe ModuleName -> Maybe UnitId -> Command)
-> Parser FilePath
-> Parser (Maybe ModuleName -> Maybe UnitId -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"NAME")
                                       Parser (Maybe ModuleName -> Maybe UnitId -> Command)
-> Parser (Maybe ModuleName) -> Parser (Maybe UnitId -> Command)
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 UnitId -> Command)
-> Parser (Maybe UnitId) -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe UnitId)
maybeUnitId)
                         (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"Lookup definition of value MODULE.NAME")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"type-def" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (FilePath -> Maybe ModuleName -> Maybe UnitId -> Command
TypeDef (FilePath -> Maybe ModuleName -> Maybe UnitId -> Command)
-> Parser FilePath
-> Parser (Maybe ModuleName -> Maybe UnitId -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"NAME")
                                       Parser (Maybe ModuleName -> Maybe UnitId -> Command)
-> Parser (Maybe ModuleName) -> Parser (Maybe UnitId -> Command)
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 UnitId -> Command)
-> Parser (Maybe UnitId) -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe UnitId)
maybeUnitId)
                         (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"Lookup definition of type MODULE.NAME")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"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
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"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
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"ls" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Command -> Parser Command
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
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"List all indexed files/modules")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"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 (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
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"Remove targets from index")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"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
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"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
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"lookup-hie" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (ModuleName -> Maybe UnitId -> Command
LookupHieFile (ModuleName -> Maybe UnitId -> Command)
-> Parser ModuleName -> Parser (Maybe UnitId -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ModuleName
moduleNameParser Parser (Maybe UnitId -> Command)
-> Parser (Maybe UnitId) -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe UnitId)
maybeUnitId)
                         (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"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
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"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 (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 (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
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"Find references for symbol at point/span")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"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 (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 (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
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"List types of ast at point/span")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"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 (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 (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
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"Find definition for symbol at point/span")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"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 (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 (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
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"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
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"ref-graph" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Command -> Parser Command
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
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"Generate a reachability graph")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"dump" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (FilePath -> Command
Dump (FilePath -> Command) -> Parser FilePath -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"HIE")) (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"Dump a HIE AST")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"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 (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
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"Find all symbols reachable from the given symbols")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"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 (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
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"Find all symbols unreachable from the given symbols")
  Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"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 (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
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"generate html files for reachability from the given symbols")

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 (FilePath -> Mod ArgumentFields Int
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar (FilePath -> Mod ArgumentFields Int)
-> FilePath -> Mod ArgumentFields Int
forall a b. (a -> b) -> a -> b
$ Char
cChar -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
"LINE") Parser (Int -> (Int, Int)) -> Parser Int -> Parser (Int, Int)
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 (FilePath -> Mod ArgumentFields Int
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar (FilePath -> Mod ArgumentFields Int)
-> FilePath -> Mod ArgumentFields Int
forall a b. (a -> b) -> a -> b
$ Char
cChar -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
"COL")

maybeUnitId :: Parser (Maybe UnitId)
maybeUnitId :: Parser (Maybe UnitId)
maybeUnitId =
  Parser UnitId -> Parser (Maybe UnitId)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (FilePath -> UnitId
stringToUnitId (FilePath -> UnitId) -> Parser FilePath -> Parser UnitId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'u' Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"unit-id" Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"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
$ FilePath -> Mod ArgumentFields Symbol
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"SYMBOL"

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

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

progress :: Int -> Int -> Int -> (FilePath -> DbMonad a) -> FilePath -> DbMonad a
progress :: Int
-> Int -> Int -> (FilePath -> DbMonad a) -> FilePath -> DbMonad a
progress Int
l Int
total Int
cur FilePath -> DbMonad a
act FilePath
f = do
  IO () -> DbMonadT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DbMonadT IO ()) -> IO () -> DbMonadT IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Char -> FilePath
forall a. Int -> a -> [a]
replicate Int
l Char
' '
  IO () -> DbMonadT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DbMonadT IO ()) -> IO () -> DbMonadT IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStr FilePath
"\r"
  let msg :: FilePath
msg = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
8) (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unwords [FilePath
"Processing file", Int -> FilePath
forall a. Show a => a -> FilePath
show (Int
cur Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
total FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
":", FilePath
f] FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"..."
  IO () -> DbMonadT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DbMonadT IO ()) -> IO () -> DbMonadT IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStr FilePath
msg
  a
x <- FilePath -> DbMonad a
act FilePath
f
  IO () -> DbMonadT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DbMonadT IO ()) -> IO () -> DbMonadT IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStr FilePath
" done\r"
  a -> DbMonad a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

runCommand :: LibDir -> Options -> Command -> IO ()
runCommand :: LibDir -> Options -> Command -> IO ()
runCommand LibDir
libdir Options
opts Command
cmd = LibDir -> FilePath -> (DynFlags -> HieDb -> IO ()) -> IO ()
forall a. LibDir -> FilePath -> (DynFlags -> HieDb -> IO a) -> IO a
withHieDbAndFlags LibDir
libdir (Options -> FilePath
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
<>))
  case Command
cmd of
    Command
Init -> HieDb -> IO ()
initConn HieDb
conn
    Index [FilePath]
dirs -> do
      HieDb -> IO ()
initConn HieDb
conn
      [FilePath]
files <- [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO [FilePath]
getHieFilesIn [FilePath]
dirs
      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
      Int
wsize <- Int -> (Window Int -> Int) -> Maybe (Window Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
80 Window Int -> Int
forall a. Window a -> a
width (Maybe (Window Int) -> Int) -> IO (Maybe (Window Int)) -> IO 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 progress' :: Int
-> Int -> Int -> (FilePath -> DbMonad a) -> FilePath -> DbMonad a
progress' = if Options -> Bool
quiet Options
opts then (\Int
_ Int
_ Int
_ FilePath -> DbMonad a
k -> FilePath -> DbMonad a
k) else Int
-> Int -> Int -> (FilePath -> DbMonad a) -> FilePath -> DbMonad a
forall a.
Int
-> Int -> Int -> (FilePath -> DbMonad a) -> FilePath -> DbMonad a
progress
      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
$
        (FilePath -> Int -> DbMonadT IO ())
-> [FilePath] -> [Int] -> DbMonadT IO ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (\FilePath
f Int
n -> Int
-> Int
-> Int
-> (FilePath -> DbMonadT IO ())
-> FilePath
-> DbMonadT IO ()
forall a.
Int
-> Int -> Int -> (FilePath -> DbMonad a) -> FilePath -> DbMonad a
progress' Int
wsize ([FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
files) Int
n (HieDb -> FilePath -> DbMonadT IO ()
forall (m :: * -> *).
(MonadIO m, NameCacheMonad m) =>
HieDb -> FilePath -> m ()
addRefsFrom HieDb
conn) FilePath
f) [FilePath]
files [Int
0..]
      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
$
        FilePath -> IO ()
putStrLn FilePath
"\nCompleted!"
    TypeRefs FilePath
typ Maybe ModuleName
mn Maybe UnitId
muid -> do
      let occ :: OccName
occ = NameSpace -> FilePath -> OccName
mkOccName NameSpace
tcClsName FilePath
typ
      [Res RefRow]
refs <- HieDb
-> Bool
-> OccName
-> Maybe ModuleName
-> Maybe UnitId
-> [FilePath]
-> IO [Res RefRow]
search HieDb
conn Bool
False OccName
occ Maybe ModuleName
mn Maybe UnitId
muid []
      [Res RefRow] -> IO ()
reportRefs [Res RefRow]
refs
    NameRefs FilePath
nm Maybe ModuleName
mn Maybe UnitId
muid -> do
      let ns :: NameSpace
ns = if FilePath -> Bool
isCons FilePath
nm then NameSpace
dataName else NameSpace
varName
      let occ :: OccName
occ = NameSpace -> FilePath -> OccName
mkOccName NameSpace
ns FilePath
nm
      [Res RefRow]
refs <- HieDb
-> Bool
-> OccName
-> Maybe ModuleName
-> Maybe UnitId
-> [FilePath]
-> IO [Res RefRow]
search HieDb
conn Bool
False OccName
occ Maybe ModuleName
mn Maybe UnitId
muid []
      [Res RefRow] -> IO ()
reportRefs [Res RefRow]
refs
    NameDef FilePath
nm Maybe ModuleName
mn Maybe UnitId
muid -> do
      let ns :: NameSpace
ns = if FilePath -> Bool
isCons FilePath
nm then NameSpace
dataName else NameSpace
varName
      let occ :: OccName
occ = NameSpace -> FilePath -> OccName
mkOccName NameSpace
ns FilePath
nm
      (DefRow
row:.ModuleInfo
inf) <- Either HieDbErr (DefRow :. ModuleInfo) -> IO (DefRow :. ModuleInfo)
forall a. Either HieDbErr a -> IO a
reportAmbiguousErr (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 UnitId
-> IO (Either HieDbErr (DefRow :. ModuleInfo))
findOneDef HieDb
conn OccName
occ Maybe ModuleName
mn Maybe UnitId
muid
      let mdl :: Module
mdl = UnitId -> ModuleName -> Module
mkModule (ModuleInfo -> UnitId
modInfoUnit ModuleInfo
inf) (ModuleInfo -> ModuleName
modInfoName ModuleInfo
inf)
      [(Module, (Int, Int), (Int, Int))] -> IO ()
reportRefSpans [(Module
mdl, (DefRow -> Int
defSLine DefRow
row, DefRow -> Int
defSCol DefRow
row), (DefRow -> Int
defELine DefRow
row, DefRow -> Int
defECol DefRow
row))]
    TypeDef FilePath
nm Maybe ModuleName
mn Maybe UnitId
muid -> do
      let occ :: OccName
occ = NameSpace -> FilePath -> OccName
mkOccName NameSpace
tcClsName FilePath
nm
      (DefRow
row:.ModuleInfo
inf) <- Either HieDbErr (DefRow :. ModuleInfo) -> IO (DefRow :. ModuleInfo)
forall a. Either HieDbErr a -> IO a
reportAmbiguousErr (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 UnitId
-> IO (Either HieDbErr (DefRow :. ModuleInfo))
findOneDef HieDb
conn OccName
occ Maybe ModuleName
mn Maybe UnitId
muid
      let mdl :: Module
mdl = UnitId -> ModuleName -> Module
mkModule (ModuleInfo -> UnitId
modInfoUnit ModuleInfo
inf) (ModuleInfo -> ModuleName
modInfoName ModuleInfo
inf)
      [(Module, (Int, Int), (Int, Int))] -> IO ()
reportRefSpans [(Module
mdl, (DefRow -> Int
defSLine DefRow
row, DefRow -> Int
defSCol DefRow
row), (DefRow -> Int
defELine DefRow
row, DefRow -> Int
defECol DefRow
row))]
    Cat HieTarget
target -> HieDb -> HieTarget -> (HieFile -> IO ()) -> IO ()
forall a. HieDb -> HieTarget -> (HieFile -> IO a) -> IO a
hieFileCommand HieDb
conn 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
        FilePath -> IO ()
putStr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ HieModuleRow -> FilePath
hieModuleHieFile HieModuleRow
mod
        FilePath -> IO ()
putStr FilePath
"\t"
        FilePath -> IO ()
putStr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ ModuleName -> FilePath
moduleNameString (ModuleName -> FilePath) -> ModuleName -> FilePath
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
        FilePath -> IO ()
putStr FilePath
"\t"
        FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ UnitId -> FilePath
unitIdString (UnitId -> FilePath) -> UnitId -> FilePath
forall a b. (a -> b) -> a -> b
$ ModuleInfo -> UnitId
modInfoUnit (ModuleInfo -> UnitId) -> ModuleInfo -> UnitId
forall a b. (a -> b) -> a -> b
$ HieModuleRow -> ModuleInfo
hieModInfo HieModuleRow
mod
    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 FilePath
f -> do
              Bool
dir <- FilePath -> IO Bool
doesDirectoryExist FilePath
f
              if Bool
dir
              then do
                [FilePath]
fs <- FilePath -> IO [FilePath]
getHieFilesIn FilePath
f
                (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (HieDb -> FilePath -> IO ()
deleteFileFromIndex HieDb
conn) [FilePath]
fs
              else do
                FilePath
cf <- FilePath -> IO FilePath
canonicalizePath FilePath
f
                HieDb -> FilePath -> IO ()
deleteFileFromIndex HieDb
conn FilePath
cf
            Right (ModuleName
mn,Maybe UnitId
muid) -> do
              UnitId
uid <- Either HieDbErr UnitId -> IO UnitId
forall a. Either HieDbErr a -> IO a
reportAmbiguousErr (Either HieDbErr UnitId -> IO UnitId)
-> IO (Either HieDbErr UnitId) -> IO UnitId
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Either HieDbErr UnitId)
-> (UnitId -> IO (Either HieDbErr UnitId))
-> Maybe UnitId
-> IO (Either HieDbErr UnitId)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (HieDb -> ModuleName -> IO (Either HieDbErr UnitId)
resolveUnitId HieDb
conn ModuleName
mn) (Either HieDbErr UnitId -> IO (Either HieDbErr UnitId)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either HieDbErr UnitId -> IO (Either HieDbErr UnitId))
-> (UnitId -> Either HieDbErr UnitId)
-> UnitId
-> IO (Either HieDbErr UnitId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitId -> Either HieDbErr UnitId
forall a b. b -> Either a b
Right) Maybe UnitId
muid
              Maybe HieModuleRow
mFile <- HieDb -> ModuleName -> UnitId -> IO (Maybe HieModuleRow)
lookupHieFile HieDb
conn ModuleName
mn UnitId
uid
              case Maybe HieModuleRow
mFile of
                Maybe HieModuleRow
Nothing -> Either HieDbErr () -> IO ()
forall a. Either HieDbErr a -> IO a
reportAmbiguousErr (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 UnitId -> HieDbErr
NotIndexed ModuleName
mn (Maybe UnitId -> HieDbErr) -> Maybe UnitId -> HieDbErr
forall a b. (a -> b) -> a -> b
$ UnitId -> Maybe UnitId
forall a. a -> Maybe a
Just UnitId
uid)
                Just HieModuleRow
x -> HieDb -> FilePath -> IO ()
deleteFileFromIndex HieDb
conn (HieModuleRow -> FilePath
hieModuleHieFile HieModuleRow
x)
    ModuleUIDs ModuleName
mn ->
      UnitId -> IO ()
forall a. Show a => a -> IO ()
print (UnitId -> IO ()) -> IO UnitId -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either HieDbErr UnitId -> IO UnitId
forall a. Either HieDbErr a -> IO a
reportAmbiguousErr (Either HieDbErr UnitId -> IO UnitId)
-> IO (Either HieDbErr UnitId) -> IO UnitId
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HieDb -> ModuleName -> IO (Either HieDbErr UnitId)
resolveUnitId HieDb
conn ModuleName
mn
    LookupHieFile ModuleName
mn Maybe UnitId
muid -> Either HieDbErr () -> IO ()
forall a. Either HieDbErr a -> IO a
reportAmbiguousErr (Either HieDbErr () -> IO ()) -> IO (Either HieDbErr ()) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
      Either HieDbErr UnitId
euid <- IO (Either HieDbErr UnitId)
-> (UnitId -> IO (Either HieDbErr UnitId))
-> Maybe UnitId
-> IO (Either HieDbErr UnitId)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (HieDb -> ModuleName -> IO (Either HieDbErr UnitId)
resolveUnitId HieDb
conn ModuleName
mn) (Either HieDbErr UnitId -> IO (Either HieDbErr UnitId)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either HieDbErr UnitId -> IO (Either HieDbErr UnitId))
-> (UnitId -> Either HieDbErr UnitId)
-> UnitId
-> IO (Either HieDbErr UnitId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitId -> Either HieDbErr UnitId
forall a b. b -> Either a b
Right) Maybe UnitId
muid
      case Either HieDbErr UnitId
euid of
        Left HieDbErr
err -> Either HieDbErr () -> IO (Either HieDbErr ())
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 UnitId
uid -> do
          Maybe HieModuleRow
mFile <- HieDb -> ModuleName -> UnitId -> IO (Maybe HieModuleRow)
lookupHieFile HieDb
conn ModuleName
mn UnitId
uid
          case Maybe HieModuleRow
mFile of
            Maybe HieModuleRow
Nothing -> Either HieDbErr () -> IO (Either HieDbErr ())
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 UnitId -> HieDbErr
NotIndexed ModuleName
mn (Maybe UnitId -> HieDbErr) -> Maybe UnitId -> HieDbErr
forall a b. (a -> b) -> a -> b
$ UnitId -> Maybe UnitId
forall a. a -> Maybe a
Just UnitId
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
<$> FilePath -> IO ()
putStrLn (HieModuleRow -> FilePath
hieModuleHieFile HieModuleRow
x)
    RefsAtPoint HieTarget
target (Int, Int)
sp Maybe (Int, Int)
mep -> HieDb -> HieTarget -> (HieFile -> IO ()) -> IO ()
forall a. HieDb -> HieTarget -> (HieFile -> IO a) -> IO a
hieFileCommand HieDb
conn 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
forall a. HieAST a -> NodeInfo a
nodeInfo
      [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
        FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unwords [FilePath
"Name", OccName -> FilePath
occNameString (Name -> OccName
nameOccName Name
name),FilePath
"at",(Int, Int) -> FilePath
forall a. Show a => a -> FilePath
show (Int, Int)
sp,FilePath
"is used in:"]
        case Name -> Maybe Module
nameModule_maybe Name
name of
          Just Module
mod -> do
            [Res RefRow] -> IO ()
reportRefs ([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 UnitId
-> [FilePath]
-> IO [Res RefRow]
search 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
moduleName Module
mod) (UnitId -> Maybe UnitId
forall a. a -> Maybe a
Just (UnitId -> Maybe UnitId) -> UnitId -> Maybe UnitId
forall a b. (a -> b) -> a -> b
$ Module -> UnitId
moduleUnitId Module
mod) []
          Maybe Module
Nothing -> do
            let refmap :: Map (Either ModuleName Name) [(Span, IdentifierDetails Int)]
refmap = Map FastString (HieAST Int)
-> Map (Either ModuleName Name) [(Span, IdentifierDetails Int)]
forall (f :: * -> *) a.
Foldable f =>
f (HieAST a)
-> Map (Either ModuleName Name) [(Span, IdentifierDetails a)]
generateReferencesMap (HieASTs Int -> Map FastString (HieAST Int)
forall a. HieASTs a -> Map FastString (HieAST a)
getAsts (HieASTs Int -> Map FastString (HieAST Int))
-> HieASTs Int -> Map FastString (HieAST Int)
forall a b. (a -> b) -> a -> b
$ HieFile -> HieASTs Int
hie_asts HieFile
hf)
                refs :: [(Module, (Int, Int), (Int, Int))]
refs = ((Span, IdentifierDetails Int) -> (Module, (Int, Int), (Int, Int)))
-> [(Span, IdentifierDetails Int)]
-> [(Module, (Int, Int), (Int, Int))]
forall a b. (a -> b) -> [a] -> [b]
map (Span -> (Module, (Int, Int), (Int, Int))
toRef (Span -> (Module, (Int, Int), (Int, Int)))
-> ((Span, IdentifierDetails Int) -> Span)
-> (Span, IdentifierDetails Int)
-> (Module, (Int, Int), (Int, Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Span, IdentifierDetails Int) -> Span
forall a b. (a, b) -> a
fst) ([(Span, IdentifierDetails Int)]
 -> [(Module, (Int, Int), (Int, Int))])
-> [(Span, IdentifierDetails Int)]
-> [(Module, (Int, Int), (Int, Int))]
forall a b. (a -> b) -> a -> b
$ [(Span, IdentifierDetails Int)]
-> Either ModuleName Name
-> Map (Either ModuleName Name) [(Span, IdentifierDetails Int)]
-> [(Span, 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) Map (Either ModuleName Name) [(Span, IdentifierDetails Int)]
refmap
                toRef :: Span -> (Module, (Int, Int), (Int, Int))
toRef Span
spn = (HieFile -> Module
hie_module HieFile
hf,
                              (Span -> Int
srcSpanStartLine Span
spn , Span -> Int
srcSpanStartCol Span
spn),
                              (Span -> Int
srcSpanEndLine Span
spn , Span -> Int
srcSpanEndCol Span
spn))
            [(Module, (Int, Int), (Int, Int))] -> IO ()
reportRefSpans [(Module, (Int, Int), (Int, Int))]
refs
    TypesAtPoint HieTarget
target (Int, Int)
sp Maybe (Int, Int)
mep -> HieDb -> HieTarget -> (HieFile -> IO ()) -> IO ()
forall a. HieDb -> HieTarget -> (HieFile -> IO a) -> IO a
hieFileCommand HieDb
conn 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
forall a. HieAST a -> NodeInfo a
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'
      [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
        FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> HieTypeFix -> FilePath
renderHieType DynFlags
dynFlags HieTypeFix
typ
    DefsAtPoint HieTarget
target (Int, Int)
sp Maybe (Int, Int)
mep -> HieDb -> HieTarget -> (HieFile -> IO ()) -> IO ()
forall a. HieDb -> HieTarget -> (HieFile -> IO a) -> IO a
hieFileCommand HieDb
conn 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
forall a. HieAST a -> NodeInfo a
nodeInfo
      [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 Span
dsp -> do
            FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unwords [FilePath
"Name", OccName -> FilePath
occNameString (Name -> OccName
nameOccName Name
name),FilePath
"at",(Int, Int) -> FilePath
forall a. Show a => a -> FilePath
show (Int, Int)
sp,FilePath
"is defined at:"]
            [(Module, (Int, Int), (Int, Int))] -> IO ()
reportRefSpans [(Module -> Maybe Module -> Module
forall a. a -> Maybe a -> a
fromMaybe (HieFile -> Module
hie_module HieFile
hf) (Name -> Maybe Module
nameModule_maybe Name
name)
                            ,(Span -> Int
srcSpanStartLine Span
dsp,Span -> Int
srcSpanStartCol Span
dsp)
                            ,(Span -> Int
srcSpanEndLine Span
dsp, Span -> Int
srcSpanEndCol Span
dsp))]
          UnhelpfulSpan FastString
msg -> do
            case Name -> Maybe Module
nameModule_maybe Name
name of
              Just Module
mod -> do
                (DefRow
row:.ModuleInfo
inf) <- Either HieDbErr (DefRow :. ModuleInfo) -> IO (DefRow :. ModuleInfo)
forall a. Either HieDbErr a -> IO a
reportAmbiguousErr
                    (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 UnitId
-> 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
moduleName Module
mod) (UnitId -> Maybe UnitId
forall a. a -> Maybe a
Just (UnitId -> Maybe UnitId) -> UnitId -> Maybe UnitId
forall a b. (a -> b) -> a -> b
$ Module -> UnitId
moduleUnitId Module
mod)
                FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unwords [FilePath
"Name", OccName -> FilePath
occNameString (Name -> OccName
nameOccName Name
name),FilePath
"at",(Int, Int) -> FilePath
forall a. Show a => a -> FilePath
show (Int, Int)
sp,FilePath
"is defined at:"]
                [(Module, (Int, Int), (Int, Int))] -> IO ()
reportRefSpans [(UnitId -> ModuleName -> Module
mkModule (ModuleInfo -> UnitId
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))]
              Maybe Module
Nothing -> do
                Either HieDbErr () -> IO ()
forall a. Either HieDbErr a -> IO a
reportAmbiguousErr (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 -> FilePath -> HieDbErr
NameUnhelpfulSpan Name
name (FastString -> FilePath
FS.unpackFS FastString
msg)
    InfoAtPoint HieTarget
target (Int, Int)
sp Maybe (Int, Int)
mep -> HieDb -> HieTarget -> (HieFile -> IO ()) -> IO ()
forall a. HieDb -> HieTarget -> (HieFile -> IO a) -> IO a
hieFileCommand HieDb
conn HieTarget
target ((HieFile -> IO ()) -> IO ()) -> (HieFile -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HieFile
hf -> do
      ((NodeInfo FilePath, Span) -> IO ())
-> [(NodeInfo FilePath, Span)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((NodeInfo FilePath -> Span -> IO ())
-> (NodeInfo FilePath, Span) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((NodeInfo FilePath -> Span -> IO ())
 -> (NodeInfo FilePath, Span) -> IO ())
-> (NodeInfo FilePath -> Span -> IO ())
-> (NodeInfo FilePath, Span)
-> IO ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> NodeInfo FilePath -> Span -> IO ()
printInfo DynFlags
dynFlags) ([(NodeInfo FilePath, Span)] -> IO ())
-> [(NodeInfo FilePath, Span)] -> IO ()
forall a b. (a -> b) -> a -> b
$ HieFile
-> (Int, Int)
-> Maybe (Int, Int)
-> (HieAST Int -> (NodeInfo FilePath, Span))
-> [(NodeInfo FilePath, Span)]
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 FilePath, Span))
 -> [(NodeInfo FilePath, Span)])
-> (HieAST Int -> (NodeInfo FilePath, Span))
-> [(NodeInfo FilePath, Span)]
forall a b. (a -> b) -> a -> b
$ \HieAST Int
ast ->
        (DynFlags -> HieTypeFix -> FilePath
renderHieType DynFlags
dynFlags (HieTypeFix -> FilePath) -> (Int -> HieTypeFix) -> Int -> FilePath
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 -> FilePath) -> NodeInfo Int -> NodeInfo FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HieAST Int -> NodeInfo Int
forall a. HieAST a -> NodeInfo a
nodeInfo HieAST Int
ast, HieAST Int -> Span
forall a. HieAST a -> Span
nodeSpan HieAST Int
ast)
    Command
RefGraph -> HieDb -> IO ()
declRefs HieDb
conn
    Dump FilePath
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 -> FilePath -> DbMonadT IO ()
forall (m :: * -> *).
(NameCacheMonad m, MonadIO m) =>
DynFlags -> FilePath -> m ()
dump DynFlags
dynFlags FilePath
path
    Reachable [Symbol]
s -> HieDb -> [Symbol] -> IO [Vertex]
getReachable HieDb
conn [Symbol]
s IO [Vertex] -> ([Vertex] -> IO ()) -> IO ()
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 (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

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

hieFileCommand :: HieDb -> HieTarget -> (HieFile -> IO a) -> IO a
hieFileCommand :: HieDb -> HieTarget -> (HieFile -> IO a) -> IO a
hieFileCommand HieDb
conn 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
$ Either HieDbErr (IO a) -> IO (IO a)
forall a. Either HieDbErr a -> IO a
reportAmbiguousErr (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 :: Either HieDbErr a -> IO a
reportAmbiguousErr :: Either HieDbErr a -> IO a
reportAmbiguousErr (Right a
x) = a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
reportAmbiguousErr (Left HieDbErr
e) = do
  FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ HieDbErr -> FilePath
showHieDbErr HieDbErr
e
  IO a
forall a. IO a
exitFailure

showHieDbErr :: HieDbErr -> String
showHieDbErr :: HieDbErr -> FilePath
showHieDbErr HieDbErr
e = case HieDbErr
e of
  NotIndexed ModuleName
mn Maybe UnitId
muid -> [FilePath] -> FilePath
unwords [FilePath
"Module", ModuleName -> FilePath
moduleNameString ModuleName
mn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> (UnitId -> FilePath) -> Maybe UnitId -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" (\UnitId
uid -> FilePath
"("FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++UnitId -> FilePath
forall a. Show a => a -> FilePath
show UnitId
uidFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
")") Maybe UnitId
muid, FilePath
"not indexed."]
  AmbiguousUnitId NonEmpty ModuleInfo
xs -> [FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"UnitId could be any of:" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: (ModuleInfo -> FilePath) -> [ModuleInfo] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath
" - "FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>) (FilePath -> FilePath)
-> (ModuleInfo -> FilePath) -> ModuleInfo -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitId -> FilePath
unitIdString (UnitId -> FilePath)
-> (ModuleInfo -> UnitId) -> ModuleInfo -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleInfo -> UnitId
modInfoUnit) (NonEmpty ModuleInfo -> [ModuleInfo]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty ModuleInfo
xs)
    [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [FilePath
"Use --unit-id to disambiguate"]
  NameNotFound OccName
occ Maybe ModuleName
mn Maybe UnitId
muid -> [FilePath] -> FilePath
unwords
    [FilePath
"Couldn't find name:", OccName -> FilePath
occNameString OccName
occ, FilePath
-> (ModuleName -> FilePath) -> Maybe ModuleName -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" ((FilePath
"from module " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) (FilePath -> FilePath)
-> (ModuleName -> FilePath) -> ModuleName -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> FilePath
moduleNameString) Maybe ModuleName
mn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> (UnitId -> FilePath) -> Maybe UnitId -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" (\UnitId
uid ->FilePath
"("FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++UnitId -> FilePath
forall a. Show a => a -> FilePath
show UnitId
uidFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
")") Maybe UnitId
muid]
  NameUnhelpfulSpan Name
nm FilePath
msg -> [FilePath] -> FilePath
unwords
    [FilePath
"Got no helpful spans for:", OccName -> FilePath
occNameString (Name -> OccName
nameOccName Name
nm), FilePath
"\nMsg:", FilePath
msg]
 
reportRefSpans :: [(Module,(Int,Int),(Int,Int))] -> IO ()
reportRefSpans :: [(Module, (Int, Int), (Int, Int))] -> IO ()
reportRefSpans = ((Module, (Int, Int), (Int, Int)) -> IO ())
-> [(Module, (Int, Int), (Int, Int))] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (((Module, (Int, Int), (Int, Int)) -> IO ())
 -> [(Module, (Int, Int), (Int, Int))] -> IO ())
-> ((Module, (Int, Int), (Int, Int)) -> IO ())
-> [(Module, (Int, Int), (Int, Int))]
-> IO ()
forall a b. (a -> b) -> a -> b
$ \(Module
mn,(Int
sl,Int
sc),(Int
el,Int
ec)) ->
  FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ ModuleName -> FilePath
moduleNameString (ModuleName -> FilePath) -> ModuleName -> FilePath
forall a b. (a -> b) -> a -> b
$ Module -> ModuleName
moduleName Module
mn
    , Char
':'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Int -> FilePath
forall a. Show a => a -> FilePath
show Int
sl
    , Char
':'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Int -> FilePath
forall a. Show a => a -> FilePath
show Int
sc
    , Char
'-'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Int -> FilePath
forall a. Show a => a -> FilePath
show Int
el
    , Char
':'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Int -> FilePath
forall a. Show a => a -> FilePath
show Int
ec
    ]

reportRefs :: [Res RefRow] -> IO ()
reportRefs :: [Res RefRow] -> IO ()
reportRefs [Res RefRow]
xs = [(Module, (Int, Int), (Int, Int))] -> IO ()
reportRefSpans
  [ (Module
mdl,(RefRow -> Int
refSLine RefRow
x, RefRow -> Int
refSCol RefRow
x),(RefRow -> Int
refELine RefRow
x, RefRow -> Int
refECol RefRow
x))
  | (RefRow
x:.ModuleInfo
inf) <- [Res RefRow]
xs
  , let mdl :: Module
mdl = UnitId -> ModuleName -> Module
mkModule (ModuleInfo -> UnitId
modInfoUnit ModuleInfo
inf) (ModuleInfo -> ModuleName
modInfoName ModuleInfo
inf)
  ]