{-# LANGUAGE FlexibleInstances, TypeOperators, TypeApplications, OverloadedStrings #-}
module HsDev.Scan (
CompileFlag, ModuleToScan, ProjectToScan, PackageDbToScan, ScanContents(..),
EnumContents(..),
enumRescan, enumDependent, enumProject, enumSandbox, enumDirectory,
scanProjectFile,
scanModify,
upToDate, changedModules,
getFileContents,
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
type CompileFlag = String
type ModuleToScan = (ModuleLocation, [CompileFlag], Maybe Text)
type ProjectToScan = (Project, [ModuleToScan])
type PackageDbToScan = PackageDbStack
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
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)] [] []
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
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)] []
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
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]
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
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
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
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)
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