{-# LANGUAGE FlexibleInstances, TypeOperators, TypeApplications, OverloadedStrings #-}

module HsDev.Scan (
	-- * Enumerate functions
	CompileFlag, ModuleToScan, ProjectToScan, PackageDbToScan, ScanContents(..),
	EnumContents(..),
	enumRescan, enumDependent, enumProject, enumSandbox, enumDirectory,

	-- * Scan
	scanProjectFile,
	scanModify,
	upToDate, changedModules,
	getFileContents,

	-- * Reexportss
	module HsDev.Symbols.Types,
	module Control.Monad.Except,
	) where

import Control.DeepSeq
import Control.Lens
import Control.Monad.Except
import Data.Deps
import Data.Maybe (catMaybes, isJust, listToMaybe)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.List (intercalate)
import Data.Text (Text)
import Data.Text.Lens (unpacked)
import qualified Data.Text as T
import Data.Time.Clock.POSIX (POSIXTime)
import Data.Traversable (for)
import Data.Semigroup
import Data.String (IsString, fromString)
import qualified Data.Set as S
import System.Directory
import Text.Format
import qualified System.Log.Simple as Log

import HsDev.Error
import qualified HsDev.Database.SQLite as SQLite
import HsDev.Database.SQLite.Select
import HsDev.Scan.Browse (browsePackages)
import HsDev.Server.Types (FileSource(..), SessionMonad(..), CommandMonad(..), inSessionGhc, postSessionUpdater)
import HsDev.Sandbox
import HsDev.Symbols
import HsDev.Symbols.Types
import HsDev.Display
import HsDev.Inspect
import HsDev.Util
import System.Directory.Paths

-- | Compile flags
type CompileFlag = String
-- | Module with flags ready to scan
type ModuleToScan = (ModuleLocation, [CompileFlag], Maybe Text)
-- | Project ready to scan
type ProjectToScan = (Project, [ModuleToScan])
-- | Package-db sandbox to scan (top of stack)
type PackageDbToScan = PackageDbStack

-- | Scan info
data ScanContents = ScanContents {
	ScanContents -> [ModuleToScan]
modulesToScan :: [ModuleToScan],
	ScanContents -> [ProjectToScan]
projectsToScan :: [ProjectToScan],
	ScanContents -> [PackageDbStack]
sandboxesToScan :: [PackageDbStack] }

instance NFData ScanContents where
	rnf :: ScanContents -> ()
rnf (ScanContents [ModuleToScan]
ms [ProjectToScan]
ps [PackageDbStack]
ss) = [ModuleToScan] -> ()
forall a. NFData a => a -> ()
rnf [ModuleToScan]
ms () -> () -> ()
`seq` [ProjectToScan] -> ()
forall a. NFData a => a -> ()
rnf [ProjectToScan]
ps () -> () -> ()
`seq` [PackageDbStack] -> ()
forall a. NFData a => a -> ()
rnf [PackageDbStack]
ss

instance Semigroup ScanContents where
	ScanContents [ModuleToScan]
lm [ProjectToScan]
lp [PackageDbStack]
ls <> :: ScanContents -> ScanContents -> ScanContents
<> ScanContents [ModuleToScan]
rm [ProjectToScan]
rp [PackageDbStack]
rs = [ModuleToScan]
-> [ProjectToScan] -> [PackageDbStack] -> ScanContents
ScanContents
		((ModuleToScan -> ModuleLocation)
-> [ModuleToScan] -> [ModuleToScan]
forall b a. Ord b => (a -> b) -> [a] -> [a]
uniqueBy (Getting ModuleLocation ModuleToScan ModuleLocation
-> ModuleToScan -> ModuleLocation
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ModuleLocation ModuleToScan ModuleLocation
forall s t a b. Field1 s t a b => Lens s t a b
_1) ([ModuleToScan] -> [ModuleToScan])
-> [ModuleToScan] -> [ModuleToScan]
forall a b. (a -> b) -> a -> b
$ [ModuleToScan]
lm [ModuleToScan] -> [ModuleToScan] -> [ModuleToScan]
forall a. [a] -> [a] -> [a]
++ [ModuleToScan]
rm)
		((ProjectToScan -> Project) -> [ProjectToScan] -> [ProjectToScan]
forall b a. Ord b => (a -> b) -> [a] -> [a]
uniqueBy (Getting Project ProjectToScan Project -> ProjectToScan -> Project
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Project ProjectToScan Project
forall s t a b. Field1 s t a b => Lens s t a b
_1) ([ProjectToScan] -> [ProjectToScan])
-> [ProjectToScan] -> [ProjectToScan]
forall a b. (a -> b) -> a -> b
$ [ProjectToScan]
lp [ProjectToScan] -> [ProjectToScan] -> [ProjectToScan]
forall a. [a] -> [a] -> [a]
++ [ProjectToScan]
rp)
		([PackageDbStack] -> [PackageDbStack]
forall a. Ord a => [a] -> [a]
ordNub ([PackageDbStack] -> [PackageDbStack])
-> [PackageDbStack] -> [PackageDbStack]
forall a b. (a -> b) -> a -> b
$ [PackageDbStack]
ls [PackageDbStack] -> [PackageDbStack] -> [PackageDbStack]
forall a. [a] -> [a] -> [a]
++ [PackageDbStack]
rs)

instance Monoid ScanContents where
	mempty :: ScanContents
mempty = [ModuleToScan]
-> [ProjectToScan] -> [PackageDbStack] -> ScanContents
ScanContents [] [] []
	mappend :: ScanContents -> ScanContents -> ScanContents
mappend ScanContents
l ScanContents
r = ScanContents
l ScanContents -> ScanContents -> ScanContents
forall a. Semigroup a => a -> a -> a
<> ScanContents
r

instance Formattable ScanContents where
	formattable :: ScanContents -> FormatFlags -> Formatted
formattable (ScanContents [ModuleToScan]
ms [ProjectToScan]
ps [PackageDbStack]
cs) = String -> FormatFlags -> Formatted
forall a. Formattable a => a -> FormatFlags -> Formatted
formattable String
str where
		str :: String
		str :: String
str = String -> Format
forall r. FormatResult r => String -> r
format String
"modules: {}, projects: {}, package-dbs: {}"
			Format -> Text -> Format
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ (Text -> [Text] -> Text
T.intercalate Text
forall s. IsString s => s
comma ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [ModuleToScan]
ms [ModuleToScan]
-> Getting (Endo [Text]) [ModuleToScan] Text -> [Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (ModuleToScan -> Const (Endo [Text]) ModuleToScan)
-> [ModuleToScan] -> Const (Endo [Text]) [ModuleToScan]
forall s t a b. Each s t a b => Traversal s t a b
each ((ModuleToScan -> Const (Endo [Text]) ModuleToScan)
 -> [ModuleToScan] -> Const (Endo [Text]) [ModuleToScan])
-> ((Text -> Const (Endo [Text]) Text)
    -> ModuleToScan -> Const (Endo [Text]) ModuleToScan)
-> Getting (Endo [Text]) [ModuleToScan] Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleLocation -> Const (Endo [Text]) ModuleLocation)
-> ModuleToScan -> Const (Endo [Text]) ModuleToScan
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((ModuleLocation -> Const (Endo [Text]) ModuleLocation)
 -> ModuleToScan -> Const (Endo [Text]) ModuleToScan)
-> ((Text -> Const (Endo [Text]) Text)
    -> ModuleLocation -> Const (Endo [Text]) ModuleLocation)
-> (Text -> Const (Endo [Text]) Text)
-> ModuleToScan
-> Const (Endo [Text]) ModuleToScan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (Endo [Text]) Text)
-> ModuleLocation -> Const (Endo [Text]) ModuleLocation
Traversal' ModuleLocation Text
moduleFile)
			Format -> Text -> Format
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ (Text -> [Text] -> Text
T.intercalate Text
forall s. IsString s => s
comma ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [ProjectToScan]
ps [ProjectToScan]
-> Getting (Endo [Text]) [ProjectToScan] Text -> [Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (ProjectToScan -> Const (Endo [Text]) ProjectToScan)
-> [ProjectToScan] -> Const (Endo [Text]) [ProjectToScan]
forall s t a b. Each s t a b => Traversal s t a b
each ((ProjectToScan -> Const (Endo [Text]) ProjectToScan)
 -> [ProjectToScan] -> Const (Endo [Text]) [ProjectToScan])
-> ((Text -> Const (Endo [Text]) Text)
    -> ProjectToScan -> Const (Endo [Text]) ProjectToScan)
-> Getting (Endo [Text]) [ProjectToScan] Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Project -> Const (Endo [Text]) Project)
-> ProjectToScan -> Const (Endo [Text]) ProjectToScan
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((Project -> Const (Endo [Text]) Project)
 -> ProjectToScan -> Const (Endo [Text]) ProjectToScan)
-> ((Text -> Const (Endo [Text]) Text)
    -> Project -> Const (Endo [Text]) Project)
-> (Text -> Const (Endo [Text]) Text)
-> ProjectToScan
-> Const (Endo [Text]) ProjectToScan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (Endo [Text]) Text)
-> Project -> Const (Endo [Text]) Project
Lens' Project Text
projectPath)
			Format -> String -> String
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ (String -> FormatFlags -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
forall s. IsString s => s
comma (FormatFlags -> String) -> FormatFlags -> String
forall a b. (a -> b) -> a -> b
$ (PackageDbStack -> String) -> [PackageDbStack] -> FormatFlags
forall a b. (a -> b) -> [a] -> [b]
map (PackageDb -> String
forall a. Display a => a -> String
display (PackageDb -> String)
-> (PackageDbStack -> PackageDb) -> PackageDbStack -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDbStack -> PackageDb
topPackageDb) ([PackageDbStack] -> FormatFlags)
-> [PackageDbStack] -> FormatFlags
forall a b. (a -> b) -> a -> b
$ [PackageDbStack]
cs [PackageDbStack]
-> Getting (Endo [PackageDbStack]) [PackageDbStack] PackageDbStack
-> [PackageDbStack]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [PackageDbStack]) [PackageDbStack] PackageDbStack
forall s t a b. Each s t a b => Traversal s t a b
each)
		comma :: IsString s => s
		comma :: s
comma = String -> s
forall a. IsString a => String -> a
fromString String
", "

class EnumContents a where
	enumContents :: CommandMonad m => a -> m ScanContents

instance EnumContents ModuleLocation where
	enumContents :: ModuleLocation -> m ScanContents
enumContents ModuleLocation
mloc = ScanContents -> m ScanContents
forall (m :: * -> *) a. Monad m => a -> m a
return (ScanContents -> m ScanContents) -> ScanContents -> m ScanContents
forall a b. (a -> b) -> a -> b
$ [ModuleToScan]
-> [ProjectToScan] -> [PackageDbStack] -> ScanContents
ScanContents [(ModuleLocation
mloc, [], Maybe Text
forall a. Maybe a
Nothing)] [] []

instance EnumContents (Extensions ModuleLocation) where
	enumContents :: Extensions ModuleLocation -> m ScanContents
enumContents Extensions ModuleLocation
ex = ScanContents -> m ScanContents
forall (m :: * -> *) a. Monad m => a -> m a
return (ScanContents -> m ScanContents) -> ScanContents -> m ScanContents
forall a b. (a -> b) -> a -> b
$ [ModuleToScan]
-> [ProjectToScan] -> [PackageDbStack] -> ScanContents
ScanContents [(Getting ModuleLocation (Extensions ModuleLocation) ModuleLocation
-> Extensions ModuleLocation -> ModuleLocation
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ModuleLocation (Extensions ModuleLocation) ModuleLocation
forall a1 a2. Lens (Extensions a1) (Extensions a2) a1 a2
entity Extensions ModuleLocation
ex, Extensions ModuleLocation -> FormatFlags
forall a. Extensions a -> FormatFlags
extensionsOpts Extensions ModuleLocation
ex, Maybe Text
forall a. Maybe a
Nothing)] [] []

instance EnumContents Project where
	enumContents :: Project -> m ScanContents
enumContents = Project -> m ScanContents
forall (m :: * -> *). CommandMonad m => Project -> m ScanContents
enumProject

instance EnumContents PackageDbStack where
	enumContents :: PackageDbStack -> m ScanContents
enumContents PackageDbStack
pdbs = ScanContents -> m ScanContents
forall (m :: * -> *) a. Monad m => a -> m a
return (ScanContents -> m ScanContents) -> ScanContents -> m ScanContents
forall a b. (a -> b) -> a -> b
$ [ModuleToScan]
-> [ProjectToScan] -> [PackageDbStack] -> ScanContents
ScanContents [] [] (PackageDbStack -> [PackageDbStack]
packageDbStacks PackageDbStack
pdbs)

instance EnumContents Sandbox where
	enumContents :: Sandbox -> m ScanContents
enumContents = Sandbox -> m ScanContents
forall (m :: * -> *). CommandMonad m => Sandbox -> m ScanContents
enumSandbox

instance {-# OVERLAPPABLE #-} EnumContents a => EnumContents [a] where
	enumContents :: [a] -> m ScanContents
enumContents = ([ScanContents] -> ScanContents)
-> m [ScanContents] -> m ScanContents
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [ScanContents] -> ScanContents
forall a. Monoid a => [a] -> a
mconcat (m [ScanContents] -> m ScanContents)
-> ([a] -> m [ScanContents]) -> [a] -> m ScanContents
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [m ScanContents] -> m [ScanContents]
forall (m :: * -> *) a. MonadPlus m => [m a] -> m [a]
tries ([m ScanContents] -> m [ScanContents])
-> ([a] -> [m ScanContents]) -> [a] -> m [ScanContents]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m ScanContents) -> [a] -> [m ScanContents]
forall a b. (a -> b) -> [a] -> [b]
map a -> m ScanContents
forall a (m :: * -> *).
(EnumContents a, CommandMonad m) =>
a -> m ScanContents
enumContents

instance {-# OVERLAPPING #-} EnumContents FilePath where
	enumContents :: String -> m ScanContents
enumContents String
f
		| String -> Bool
haskellSource String
f = m ScanContents -> m ScanContents
forall (m :: * -> *) a. MonadCatch m => m a -> m a
hsdevLiftIO (m ScanContents -> m ScanContents)
-> m ScanContents -> m ScanContents
forall a b. (a -> b) -> a -> b
$ do
			Maybe Project
mproj <- IO (Maybe Project) -> m (Maybe Project)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Project) -> m (Maybe Project))
-> IO (Maybe Project) -> m (Maybe Project)
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe Project)
locateProject String
f
			case Maybe Project
mproj of
				Maybe Project
Nothing -> ModuleLocation -> m ScanContents
forall a (m :: * -> *).
(EnumContents a, CommandMonad m) =>
a -> m ScanContents
enumContents (ModuleLocation -> m ScanContents)
-> ModuleLocation -> m ScanContents
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Project -> ModuleLocation
FileModule (String -> Text
fromFilePath String
f) Maybe Project
forall a. Maybe a
Nothing
				Just Project
proj -> do
					ScanContents [ModuleToScan]
_ [(Project
_, [ModuleToScan]
mods)] [PackageDbStack]
_ <- Project -> m ScanContents
forall a (m :: * -> *).
(EnumContents a, CommandMonad m) =>
a -> m ScanContents
enumContents Project
proj
					ScanContents -> m ScanContents
forall (m :: * -> *) a. Monad m => a -> m a
return (ScanContents -> m ScanContents) -> ScanContents -> m ScanContents
forall a b. (a -> b) -> a -> b
$ [ModuleToScan]
-> [ProjectToScan] -> [PackageDbStack] -> ScanContents
ScanContents ((ModuleToScan -> Bool) -> [ModuleToScan] -> [ModuleToScan]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
f) (Maybe String -> Bool)
-> (ModuleToScan -> Maybe String) -> ModuleToScan -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First String) ModuleToScan String
-> ModuleToScan -> Maybe String
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((ModuleLocation -> Const (First String) ModuleLocation)
-> ModuleToScan -> Const (First String) ModuleToScan
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((ModuleLocation -> Const (First String) ModuleLocation)
 -> ModuleToScan -> Const (First String) ModuleToScan)
-> ((String -> Const (First String) String)
    -> ModuleLocation -> Const (First String) ModuleLocation)
-> Getting (First String) ModuleToScan String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First String) Text)
-> ModuleLocation -> Const (First String) ModuleLocation
Traversal' ModuleLocation Text
moduleFile ((Text -> Const (First String) Text)
 -> ModuleLocation -> Const (First String) ModuleLocation)
-> ((String -> Const (First String) String)
    -> Text -> Const (First String) Text)
-> (String -> Const (First String) String)
-> ModuleLocation
-> Const (First String) ModuleLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Const (First String) String)
-> Text -> Const (First String) Text
Lens' Text String
path)) [ModuleToScan]
mods) [] []
		| Bool
otherwise = String -> m ScanContents
forall (m :: * -> *). CommandMonad m => String -> m ScanContents
enumDirectory String
f

instance {-# OVERLAPPING #-} EnumContents Path where
	enumContents :: Text -> m ScanContents
enumContents = String -> m ScanContents
forall a (m :: * -> *).
(EnumContents a, CommandMonad m) =>
a -> m ScanContents
enumContents (String -> m ScanContents)
-> (Text -> String) -> Text -> m ScanContents
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting String Text String -> Text -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String Text String
Lens' Text String
path

instance EnumContents FileSource where
	enumContents :: FileSource -> m ScanContents
enumContents (FileSource Text
f Maybe Text
mcts)
		| String -> Bool
haskellSource (Getting String Text String -> Text -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String Text String
Lens' Text String
path Text
f) = do
			ScanContents [(ModuleLocation
m, FormatFlags
opts, Maybe Text
_)] [ProjectToScan]
_ [PackageDbStack]
_ <- Text -> m ScanContents
forall a (m :: * -> *).
(EnumContents a, CommandMonad m) =>
a -> m ScanContents
enumContents Text
f
			ScanContents -> m ScanContents
forall (m :: * -> *) a. Monad m => a -> m a
return (ScanContents -> m ScanContents) -> ScanContents -> m ScanContents
forall a b. (a -> b) -> a -> b
$ [ModuleToScan]
-> [ProjectToScan] -> [PackageDbStack] -> ScanContents
ScanContents [(ModuleLocation
m, FormatFlags
opts, Maybe Text
mcts)] [] []
		| Bool
otherwise = ScanContents -> m ScanContents
forall (m :: * -> *) a. Monad m => a -> m a
return ScanContents
forall a. Monoid a => a
mempty

-- | Enum rescannable (i.e. already scanned) file
enumRescan :: CommandMonad m => FilePath -> m ScanContents
enumRescan :: String -> m ScanContents
enumRescan String
fpath = Text -> m ScanContents -> m ScanContents
forall (m :: * -> *) a.
(MonadLog m, HasCallStack) =>
Text -> m a -> m a
Log.scope Text
"enum-rescan" (m ScanContents -> m ScanContents)
-> m ScanContents -> m ScanContents
forall a b. (a -> b) -> a -> b
$ do
	[ModuleLocation :. Inspection]
ms <- Query -> Only String -> m [ModuleLocation :. Inspection]
forall q r (m :: * -> *).
(ToRow q, FromRow r, SessionMonad m) =>
Query -> q -> m [r]
SQLite.query @_ @(ModuleLocation SQLite.:. Inspection)
		(Select Text -> Query
toQuery (Select Text -> Query) -> Select Text -> Query
forall a b. (a -> b) -> a -> b
$ [Select Text] -> Select Text
forall a. Monoid a => [a] -> a
mconcat [
			Text -> Select Text
qModuleLocation Text
"ml",
			[Text] -> Select Text
forall a. [a] -> Select a
select_ [Text
"ml.inspection_time", Text
"ml.inspection_opts"],
			[Text] -> Select Text
forall a. [a] -> Select a
where_ [Text
"ml.file == ?"]])
		(String -> Only String
forall a. a -> Only a
SQLite.Only String
fpath)
	case [ModuleLocation :. Inspection]
ms of
		[] -> do
			Level -> Text -> m ()
forall (m :: * -> *). MonadLog m => Level -> Text -> m ()
Log.sendLog Level
Log.Warning (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Format
"file {} not found" Format -> String -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ String
fpath
			ScanContents -> m ScanContents
forall (m :: * -> *) a. Monad m => a -> m a
return ScanContents
forall a. Monoid a => a
mempty
		((ModuleLocation
mloc SQLite.:. Inspection
insp):[ModuleLocation :. Inspection]
_) -> do
			Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([ModuleLocation :. Inspection] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ModuleLocation :. Inspection]
ms Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Level -> Text -> m ()
forall (m :: * -> *). MonadLog m => Level -> Text -> m ()
Log.sendLog Level
Log.Warning (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Format
"several modules with file == {} found, taking first one" Format -> String -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ String
fpath
			ScanContents -> m ScanContents
forall (m :: * -> *) a. Monad m => a -> m a
return (ScanContents -> m ScanContents) -> ScanContents -> m ScanContents
forall a b. (a -> b) -> a -> b
$ [ModuleToScan]
-> [ProjectToScan] -> [PackageDbStack] -> ScanContents
ScanContents [(ModuleLocation
mloc, Inspection
insp Inspection
-> Getting (Endo FormatFlags) Inspection String -> FormatFlags
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. ([Text] -> Const (Endo FormatFlags) [Text])
-> Inspection -> Const (Endo FormatFlags) Inspection
Traversal' Inspection [Text]
inspectionOpts (([Text] -> Const (Endo FormatFlags) [Text])
 -> Inspection -> Const (Endo FormatFlags) Inspection)
-> ((String -> Const (Endo FormatFlags) String)
    -> [Text] -> Const (Endo FormatFlags) [Text])
-> Getting (Endo FormatFlags) Inspection String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (Endo FormatFlags) Text)
-> [Text] -> Const (Endo FormatFlags) [Text]
forall s t a b. Each s t a b => Traversal s t a b
each ((Text -> Const (Endo FormatFlags) Text)
 -> [Text] -> Const (Endo FormatFlags) [Text])
-> ((String -> Const (Endo FormatFlags) String)
    -> Text -> Const (Endo FormatFlags) Text)
-> (String -> Const (Endo FormatFlags) String)
-> [Text]
-> Const (Endo FormatFlags) [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Const (Endo FormatFlags) String)
-> Text -> Const (Endo FormatFlags) Text
forall t. IsText t => Iso' t String
unpacked, Maybe Text
forall a. Maybe a
Nothing)] [] []

-- | Enum file dependent
enumDependent :: CommandMonad m => FilePath -> m ScanContents
enumDependent :: String -> m ScanContents
enumDependent String
fpath = Text -> m ScanContents -> m ScanContents
forall (m :: * -> *) a.
(MonadLog m, HasCallStack) =>
Text -> m a -> m a
Log.scope Text
"enum-dependent" (m ScanContents -> m ScanContents)
-> m ScanContents -> m ScanContents
forall a b. (a -> b) -> a -> b
$ do
	[ModuleId]
ms <- Query -> Only String -> m [ModuleId]
forall q r (m :: * -> *).
(ToRow q, FromRow r, SessionMonad m) =>
Query -> q -> m [r]
SQLite.query @_ @ModuleId
		(Select Text -> Query
toQuery (Select Text -> Query) -> Select Text -> Query
forall a b. (a -> b) -> a -> b
$ Select Text
qModuleId Select Text -> Select Text -> Select Text
forall a. Monoid a => a -> a -> a
`mappend` [Text] -> Select Text
forall a. [a] -> Select a
where_ [Text
"mu.file == ?"]) (String -> Only String
forall a. a -> Only a
SQLite.Only String
fpath)
	case [ModuleId]
ms of
		[] -> do
			Level -> Text -> m ()
forall (m :: * -> *). MonadLog m => Level -> Text -> m ()
Log.sendLog Level
Log.Warning (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Format
"file {} not found" Format -> String -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ String
fpath
			ScanContents -> m ScanContents
forall (m :: * -> *) a. Monad m => a -> m a
return ScanContents
forall a. Monoid a => a
mempty
		(ModuleId
mid:[ModuleId]
_) -> do
			Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([ModuleId] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ModuleId]
ms Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Level -> Text -> m ()
forall (m :: * -> *). MonadLog m => Level -> Text -> m ()
Log.sendLog Level
Log.Warning (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Format
"several modules with file == {} found, taking first one" Format -> String -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ String
fpath
			let
				mcabal :: Maybe Text
mcabal = ModuleId
mid ModuleId -> Getting (First Text) ModuleId Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModuleLocation -> Const (First Text) ModuleLocation)
-> ModuleId -> Const (First Text) ModuleId
Lens' ModuleId ModuleLocation
moduleLocation ((ModuleLocation -> Const (First Text) ModuleLocation)
 -> ModuleId -> Const (First Text) ModuleId)
-> ((Text -> Const (First Text) Text)
    -> ModuleLocation -> Const (First Text) ModuleLocation)
-> Getting (First Text) ModuleId Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Project -> Const (First Text) (Maybe Project))
-> ModuleLocation -> Const (First Text) ModuleLocation
Traversal' ModuleLocation (Maybe Project)
moduleProject ((Maybe Project -> Const (First Text) (Maybe Project))
 -> ModuleLocation -> Const (First Text) ModuleLocation)
-> ((Text -> Const (First Text) Text)
    -> Maybe Project -> Const (First Text) (Maybe Project))
-> (Text -> Const (First Text) Text)
-> ModuleLocation
-> Const (First Text) ModuleLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Project -> Const (First Text) Project)
-> Maybe Project -> Const (First Text) (Maybe Project)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Project -> Const (First Text) Project)
 -> Maybe Project -> Const (First Text) (Maybe Project))
-> ((Text -> Const (First Text) Text)
    -> Project -> Const (First Text) Project)
-> (Text -> Const (First Text) Text)
-> Maybe Project
-> Const (First Text) (Maybe Project)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> Project -> Const (First Text) Project
Lens' Project Text
projectCabal
			[(Text, Text)]
depList <- Query -> Only (Maybe Text) -> m [(Text, Text)]
forall q r (m :: * -> *).
(ToRow q, FromRow r, SessionMonad m) =>
Query -> q -> m [r]
SQLite.query @_ @(Path, Path) Query
"select d.module_file, d.depends_file from sources_depends as d, projects_modules_scope as ps where ps.cabal is ? and ps.module_id == d.module_id;"
				(Maybe Text -> Only (Maybe Text)
forall a. a -> Only a
SQLite.Only Maybe Text
mcabal)
			let
				rdeps :: Deps Text
rdeps = Deps Text -> Deps Text
forall a. Ord a => Deps a -> Deps a
inverse (Deps Text -> Deps Text)
-> ([(Text, Text)] -> Deps Text) -> [(Text, Text)] -> Deps Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DepsError Text -> Deps Text)
-> (Deps Text -> Deps Text)
-> Either (DepsError Text) (Deps Text)
-> Deps Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Deps Text -> DepsError Text -> Deps Text
forall a b. a -> b -> a
const Deps Text
forall a. Monoid a => a
mempty) Deps Text -> Deps Text
forall a. a -> a
id (Either (DepsError Text) (Deps Text) -> Deps Text)
-> ([(Text, Text)] -> Either (DepsError Text) (Deps Text))
-> [(Text, Text)]
-> Deps Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Deps Text -> Either (DepsError Text) (Deps Text)
forall a. Ord a => Deps a -> Either (DepsError a) (Deps a)
flatten (Deps Text -> Either (DepsError Text) (Deps Text))
-> ([(Text, Text)] -> Deps Text)
-> [(Text, Text)]
-> Either (DepsError Text) (Deps Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Deps Text] -> Deps Text
forall a. Monoid a => [a] -> a
mconcat ([Deps Text] -> Deps Text)
-> ([(Text, Text)] -> [Deps Text]) -> [(Text, Text)] -> Deps Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> Deps Text) -> [(Text, Text)] -> [Deps Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text -> Deps Text) -> (Text, Text) -> Deps Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Text -> Deps Text
forall a. a -> a -> Deps a
dep) ([(Text, Text)] -> Deps Text) -> [(Text, Text)] -> Deps Text
forall a b. (a -> b) -> a -> b
$ [(Text, Text)]
depList
				dependent :: [Text]
dependent = Deps Text
rdeps Deps Text -> Getting [Text] (Deps Text) [Text] -> [Text]
forall s a. s -> Getting a s a -> a
^. Index (Deps Text) -> Traversal' (Deps Text) (IxValue (Deps Text))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (String -> Text
fromFilePath String
fpath)
			([ScanContents] -> ScanContents)
-> m [ScanContents] -> m ScanContents
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [ScanContents] -> ScanContents
forall a. Monoid a => [a] -> a
mconcat (m [ScanContents] -> m ScanContents)
-> m [ScanContents] -> m ScanContents
forall a b. (a -> b) -> a -> b
$ (Text -> m ScanContents) -> [Text] -> m [ScanContents]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String -> m ScanContents
forall (m :: * -> *). CommandMonad m => String -> m ScanContents
enumRescan (String -> m ScanContents)
-> (Text -> String) -> Text -> m ScanContents
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting String Text String -> Text -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String Text String
Lens' Text String
path) [Text]
dependent

-- | Enum project sources
enumProject :: CommandMonad m => Project -> m ScanContents
enumProject :: Project -> m ScanContents
enumProject Project
p = m ScanContents -> m ScanContents
forall (m :: * -> *) a. MonadCatch m => m a -> m a
hsdevLiftIO (m ScanContents -> m ScanContents)
-> m ScanContents -> m ScanContents
forall a b. (a -> b) -> a -> b
$ do
	Project
p' <- IO Project -> m Project
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Project -> m Project) -> IO Project -> m Project
forall a b. (a -> b) -> a -> b
$ Project -> IO Project
loadProject Project
p
	PackageDbStack
pdbs <- GhcM PackageDbStack -> m PackageDbStack
forall (m :: * -> *) a. SessionMonad m => GhcM a -> m a
inSessionGhc (GhcM PackageDbStack -> m PackageDbStack)
-> GhcM PackageDbStack -> m PackageDbStack
forall a b. (a -> b) -> a -> b
$ BuildTool -> Text -> GhcM PackageDbStack
searchPackageDbStack (Getting BuildTool Project BuildTool -> Project -> BuildTool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting BuildTool Project BuildTool
Lens' Project BuildTool
projectBuildTool Project
p') (Getting Text Project Text -> Project -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text Project Text
Lens' Project Text
projectPath Project
p')
	Set Text
pkgs <- GhcM (Set Text) -> m (Set Text)
forall (m :: * -> *) a. SessionMonad m => GhcM a -> m a
inSessionGhc (GhcM (Set Text) -> m (Set Text))
-> GhcM (Set Text) -> m (Set Text)
forall a b. (a -> b) -> a -> b
$ ([PackageConfig] -> Set Text)
-> MGhcT SessionConfig (First DynFlags) (LogT IO) [PackageConfig]
-> GhcM (Set Text)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ([Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList ([Text] -> Set Text)
-> ([PackageConfig] -> [Text]) -> [PackageConfig] -> Set Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PackageConfig -> Text) -> [PackageConfig] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Getting Text PackageConfig Text -> PackageConfig -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((ModulePackage -> Const Text ModulePackage)
-> PackageConfig -> Const Text PackageConfig
Lens' PackageConfig ModulePackage
package ((ModulePackage -> Const Text ModulePackage)
 -> PackageConfig -> Const Text PackageConfig)
-> ((Text -> Const Text Text)
    -> ModulePackage -> Const Text ModulePackage)
-> Getting Text PackageConfig Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text)
-> ModulePackage -> Const Text ModulePackage
Lens' ModulePackage Text
packageName))) (MGhcT SessionConfig (First DynFlags) (LogT IO) [PackageConfig]
 -> GhcM (Set Text))
-> MGhcT SessionConfig (First DynFlags) (LogT IO) [PackageConfig]
-> GhcM (Set Text)
forall a b. (a -> b) -> a -> b
$ FormatFlags
-> PackageDbStack
-> MGhcT SessionConfig (First DynFlags) (LogT IO) [PackageConfig]
browsePackages [] PackageDbStack
pdbs
	let
		projOpts :: Path -> [Text]
		projOpts :: Text -> [Text]
projOpts Text
f = (String -> Text) -> FormatFlags -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
forall a. IsString a => String -> a
fromString (FormatFlags -> [Text]) -> FormatFlags -> [Text]
forall a b. (a -> b) -> a -> b
$ (Info -> FormatFlags) -> [Info] -> FormatFlags
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Info -> FormatFlags
makeOpts ([Info] -> FormatFlags) -> [Info] -> FormatFlags
forall a b. (a -> b) -> a -> b
$ Project -> Text -> [Info]
fileTargets Project
p' Text
f where
			makeOpts :: Info -> [String]
			makeOpts :: Info -> FormatFlags
makeOpts Info
i = [FormatFlags] -> FormatFlags
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
				[String
"-hide-all-packages"],
				[String
"-package " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Getting String Project String -> Project -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Text -> Const String Text) -> Project -> Const String Project
Lens' Project Text
projectName ((Text -> Const String Text) -> Project -> Const String Project)
-> Getting String Text String -> Getting String Project String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting String Text String
Lens' Text String
path) Project
p'],
				[String
"-package " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
dep' | Text
dep' <- Getting [Text] Info [Text] -> Info -> [Text]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Text] Info [Text]
Lens' Info [Text]
infoDepends Info
i, Text
dep' Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Text
pkgs]]
	[Extensions Text]
srcs <- IO [Extensions Text] -> m [Extensions Text]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Extensions Text] -> m [Extensions Text])
-> IO [Extensions Text] -> m [Extensions Text]
forall a b. (a -> b) -> a -> b
$ Project -> IO [Extensions Text]
projectSources Project
p'
	let
		mlocs :: [Extensions ModuleLocation]
mlocs = ASetter
  [Extensions Text]
  [Extensions ModuleLocation]
  (Extensions Text)
  (Extensions ModuleLocation)
-> (Extensions Text -> Extensions ModuleLocation)
-> [Extensions Text]
-> [Extensions ModuleLocation]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  [Extensions Text]
  [Extensions ModuleLocation]
  (Extensions Text)
  (Extensions ModuleLocation)
forall s t a b. Each s t a b => Traversal s t a b
each (\Extensions Text
src -> ASetter
  (Extensions ModuleLocation)
  (Extensions ModuleLocation)
  [Text]
  [Text]
-> ([Text] -> [Text])
-> Extensions ModuleLocation
-> Extensions ModuleLocation
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Extensions ModuleLocation)
  (Extensions ModuleLocation)
  [Text]
  [Text]
forall a1. Lens' (Extensions a1) [Text]
ghcOptions ([Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Text -> [Text]
projOpts (Getting Text (Extensions Text) Text -> Extensions Text -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text (Extensions Text) Text
forall a1 a2. Lens (Extensions a1) (Extensions a2) a1 a2
entity Extensions Text
src)) (Extensions ModuleLocation -> Extensions ModuleLocation)
-> (Extensions Text -> Extensions ModuleLocation)
-> Extensions Text
-> Extensions ModuleLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter
  (Extensions Text) (Extensions ModuleLocation) Text ModuleLocation
-> (Text -> ModuleLocation)
-> Extensions Text
-> Extensions ModuleLocation
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Extensions Text) (Extensions ModuleLocation) Text ModuleLocation
forall a1 a2. Lens (Extensions a1) (Extensions a2) a1 a2
entity (\Text
f -> Text -> Maybe Project -> ModuleLocation
FileModule Text
f (Project -> Maybe Project
forall a. a -> Maybe a
Just Project
p')) (Extensions Text -> Extensions ModuleLocation)
-> Extensions Text -> Extensions ModuleLocation
forall a b. (a -> b) -> a -> b
$ Extensions Text
src) [Extensions Text]
srcs
	[ModuleToScan]
mods <- (ScanContents -> [ModuleToScan])
-> m ScanContents -> m [ModuleToScan]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ScanContents -> [ModuleToScan]
modulesToScan (m ScanContents -> m [ModuleToScan])
-> m ScanContents -> m [ModuleToScan]
forall a b. (a -> b) -> a -> b
$ [Extensions ModuleLocation] -> m ScanContents
forall a (m :: * -> *).
(EnumContents a, CommandMonad m) =>
a -> m ScanContents
enumContents [Extensions ModuleLocation]
mlocs
	ScanContents -> m ScanContents
forall (m :: * -> *) a. Monad m => a -> m a
return (ScanContents -> m ScanContents) -> ScanContents -> m ScanContents
forall a b. (a -> b) -> a -> b
$ [ModuleToScan]
-> [ProjectToScan] -> [PackageDbStack] -> ScanContents
ScanContents [] [(Project
p', [ModuleToScan]
mods)] [] -- (sandboxCabals sboxes)

-- | Enum sandbox
enumSandbox :: CommandMonad m => Sandbox -> m ScanContents
enumSandbox :: Sandbox -> m ScanContents
enumSandbox = (GhcM PackageDbStack -> m PackageDbStack
forall (m :: * -> *) a. SessionMonad m => GhcM a -> m a
inSessionGhc (GhcM PackageDbStack -> m PackageDbStack)
-> (Sandbox -> GhcM PackageDbStack) -> Sandbox -> m PackageDbStack
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sandbox -> GhcM PackageDbStack
sandboxPackageDbStack) (Sandbox -> m PackageDbStack)
-> (PackageDbStack -> m ScanContents) -> Sandbox -> m ScanContents
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> PackageDbStack -> m ScanContents
forall a (m :: * -> *).
(EnumContents a, CommandMonad m) =>
a -> m ScanContents
enumContents

-- | Enum directory modules
enumDirectory :: CommandMonad m => FilePath -> m ScanContents
enumDirectory :: String -> m ScanContents
enumDirectory String
dir = m ScanContents -> m ScanContents
forall (m :: * -> *) a. MonadCatch m => m a -> m a
hsdevLiftIO (m ScanContents -> m ScanContents)
-> m ScanContents -> m ScanContents
forall a b. (a -> b) -> a -> b
$ do
	FormatFlags
cts <- IO FormatFlags -> m FormatFlags
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FormatFlags -> m FormatFlags)
-> IO FormatFlags -> m FormatFlags
forall a b. (a -> b) -> a -> b
$ String -> IO FormatFlags
traverseDirectory String
dir
	let
		projects :: FormatFlags
projects = (String -> Bool) -> FormatFlags -> FormatFlags
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
cabalFile FormatFlags
cts
		sources :: FormatFlags
sources = (String -> Bool) -> FormatFlags -> FormatFlags
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
haskellSource FormatFlags
cts
	FormatFlags
dirs <- IO FormatFlags -> m FormatFlags
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FormatFlags -> m FormatFlags)
-> IO FormatFlags -> m FormatFlags
forall a b. (a -> b) -> a -> b
$ (String -> IO Bool) -> FormatFlags -> IO FormatFlags
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
doesDirectoryExist FormatFlags
cts
	[Sandbox]
sboxes <- ([Maybe Sandbox] -> [Sandbox]) -> m [Maybe Sandbox] -> m [Sandbox]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Maybe Sandbox] -> [Sandbox]
forall a. [Maybe a] -> [a]
catMaybes (m [Maybe Sandbox] -> m [Sandbox])
-> m [Maybe Sandbox] -> m [Sandbox]
forall a b. (a -> b) -> a -> b
$ (String -> m (Maybe Sandbox)) -> FormatFlags -> m [Maybe Sandbox]
forall (m :: * -> *) a b. MonadPlus m => (a -> m b) -> [a] -> m [b]
triesMap (IO (Maybe Sandbox) -> m (Maybe Sandbox)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Sandbox) -> m (Maybe Sandbox))
-> (String -> IO (Maybe Sandbox)) -> String -> m (Maybe Sandbox)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO (Maybe Sandbox)
findSandbox (Text -> IO (Maybe Sandbox))
-> (String -> Text) -> String -> IO (Maybe Sandbox)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
fromFilePath) FormatFlags
dirs
	[ScanContents]
pdbs <- (Sandbox -> m ScanContents) -> [Sandbox] -> m [ScanContents]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Sandbox -> m ScanContents
forall (m :: * -> *). CommandMonad m => Sandbox -> m ScanContents
enumSandbox [Sandbox]
sboxes
	ScanContents
projs <- ([ScanContents] -> ScanContents)
-> m [ScanContents] -> m ScanContents
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [ScanContents] -> ScanContents
forall a. Monoid a => [a] -> a
mconcat (m [ScanContents] -> m ScanContents)
-> m [ScanContents] -> m ScanContents
forall a b. (a -> b) -> a -> b
$ (String -> m ScanContents) -> FormatFlags -> m [ScanContents]
forall (m :: * -> *) a b. MonadPlus m => (a -> m b) -> [a] -> m [b]
triesMap (Project -> m ScanContents
forall (m :: * -> *). CommandMonad m => Project -> m ScanContents
enumProject (Project -> m ScanContents)
-> (String -> Project) -> String -> m ScanContents
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Project
project) FormatFlags
projects
	let
		projPaths :: [Text]
projPaths = (ProjectToScan -> Text) -> [ProjectToScan] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Getting Text Project Text -> Project -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text Project Text
Lens' Project Text
projectPath (Project -> Text)
-> (ProjectToScan -> Project) -> ProjectToScan -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectToScan -> Project
forall a b. (a, b) -> a
fst) ([ProjectToScan] -> [Text]) -> [ProjectToScan] -> [Text]
forall a b. (a -> b) -> a -> b
$ ScanContents -> [ProjectToScan]
projectsToScan ScanContents
projs
		standalone :: [ModuleLocation]
standalone = (Text -> ModuleLocation) -> [Text] -> [ModuleLocation]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Maybe Project -> ModuleLocation
`FileModule` Maybe Project
forall a. Maybe a
Nothing) ([Text] -> [ModuleLocation]) -> [Text] -> [ModuleLocation]
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Text
s -> Bool -> Bool
not ((Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`isParent` Text
s) [Text]
projPaths)) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> FormatFlags -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
fromFilePath FormatFlags
sources
	ScanContents -> m ScanContents
forall (m :: * -> *) a. Monad m => a -> m a
return (ScanContents -> m ScanContents) -> ScanContents -> m ScanContents
forall a b. (a -> b) -> a -> b
$ [ScanContents] -> ScanContents
forall a. Monoid a => [a] -> a
mconcat [
		[ModuleToScan]
-> [ProjectToScan] -> [PackageDbStack] -> ScanContents
ScanContents [(ModuleLocation
s, [], Maybe Text
forall a. Maybe a
Nothing) | ModuleLocation
s <- [ModuleLocation]
standalone] [] [],
		ScanContents
projs,
		[ScanContents] -> ScanContents
forall a. Monoid a => [a] -> a
mconcat [ScanContents]
pdbs]

-- | Scan project file
scanProjectFile :: CommandMonad m => [String] -> Path -> m Project
scanProjectFile :: FormatFlags -> Text -> m Project
scanProjectFile FormatFlags
_ Text
f = m Project -> m Project
forall (m :: * -> *) a. MonadCatch m => m a -> m a
hsdevLiftIO (m Project -> m Project) -> m Project -> m Project
forall a b. (a -> b) -> a -> b
$ do
	Project
proj <- (IO (Maybe Project) -> m (Maybe Project)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Project) -> m (Maybe Project))
-> IO (Maybe Project) -> m (Maybe Project)
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe Project)
locateProject (Getting String Text String -> Text -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String Text String
Lens' Text String
path Text
f)) m (Maybe Project) -> (Maybe Project -> m Project) -> m Project
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m Project -> (Project -> m Project) -> Maybe Project -> m Project
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (HsDevError -> m Project
forall (m :: * -> *) a. MonadThrow m => HsDevError -> m a
hsdevError (HsDevError -> m Project) -> HsDevError -> m Project
forall a b. (a -> b) -> a -> b
$ Text -> HsDevError
FileNotFound Text
f) Project -> m Project
forall (m :: * -> *) a. Monad m => a -> m a
return
	IO Project -> m Project
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Project -> m Project) -> IO Project -> m Project
forall a b. (a -> b) -> a -> b
$ Project -> IO Project
loadProject Project
proj

-- | Scan additional info and modify scanned module
scanModify :: CommandMonad m => ([String] -> Module -> m Module) -> InspectedModule -> m InspectedModule
scanModify :: (FormatFlags -> Module -> m Module)
-> InspectedModule -> m InspectedModule
scanModify FormatFlags -> Module -> m Module
f InspectedModule
im = (Module -> m Module) -> InspectedModule -> m InspectedModule
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Module -> m Module
f' InspectedModule
im where
	f' :: Module -> m Module
f' Module
m = FormatFlags -> Module -> m Module
f (Getting (Endo FormatFlags) InspectedModule String
-> InspectedModule -> FormatFlags
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf ((Inspection -> Const (Endo FormatFlags) Inspection)
-> InspectedModule -> Const (Endo FormatFlags) InspectedModule
forall k t a. Lens' (Inspected k t a) Inspection
inspection ((Inspection -> Const (Endo FormatFlags) Inspection)
 -> InspectedModule -> Const (Endo FormatFlags) InspectedModule)
-> Getting (Endo FormatFlags) Inspection String
-> Getting (Endo FormatFlags) InspectedModule String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> Const (Endo FormatFlags) [Text])
-> Inspection -> Const (Endo FormatFlags) Inspection
Traversal' Inspection [Text]
inspectionOpts (([Text] -> Const (Endo FormatFlags) [Text])
 -> Inspection -> Const (Endo FormatFlags) Inspection)
-> ((String -> Const (Endo FormatFlags) String)
    -> [Text] -> Const (Endo FormatFlags) [Text])
-> Getting (Endo FormatFlags) Inspection String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (Endo FormatFlags) Text)
-> [Text] -> Const (Endo FormatFlags) [Text]
forall s t a b. Each s t a b => Traversal s t a b
each ((Text -> Const (Endo FormatFlags) Text)
 -> [Text] -> Const (Endo FormatFlags) [Text])
-> ((String -> Const (Endo FormatFlags) String)
    -> Text -> Const (Endo FormatFlags) Text)
-> (String -> Const (Endo FormatFlags) String)
-> [Text]
-> Const (Endo FormatFlags) [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Const (Endo FormatFlags) String)
-> Text -> Const (Endo FormatFlags) Text
forall t. IsText t => Iso' t String
unpacked) InspectedModule
im) Module
m

-- | Is inspected module up to date?
upToDate :: SessionMonad m => ModuleLocation -> [String] -> Inspection -> m Bool
upToDate :: ModuleLocation -> FormatFlags -> Inspection -> m Bool
upToDate ModuleLocation
mloc FormatFlags
opts Inspection
insp = do
	Inspection
insp' <- IO Inspection -> m Inspection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Inspection -> m Inspection) -> IO Inspection -> m Inspection
forall a b. (a -> b) -> a -> b
$ ModuleLocation -> FormatFlags -> IO Inspection
moduleInspection ModuleLocation
mloc FormatFlags
opts
	Maybe Inspection
mfinsp <- (Maybe (Maybe Inspection) -> Maybe Inspection)
-> m (Maybe (Maybe Inspection)) -> m (Maybe Inspection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe Inspection) -> Maybe Inspection
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (Maybe (Maybe Inspection)) -> m (Maybe Inspection))
-> m (Maybe (Maybe Inspection)) -> m (Maybe Inspection)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> (Text -> m (Maybe Inspection)) -> m (Maybe (Maybe Inspection))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (ModuleLocation
mloc ModuleLocation
-> ((Text -> Const (First Text) Text)
    -> ModuleLocation -> Const (First Text) ModuleLocation)
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Text -> Const (First Text) Text)
-> ModuleLocation -> Const (First Text) ModuleLocation
Traversal' ModuleLocation Text
moduleFile) ((Text -> m (Maybe Inspection)) -> m (Maybe (Maybe Inspection)))
-> (Text -> m (Maybe Inspection)) -> m (Maybe (Maybe Inspection))
forall a b. (a -> b) -> a -> b
$ \Text
fpath -> do
		[Only Double]
tm <- Query -> Only Text -> m [Only Double]
forall q r (m :: * -> *).
(ToRow q, FromRow r, SessionMonad m) =>
Query -> q -> m [r]
SQLite.query @_ @(SQLite.Only Double) Query
"select mtime from file_contents where file = ?;" (Text -> Only Text
forall a. a -> Only a
SQLite.Only Text
fpath)
		Maybe Inspection -> m (Maybe Inspection)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Inspection -> m (Maybe Inspection))
-> Maybe Inspection -> m (Maybe Inspection)
forall a b. (a -> b) -> a -> b
$ (Only Double -> Inspection)
-> Maybe (Only Double) -> Maybe Inspection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FormatFlags -> POSIXTime -> Inspection
fileContentsInspection_ FormatFlags
opts (POSIXTime -> Inspection)
-> (Only Double -> POSIXTime) -> Only Double -> Inspection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> POSIXTime
forall a. Fractional a => Rational -> a
fromRational (Rational -> POSIXTime)
-> (Only Double -> Rational) -> Only Double -> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> Rational)
-> (Only Double -> Double) -> Only Double -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Only Double -> Double
forall a. Only a -> a
SQLite.fromOnly) ([Only Double] -> Maybe (Only Double)
forall a. [a] -> Maybe a
listToMaybe [Only Double]
tm)
	let
		lastInsp :: Inspection
lastInsp = Inspection
-> (Inspection -> Inspection) -> Maybe Inspection -> Inspection
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Inspection
insp' (Inspection -> Inspection -> Inspection
forall a. Ord a => a -> a -> a
max Inspection
insp') Maybe Inspection
mfinsp
	Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Inspection -> Inspection -> Bool
fresh Inspection
insp Inspection
lastInsp

-- | Returns new (to scan) and changed (to rescan) modules
changedModules :: SessionMonad m => Map ModuleLocation Inspection -> [String] -> [ModuleToScan] -> m [ModuleToScan]
changedModules :: Map ModuleLocation Inspection
-> FormatFlags -> [ModuleToScan] -> m [ModuleToScan]
changedModules Map ModuleLocation Inspection
inspMap FormatFlags
opts = (ModuleToScan -> m Bool) -> [ModuleToScan] -> m [ModuleToScan]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ((ModuleToScan -> m Bool) -> [ModuleToScan] -> m [ModuleToScan])
-> (ModuleToScan -> m Bool) -> [ModuleToScan] -> m [ModuleToScan]
forall a b. (a -> b) -> a -> b
$ \ModuleToScan
m -> if Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (ModuleToScan
m ModuleToScan
-> Getting (Maybe Text) ModuleToScan (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) ModuleToScan (Maybe Text)
forall s t a b. Field3 s t a b => Lens s t a b
_3)
	then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
	else m Bool -> (Inspection -> m Bool) -> Maybe Inspection -> m Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
		(Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
		((Bool -> Bool) -> m Bool -> m Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Bool -> Bool
not (m Bool -> m Bool)
-> (Inspection -> m Bool) -> Inspection -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleLocation -> FormatFlags -> Inspection -> m Bool
forall (m :: * -> *).
SessionMonad m =>
ModuleLocation -> FormatFlags -> Inspection -> m Bool
upToDate (ModuleToScan
m ModuleToScan
-> Getting ModuleLocation ModuleToScan ModuleLocation
-> ModuleLocation
forall s a. s -> Getting a s a -> a
^. Getting ModuleLocation ModuleToScan ModuleLocation
forall s t a b. Field1 s t a b => Lens s t a b
_1) (FormatFlags
opts FormatFlags -> FormatFlags -> FormatFlags
forall a. [a] -> [a] -> [a]
++ (ModuleToScan
m ModuleToScan
-> Getting FormatFlags ModuleToScan FormatFlags -> FormatFlags
forall s a. s -> Getting a s a -> a
^. Getting FormatFlags ModuleToScan FormatFlags
forall s t a b. Field2 s t a b => Lens s t a b
_2)))
		(ModuleLocation -> Map ModuleLocation Inspection -> Maybe Inspection
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (ModuleToScan
m ModuleToScan
-> Getting ModuleLocation ModuleToScan ModuleLocation
-> ModuleLocation
forall s a. s -> Getting a s a -> a
^. Getting ModuleLocation ModuleToScan ModuleLocation
forall s t a b. Field1 s t a b => Lens s t a b
_1) Map ModuleLocation Inspection
inspMap)

-- | Returns file contents if it was set and still actual
getFileContents :: SessionMonad m => Path -> m (Maybe (POSIXTime, Text))
getFileContents :: Text -> m (Maybe (POSIXTime, Text))
getFileContents Text
fpath = do
	[(Double, Text)]
mcts <- Query -> Only Text -> m [(Double, Text)]
forall q r (m :: * -> *).
(ToRow q, FromRow r, SessionMonad m) =>
Query -> q -> m [r]
SQLite.query @_ @(Double, Text) Query
"select mtime, contents from file_contents where file = ?;" (Text -> Only Text
forall a. a -> Only a
SQLite.Only Text
fpath)
	Inspection
insp <- IO Inspection -> m Inspection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Inspection -> m Inspection) -> IO Inspection -> m Inspection
forall a b. (a -> b) -> a -> b
$ Text -> FormatFlags -> IO Inspection
fileInspection Text
fpath []
	case [(Double, Text)] -> Maybe (Double, Text)
forall a. [a] -> Maybe a
listToMaybe [(Double, Text)]
mcts of
		Maybe (Double, Text)
Nothing -> Maybe (POSIXTime, Text) -> m (Maybe (POSIXTime, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (POSIXTime, Text)
forall a. Maybe a
Nothing
		Just (Double
tm, Text
cts) -> do
			let
				tm' :: POSIXTime
tm' = Rational -> POSIXTime
forall a. Fractional a => Rational -> a
fromRational (Double -> Rational
forall a. Real a => a -> Rational
toRational Double
tm)
			POSIXTime
fmtime <- m POSIXTime
-> (POSIXTime -> m POSIXTime) -> Maybe POSIXTime -> m POSIXTime
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (HsDevError -> m POSIXTime
forall (m :: * -> *) a. MonadThrow m => HsDevError -> m a
hsdevError (HsDevError -> m POSIXTime) -> HsDevError -> m POSIXTime
forall a b. (a -> b) -> a -> b
$ String -> HsDevError
OtherError String
"impossible: inspection time not set after call to `fileInspection`") POSIXTime -> m POSIXTime
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe POSIXTime -> m POSIXTime) -> Maybe POSIXTime -> m POSIXTime
forall a b. (a -> b) -> a -> b
$ Inspection
insp Inspection
-> Getting (First POSIXTime) Inspection POSIXTime
-> Maybe POSIXTime
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First POSIXTime) Inspection POSIXTime
Traversal' Inspection POSIXTime
inspectionAt
			if POSIXTime
fmtime POSIXTime -> POSIXTime -> Bool
forall a. Ord a => a -> a -> Bool
< POSIXTime
tm'
				then Maybe (POSIXTime, Text) -> m (Maybe (POSIXTime, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return ((POSIXTime, Text) -> Maybe (POSIXTime, Text)
forall a. a -> Maybe a
Just (POSIXTime
tm', Text
cts))
				else do
					m (Async ()) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Async ()) -> m ()) -> m (Async ()) -> m ()
forall a b. (a -> b) -> a -> b
$ ServerM IO () -> m (Async ())
forall (m :: * -> *) a.
SessionMonad m =>
ServerM IO a -> m (Async a)
postSessionUpdater (ServerM IO () -> m (Async ())) -> ServerM IO () -> m (Async ())
forall a b. (a -> b) -> a -> b
$ Query -> Only Text -> ServerM IO ()
forall q (m :: * -> *).
(ToRow q, SessionMonad m) =>
Query -> q -> m ()
SQLite.execute Query
"delete from file_contents where file = ?;" (Text -> Only Text
forall a. a -> Only a
SQLite.Only Text
fpath)
					Maybe (POSIXTime, Text) -> m (Maybe (POSIXTime, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (POSIXTime, Text)
forall a. Maybe a
Nothing