{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE LambdaCase #-}
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 IfaceType (IfaceType)

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.IO.Unsafe (unsafeInterleaveIO)
import System.Exit
import System.Time.Extra

import System.Console.ANSI

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.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"
  Bool
colr <- Handle -> IO Bool
hSupportsANSIColor Handle
stdout
  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 -> Bool -> ParserInfo (Options, Command)
progParseInfo FilePath
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 -> FilePath
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
  }

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]
  | GCTypeNames

progParseInfo :: FilePath -> Bool -> ParserInfo (Options, Command)
progParseInfo :: FilePath -> Bool -> ParserInfo (Options, Command)
progParseInfo FilePath
db Bool
colr = Parser (Options, Command)
-> InfoMod (Options, Command) -> ParserInfo (Options, Command)
forall a. Parser a -> InfoMod a -> ParserInfo a
info (FilePath -> Bool -> Parser (Options, Command)
progParser FilePath
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
<> 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 -> Bool -> Parser (Options,Command)
progParser :: FilePath -> Bool -> Parser (Options, Command)
progParser FilePath
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
<$> FilePath -> Bool -> Parser Options
optParser FilePath
db Bool
colr 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 -> Bool -> Parser Options
optParser :: FilePath -> Bool -> Parser Options
optParser FilePath
defdb Bool
colr
    = FilePath
-> Bool -> Bool -> Bool -> Maybe Natural -> Bool -> Bool -> Options
Options
  (FilePath
 -> Bool
 -> Bool
 -> Bool
 -> Maybe Natural
 -> Bool
 -> Bool
 -> Options)
-> Parser FilePath
-> Parser
     (Bool -> Bool -> Bool -> Maybe Natural -> 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 -> Maybe Natural -> Bool -> Bool -> Options)
-> Parser Bool
-> Parser
     (Bool -> Bool -> Maybe Natural -> 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 -> Maybe Natural -> Bool -> Bool -> Options)
-> Parser Bool
-> Parser (Bool -> Maybe Natural -> 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
"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 -> Maybe Natural -> Bool -> Bool -> Options)
-> Parser Bool -> Parser (Maybe Natural -> Bool -> Bool -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
colourFlag
  Parser (Maybe Natural -> Bool -> Bool -> Options)
-> Parser (Maybe Natural) -> Parser (Bool -> Bool -> Options)
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 (FilePath -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"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
<> FilePath -> Mod OptionFields Natural
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Number of lines of context for source spans - show no context by default"))
  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
"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
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Re-index all files in database before running command, deleting those with missing '.hie' files")
  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
"keep-missing" 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
"Keep missing files when re-indexing")
  where
    colourFlag :: Parser Bool
colourFlag = Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> Mod FlagFields a -> Parser a
flag' Bool
True (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"colour" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"color" 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
"Force coloured output")
            Parser Bool -> Parser Bool -> Parser Bool
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 (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"no-colour" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"no-color" 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
"Force uncoloured ouput")
            Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
colr

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 files from directory")
  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")
  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
"gc" (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
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 (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 :: Handle -> Int -> Int -> (FilePath -> DbMonad Bool) -> FilePath -> DbMonad Bool
progress :: Handle
-> Int
-> Int
-> (FilePath -> DbMonad Bool)
-> FilePath
-> DbMonad Bool
progress Handle
hndl Int
total Int
cur FilePath -> DbMonad Bool
act FilePath
f = do
  Maybe Int
mw <- ((Int, Int) -> Int) -> Maybe (Int, Int) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Int) -> Int
forall a b. (a, b) -> b
snd (Maybe (Int, Int) -> Maybe Int)
-> DbMonadT IO (Maybe (Int, Int)) -> DbMonadT IO (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe (Int, Int)) -> DbMonadT IO (Maybe (Int, Int))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Maybe (Int, Int))
getTerminalSize
  let msg' :: FilePath
msg' = [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
"..."
  FilePath
msg <- IO FilePath -> DbMonadT IO FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> DbMonadT IO FilePath)
-> IO FilePath -> DbMonadT IO FilePath
forall a b. (a -> b) -> a -> b
$ case Maybe Int
mw of
    Maybe Int
Nothing -> Handle -> FilePath -> IO ()
hPutStrLn Handle
hndl FilePath
"" IO () -> IO FilePath -> IO FilePath
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
msg'
    Just Int
w -> do
      Handle -> FilePath -> IO ()
hPutStr Handle
hndl (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Char -> FilePath
forall a. Int -> a -> [a]
replicate Int
w Char
' '
      Handle -> FilePath -> IO ()
hPutStr Handle
hndl FilePath
"\r"
      FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
8) (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
msg'
  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
$ Handle -> FilePath -> IO ()
hPutStr Handle
hndl FilePath
msg
  Bool
x <- FilePath -> DbMonad Bool
act FilePath
f
  if Bool
x
  then 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
$ Handle -> FilePath -> IO ()
hPutStr Handle
hndl FilePath
" done\r"
  else 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
$ Handle -> FilePath -> IO ()
hPutStr Handle
hndl FilePath
" skipped\r"
  Bool -> DbMonad Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
x

doIndex :: HieDb -> Options -> Handle -> [FilePath] -> IO ()
doIndex :: HieDb -> Options -> Handle -> [FilePath] -> IO ()
doIndex HieDb
_ Options
opts Handle
_ [] | Options -> Bool
reindex Options
opts = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
doIndex HieDb
conn Options
opts Handle
h [FilePath]
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
-> (FilePath -> DbMonad Bool)
-> FilePath
-> DbMonad Bool
progress' = if Options -> Bool
quiet Options
opts then (\Handle
_ Int
_ Int
_ FilePath -> DbMonad Bool
k -> FilePath -> DbMonad Bool
k) else Handle
-> Int
-> Int
-> (FilePath -> DbMonad Bool)
-> FilePath
-> DbMonad Bool
progress
  IO Seconds
start <- IO (IO Seconds)
offsetTime
  ([Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length -> Int
done, [Bool] -> 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
<$>
    (FilePath -> Int -> DbMonad Bool)
-> [FilePath] -> [Int] -> DbMonadT IO [Bool]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\FilePath
f Int
n -> Handle
-> Int
-> Int
-> (FilePath -> DbMonad Bool)
-> FilePath
-> DbMonad Bool
progress' Handle
h ([FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
files) Int
n (HieDb -> FilePath -> DbMonad Bool
forall (m :: * -> *).
(MonadIO m, NameCacheMonad m) =>
HieDb -> FilePath -> m Bool
addRefsFrom HieDb
conn) FilePath
f) [FilePath]
files [Int
0..]
  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
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 -> FilePath -> IO ()
hPutStrLn Handle
h (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"\nCompleted! (" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
done FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" indexed, " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
skipped FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" skipped in " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Seconds -> FilePath
showDuration Seconds
end FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
")"

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
<>))
  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
    [FilePath]
files' <- (HieModuleRow -> FilePath) -> [HieModuleRow] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map HieModuleRow -> FilePath
hieModuleHieFile ([HieModuleRow] -> [FilePath])
-> IO [HieModuleRow] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HieDb -> IO [HieModuleRow]
getAllIndexedMods HieDb
conn
    [FilePath]
files <- ([Maybe FilePath] -> [FilePath])
-> IO [Maybe FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe FilePath] -> [FilePath]
forall a. [Maybe a] -> [a]
catMaybes (IO [Maybe FilePath] -> IO [FilePath])
-> IO [Maybe FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
-> (FilePath -> IO (Maybe FilePath)) -> IO [Maybe FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
files' ((FilePath -> IO (Maybe FilePath)) -> IO [Maybe FilePath])
-> (FilePath -> IO (Maybe FilePath)) -> IO [Maybe FilePath]
forall a b. (a -> b) -> a -> b
$ \FilePath
f -> do
      Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
f
      if Bool
exists
      then Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
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 -> FilePath -> IO ()
deleteFileFromIndex HieDb
conn FilePath
f
        Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
    let n :: Int
n = [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
files
        orig :: Int
orig = [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
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 -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Re-indexing " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" files, deleting " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
orig) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" files"
    HieDb -> Options -> Handle -> [FilePath] -> IO ()
doIndex HieDb
conn Options
opts Handle
stderr [FilePath]
files
  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
      HieDb -> Options -> Handle -> [FilePath] -> IO ()
doIndex HieDb
conn Options
opts Handle
stderr [FilePath]
files
    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]
findReferences HieDb
conn Bool
False OccName
occ Maybe ModuleName
mn Maybe UnitId
muid []
      Options -> [Res RefRow] -> IO ()
reportRefs Options
opts [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]
findReferences HieDb
conn Bool
False OccName
occ Maybe ModuleName
mn Maybe UnitId
muid []
      Options -> [Res RefRow] -> IO ()
reportRefs Options
opts [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) <- 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 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)
      Options
-> [(Module, (Int, Int), (Int, Int),
     Maybe (Either FilePath 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 FilePath ByteString -> Maybe (Either FilePath ByteString)
forall a. a -> Maybe a
Just (Either FilePath ByteString -> Maybe (Either FilePath ByteString))
-> Either FilePath ByteString -> Maybe (Either FilePath ByteString)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath ByteString
forall a b. a -> Either a b
Left (DefRow -> FilePath
defSrc 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) <- 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 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)
      Options
-> [(Module, (Int, Int), (Int, Int),
     Maybe (Either FilePath 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 FilePath ByteString -> Maybe (Either FilePath ByteString)
forall a. a -> Maybe a
Just (Either FilePath ByteString -> Maybe (Either FilePath ByteString))
-> Either FilePath ByteString -> Maybe (Either FilePath ByteString)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath ByteString
forall a b. a -> Either a b
Left (DefRow -> FilePath
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
        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 <- Options -> Either HieDbErr UnitId -> IO UnitId
forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts (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 -> 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 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
=<< Options -> Either HieDbErr UnitId -> IO UnitId
forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts (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 -> 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 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 -> 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
forall a. HieAST a -> NodeInfo a
nodeInfo
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Name] -> 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 -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unwords [FilePath
"Name", Options -> OccName -> FilePath
ppName Options
opts (Name -> OccName
nameOccName Name
name),FilePath
"at",Options -> (Int, Int) -> FilePath
ppSpan Options
opts (Int, Int)
sp,FilePath
"is used at:"]
          Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr FilePath
""
        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 UnitId
-> [FilePath]
-> 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
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), Maybe (Either a ByteString))]
refs = ((Span, IdentifierDetails Int)
 -> (Module, (Int, Int), (Int, Int), Maybe (Either a ByteString)))
-> [(Span, IdentifierDetails Int)]
-> [(Module, (Int, Int), (Int, Int), Maybe (Either a ByteString))]
forall a b. (a -> b) -> [a] -> [b]
map (Span
-> (Module, (Int, Int), (Int, Int), Maybe (Either a ByteString))
forall a.
Span
-> (Module, (Int, Int), (Int, Int), Maybe (Either a ByteString))
toRef (Span
 -> (Module, (Int, Int), (Int, Int), Maybe (Either a ByteString)))
-> ((Span, IdentifierDetails Int) -> Span)
-> (Span, IdentifierDetails Int)
-> (Module, (Int, Int), (Int, Int), Maybe (Either a ByteString))
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), Maybe (Either a ByteString))])
-> [(Span, IdentifierDetails Int)]
-> [(Module, (Int, Int), (Int, Int), Maybe (Either a ByteString))]
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), Maybe (Either a ByteString))
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)
                            ,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 FilePath ByteString))]
-> IO ()
reportRefSpans Options
opts [(Module, (Int, Int), (Int, Int),
  Maybe (Either FilePath 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
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'
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([HieTypeFix] -> 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
        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 -> 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
forall a. HieAST a -> NodeInfo a
nodeInfo
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Name] -> 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 Span
dsp -> 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 -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unwords [FilePath
"Name", Options -> OccName -> FilePath
ppName Options
opts (Name -> OccName
nameOccName Name
name),FilePath
"at",Options -> (Int, Int) -> FilePath
ppSpan Options
opts (Int, Int)
sp,FilePath
"is defined at:"]
            Maybe (Either FilePath ByteString)
contents <- case Name -> Maybe Module
nameModule_maybe Name
name of
              Maybe Module
Nothing -> Maybe (Either FilePath ByteString)
-> IO (Maybe (Either FilePath ByteString))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Either FilePath ByteString)
 -> IO (Maybe (Either FilePath ByteString)))
-> Maybe (Either FilePath ByteString)
-> IO (Maybe (Either FilePath ByteString))
forall a b. (a -> b) -> a -> b
$ Either FilePath ByteString -> Maybe (Either FilePath ByteString)
forall a. a -> Maybe a
Just (Either FilePath ByteString -> Maybe (Either FilePath ByteString))
-> Either FilePath ByteString -> Maybe (Either FilePath ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either FilePath ByteString
forall a b. b -> Either a b
Right (ByteString -> Either FilePath ByteString)
-> ByteString -> Either FilePath 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 FilePath ByteString)
-> IO (Maybe (Either FilePath ByteString))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Either FilePath ByteString)
 -> IO (Maybe (Either FilePath ByteString)))
-> Maybe (Either FilePath ByteString)
-> IO (Maybe (Either FilePath ByteString))
forall a b. (a -> b) -> a -> b
$ Either FilePath ByteString -> Maybe (Either FilePath ByteString)
forall a. a -> Maybe a
Just (Either FilePath ByteString -> Maybe (Either FilePath ByteString))
-> Either FilePath ByteString -> Maybe (Either FilePath ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either FilePath ByteString
forall a b. b -> Either a b
Right (ByteString -> Either FilePath ByteString)
-> ByteString -> Either FilePath ByteString
forall a b. (a -> b) -> a -> b
$ HieFile -> ByteString
hie_hs_src HieFile
hf
                | Bool
otherwise -> IO (Maybe (Either FilePath ByteString))
-> IO (Maybe (Either FilePath ByteString))
forall a. IO a -> IO a
unsafeInterleaveIO (IO (Maybe (Either FilePath ByteString))
 -> IO (Maybe (Either FilePath ByteString)))
-> IO (Maybe (Either FilePath ByteString))
-> IO (Maybe (Either FilePath ByteString))
forall a b. (a -> b) -> a -> b
$ do
                    Either HieDbErr (DefRow :. ModuleInfo)
loc <- 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)
                    Maybe (Either FilePath ByteString)
-> IO (Maybe (Either FilePath ByteString))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Either FilePath ByteString)
 -> IO (Maybe (Either FilePath ByteString)))
-> Maybe (Either FilePath ByteString)
-> IO (Maybe (Either FilePath ByteString))
forall a b. (a -> b) -> a -> b
$ case Either HieDbErr (DefRow :. ModuleInfo)
loc of
                      Left HieDbErr
_ -> Maybe (Either FilePath ByteString)
forall a. Maybe a
Nothing
                      Right (DefRow
row:.ModuleInfo
_) -> Either FilePath ByteString -> Maybe (Either FilePath ByteString)
forall a. a -> Maybe a
Just (Either FilePath ByteString -> Maybe (Either FilePath ByteString))
-> Either FilePath ByteString -> Maybe (Either FilePath ByteString)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath ByteString
forall a b. a -> Either a b
Left (FilePath -> Either FilePath ByteString)
-> FilePath -> Either FilePath ByteString
forall a b. (a -> b) -> a -> b
$ DefRow -> FilePath
defSrc DefRow
row

            Options
-> [(Module, (Int, Int), (Int, Int),
     Maybe (Either FilePath 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)
               ,(Span -> Int
srcSpanStartLine Span
dsp,Span -> Int
srcSpanStartCol Span
dsp)
               ,(Span -> Int
srcSpanEndLine Span
dsp, Span -> Int
srcSpanEndCol Span
dsp)
               ,Maybe (Either FilePath ByteString)
contents
               )]
          UnhelpfulSpan FastString
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 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)
                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 -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unwords [FilePath
"Name", Options -> OccName -> FilePath
ppName Options
opts (Name -> OccName
nameOccName Name
name),FilePath
"at",Options -> (Int, Int) -> FilePath
ppSpan Options
opts (Int, Int)
sp,FilePath
"is defined at:"]
                Options
-> [(Module, (Int, Int), (Int, Int),
     Maybe (Either FilePath ByteString))]
-> IO ()
reportRefSpans Options
opts
                  [(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)
                   ,Either FilePath ByteString -> Maybe (Either FilePath ByteString)
forall a. a -> Maybe a
Just (Either FilePath ByteString -> Maybe (Either FilePath ByteString))
-> Either FilePath ByteString -> Maybe (Either FilePath ByteString)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath ByteString
forall a b. a -> Either a b
Left (FilePath -> Either FilePath ByteString)
-> FilePath -> Either FilePath ByteString
forall a b. (a -> b) -> a -> b
$ DefRow -> FilePath
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 -> FilePath -> HieDbErr
NameUnhelpfulSpan Name
name (FastString -> FilePath
FS.unpackFS FastString
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, Span) -> IO ())
-> [(NodeInfo IfaceType, Span)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((NodeInfo IfaceType -> Span -> IO ())
-> (NodeInfo IfaceType, Span) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((NodeInfo IfaceType -> Span -> IO ())
 -> (NodeInfo IfaceType, Span) -> IO ())
-> (NodeInfo IfaceType -> Span -> IO ())
-> (NodeInfo IfaceType, Span)
-> IO ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> NodeInfo IfaceType -> Span -> IO ()
printInfo DynFlags
dynFlags) ([(NodeInfo IfaceType, Span)] -> IO ())
-> [(NodeInfo IfaceType, Span)] -> IO ()
forall a b. (a -> b) -> a -> b
$ HieFile
-> (Int, Int)
-> Maybe (Int, Int)
-> (HieAST Int -> (NodeInfo IfaceType, Span))
-> [(NodeInfo IfaceType, 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 IfaceType, Span))
 -> [(NodeInfo IfaceType, Span)])
-> (HieAST Int -> (NodeInfo IfaceType, Span))
-> [(NodeInfo IfaceType, Span)]
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
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
    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 -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"GCed " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" types in " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Seconds -> FilePath
showDuration Seconds
end

printInfo :: DynFlags -> NodeInfo IfaceType -> RealSrcSpan -> IO ()
printInfo :: DynFlags -> NodeInfo IfaceType -> Span -> IO ()
printInfo DynFlags
dynFlags NodeInfo IfaceType
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 IfaceType -> Set (FastString, FastString)
forall a. NodeInfo a -> Set (FastString, FastString)
nodeAnnotations NodeInfo IfaceType
x)
  FilePath -> IO ()
putStrLn FilePath
"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 -> 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 IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IdentifierDetails IfaceType
inf)
  FilePath -> IO ()
putStrLn FilePath
"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
    FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> SDoc -> FilePath
showSDoc DynFlags
dynFlags (IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
typ)
  FilePath -> IO ()
putStrLn FilePath
""

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

showHieDbErr :: Options -> HieDbErr -> String
showHieDbErr :: Options -> HieDbErr -> FilePath
showHieDbErr Options
opts HieDbErr
e = case HieDbErr
e of
  NoNameAtPoint HieTarget
t (Int, Int)
spn -> [FilePath] -> FilePath
unwords [FilePath
"No symbols found at",Options -> (Int, Int) -> FilePath
ppSpan Options
opts (Int, Int)
spn,FilePath
"in",(FilePath -> FilePath)
-> ((ModuleName, Maybe UnitId) -> FilePath)
-> HieTarget
-> FilePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> FilePath
forall a. a -> a
id (\(ModuleName
mn,Maybe UnitId
muid) -> Options -> ModuleName -> FilePath
ppMod Options
opts 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]
++Options -> UnitId -> FilePath
ppUnit Options
opts UnitId
uidFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
")") Maybe UnitId
muid) HieTarget
t]
  NotIndexed ModuleName
mn Maybe UnitId
muid -> [FilePath] -> FilePath
unwords [FilePath
"Module", Options -> ModuleName -> FilePath
ppMod Options
opts 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]
++Options -> UnitId -> FilePath
ppUnit Options
opts 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:", Options -> OccName -> FilePath
ppName Options
opts 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]
++Options -> UnitId -> FilePath
ppUnit Options
opts 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 :: Options -> [(Module,(Int,Int),(Int,Int),Maybe (Either FilePath BS.ByteString))] -> IO ()
reportRefSpans :: Options
-> [(Module, (Int, Int), (Int, Int),
     Maybe (Either FilePath ByteString))]
-> IO ()
reportRefSpans Options
opts [(Module, (Int, Int), (Int, Int),
  Maybe (Either FilePath 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 FilePath ByteString))]
-> ((Module, (Int, Int), (Int, Int),
     Maybe (Either FilePath 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 FilePath ByteString))]
xs (((Module, (Int, Int), (Int, Int),
   Maybe (Either FilePath ByteString))
  -> DbMonadT IO ())
 -> DbMonadT IO ())
-> ((Module, (Int, Int), (Int, Int),
     Maybe (Either FilePath ByteString))
    -> DbMonadT IO ())
-> DbMonadT IO ()
forall a b. (a -> b) -> a -> b
$ \(Module
mn,(Int
sl,Int
sc),(Int
el,Int
ec),Maybe (Either FilePath ByteString)
hie_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
$ 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]
        FilePath -> IO ()
putStr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ Options -> ModuleName -> FilePath
ppMod Options
opts (ModuleName -> FilePath) -> ModuleName -> FilePath
forall a b. (a -> b) -> a -> b
$ Module -> 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]
        FilePath -> IO ()
putStr FilePath
":"
        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]
        FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ Color -> (FilePath -> FilePath) -> Options -> FilePath -> FilePath
forall a. Color -> (a -> FilePath) -> Options -> a -> FilePath
colouredPP Color
Magenta FilePath -> FilePath
forall a. a -> a
id Options
opts (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ 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
          ]
        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 (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 FilePath ByteString)
-> (Either FilePath 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 FilePath ByteString)
hie_f ((Either FilePath ByteString -> DbMonadT IO ByteString)
 -> DbMonadT IO (Maybe ByteString))
-> (Either FilePath ByteString -> DbMonadT IO ByteString)
-> DbMonadT IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \case
            Left FilePath
loc -> FilePath
-> (HieFile -> DbMonadT IO ByteString) -> DbMonadT IO ByteString
forall (m :: * -> *) a.
(NameCacheMonad m, MonadIO m) =>
FilePath -> (HieFile -> m a) -> m a
withHieFile FilePath
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 (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 (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
src
          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
$ case Maybe ByteString
msrc of
            Maybe ByteString
Nothing -> FilePath -> IO ()
putStrLn FilePath
"<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] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ [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. [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 FilePath 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 FilePath ByteString -> Maybe (Either FilePath ByteString)
forall a. a -> Maybe a
Just (Either FilePath ByteString -> Maybe (Either FilePath ByteString))
-> Either FilePath ByteString -> Maybe (Either FilePath ByteString)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath ByteString
forall a b. a -> Either a b
Left (FilePath -> Either FilePath ByteString)
-> FilePath -> Either FilePath ByteString
forall a b. (a -> b) -> a -> b
$ RefRow -> FilePath
refSrc 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)
  ]

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


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

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

ppUnit :: Options -> UnitId -> String
ppUnit :: Options -> UnitId -> FilePath
ppUnit = Color -> (UnitId -> FilePath) -> Options -> UnitId -> FilePath
forall a. Color -> (a -> FilePath) -> Options -> a -> FilePath
colouredPP Color
Yellow UnitId -> FilePath
forall a. Show a => a -> FilePath
show

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