module HsDev.Inspect.Order (
	orderBy, order
	) where

import Control.Lens
import Data.Maybe
import Data.String
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Language.Haskell.Exts as H

import Data.Deps
import HsDev.Inspect
import HsDev.Symbols.Types
import System.Directory.Paths

-- | Order source files so that dependencies goes first and we are able to resolve symbols and set fixities
orderBy :: (a -> Maybe Preloaded) -> [a] -> Either (DepsError Path) [a]
orderBy :: (a -> Maybe Preloaded) -> [a] -> Either (DepsError Path) [a]
orderBy a -> Maybe Preloaded
fn [a]
ps = do
	[Path]
order' <- Deps Path -> Either (DepsError Path) [Path]
forall a. Ord a => Deps a -> Either (DepsError a) [a]
linearize Deps Path
pdeps
	[a] -> Either (DepsError Path) [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> Either (DepsError Path) [a])
-> [a] -> Either (DepsError Path) [a]
forall a b. (a -> b) -> a -> b
$ (Path -> Maybe a) -> [Path] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Path -> Map Path a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map Path a
pm) [Path]
order'
	where
		pdeps :: Deps Path
pdeps = [Deps Path] -> Deps Path
forall a. Monoid a => [a] -> a
mconcat ([Deps Path] -> Deps Path) -> [Deps Path] -> Deps Path
forall a b. (a -> b) -> a -> b
$ (a -> Maybe (Deps Path)) -> [a] -> [Deps Path]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Preloaded -> Deps Path) -> Maybe Preloaded -> Maybe (Deps Path)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Preloaded -> Deps Path
getDeps (Maybe Preloaded -> Maybe (Deps Path))
-> (a -> Maybe Preloaded) -> a -> Maybe (Deps Path)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe Preloaded
fn) [a]
ps
		pm :: Map Path a
pm = [(Path, a)] -> Map Path a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Path
pfile, a
p) | a
p <- [a]
ps, Path
pfile <- a -> Maybe Preloaded
fn a
p Maybe Preloaded
-> Getting (Endo [Path]) (Maybe Preloaded) Path -> [Path]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Preloaded -> Const (Endo [Path]) Preloaded)
-> Maybe Preloaded -> Const (Endo [Path]) (Maybe Preloaded)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Preloaded -> Const (Endo [Path]) Preloaded)
 -> Maybe Preloaded -> Const (Endo [Path]) (Maybe Preloaded))
-> ((Path -> Const (Endo [Path]) Path)
    -> Preloaded -> Const (Endo [Path]) Preloaded)
-> Getting (Endo [Path]) (Maybe Preloaded) Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleId -> Const (Endo [Path]) ModuleId)
-> Preloaded -> Const (Endo [Path]) Preloaded
Lens' Preloaded ModuleId
preloadedId ((ModuleId -> Const (Endo [Path]) ModuleId)
 -> Preloaded -> Const (Endo [Path]) Preloaded)
-> ((Path -> Const (Endo [Path]) Path)
    -> ModuleId -> Const (Endo [Path]) ModuleId)
-> (Path -> Const (Endo [Path]) Path)
-> Preloaded
-> Const (Endo [Path]) Preloaded
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleLocation -> Const (Endo [Path]) ModuleLocation)
-> ModuleId -> Const (Endo [Path]) ModuleId
Lens' ModuleId ModuleLocation
moduleLocation ((ModuleLocation -> Const (Endo [Path]) ModuleLocation)
 -> ModuleId -> Const (Endo [Path]) ModuleId)
-> ((Path -> Const (Endo [Path]) Path)
    -> ModuleLocation -> Const (Endo [Path]) ModuleLocation)
-> (Path -> Const (Endo [Path]) Path)
-> ModuleId
-> Const (Endo [Path]) ModuleId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const (Endo [Path]) Path)
-> ModuleLocation -> Const (Endo [Path]) ModuleLocation
Traversal' ModuleLocation Path
moduleFile]
		files :: Set Path
files = [Path] -> Set Path
forall a. Ord a => [a] -> Set a
S.fromList ([Path] -> Set Path) -> [Path] -> Set Path
forall a b. (a -> b) -> a -> b
$ (a -> Maybe Preloaded) -> [a] -> [Maybe Preloaded]
forall a b. (a -> b) -> [a] -> [b]
map a -> Maybe Preloaded
fn [a]
ps [Maybe Preloaded]
-> Getting (Endo [Path]) [Maybe Preloaded] Path -> [Path]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Maybe Preloaded -> Const (Endo [Path]) (Maybe Preloaded))
-> [Maybe Preloaded] -> Const (Endo [Path]) [Maybe Preloaded]
forall s t a b. Each s t a b => Traversal s t a b
each ((Maybe Preloaded -> Const (Endo [Path]) (Maybe Preloaded))
 -> [Maybe Preloaded] -> Const (Endo [Path]) [Maybe Preloaded])
-> Getting (Endo [Path]) (Maybe Preloaded) Path
-> Getting (Endo [Path]) [Maybe Preloaded] Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Preloaded -> Const (Endo [Path]) Preloaded)
-> Maybe Preloaded -> Const (Endo [Path]) (Maybe Preloaded)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Preloaded -> Const (Endo [Path]) Preloaded)
 -> Maybe Preloaded -> Const (Endo [Path]) (Maybe Preloaded))
-> ((Path -> Const (Endo [Path]) Path)
    -> Preloaded -> Const (Endo [Path]) Preloaded)
-> Getting (Endo [Path]) (Maybe Preloaded) Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleId -> Const (Endo [Path]) ModuleId)
-> Preloaded -> Const (Endo [Path]) Preloaded
Lens' Preloaded ModuleId
preloadedId ((ModuleId -> Const (Endo [Path]) ModuleId)
 -> Preloaded -> Const (Endo [Path]) Preloaded)
-> ((Path -> Const (Endo [Path]) Path)
    -> ModuleId -> Const (Endo [Path]) ModuleId)
-> (Path -> Const (Endo [Path]) Path)
-> Preloaded
-> Const (Endo [Path]) Preloaded
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleLocation -> Const (Endo [Path]) ModuleLocation)
-> ModuleId -> Const (Endo [Path]) ModuleId
Lens' ModuleId ModuleLocation
moduleLocation ((ModuleLocation -> Const (Endo [Path]) ModuleLocation)
 -> ModuleId -> Const (Endo [Path]) ModuleId)
-> ((Path -> Const (Endo [Path]) Path)
    -> ModuleLocation -> Const (Endo [Path]) ModuleLocation)
-> (Path -> Const (Endo [Path]) Path)
-> ModuleId
-> Const (Endo [Path]) ModuleId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const (Endo [Path]) Path)
-> ModuleLocation -> Const (Endo [Path]) ModuleLocation
Traversal' ModuleLocation Path
moduleFile
		getDeps :: Preloaded -> Deps Path
		getDeps :: Preloaded -> Deps Path
getDeps Preloaded
p = Path -> [Path] -> Deps Path
forall a. a -> [a] -> Deps a
deps Path
mfile [Path
ifile | Path
ifile <- [Path]
ifiles, Path -> Set Path -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member Path
ifile Set Path
files] where
			H.Module SrcSpanInfo
_ Maybe (ModuleHead SrcSpanInfo)
_ [ModulePragma SrcSpanInfo]
_ [ImportDecl SrcSpanInfo]
idecls [Decl SrcSpanInfo]
_ = Preloaded -> Module SrcSpanInfo
_preloadedModule Preloaded
p
			imods :: [Path]
imods = [String -> Path
forall a. IsString a => String -> a
fromString String
iname | H.ModuleName SrcSpanInfo
_ String
iname <- (ImportDecl SrcSpanInfo -> ModuleName SrcSpanInfo)
-> [ImportDecl SrcSpanInfo] -> [ModuleName SrcSpanInfo]
forall a b. (a -> b) -> [a] -> [b]
map ImportDecl SrcSpanInfo -> ModuleName SrcSpanInfo
forall l. ImportDecl l -> ModuleName l
H.importModule [ImportDecl SrcSpanInfo]
idecls]
			mfile :: Path
mfile = Preloaded -> ModuleId
_preloadedId Preloaded
p ModuleId -> Getting (Endo Path) ModuleId Path -> Path
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! (ModuleLocation -> Const (Endo Path) ModuleLocation)
-> ModuleId -> Const (Endo Path) ModuleId
Lens' ModuleId ModuleLocation
moduleLocation ((ModuleLocation -> Const (Endo Path) ModuleLocation)
 -> ModuleId -> Const (Endo Path) ModuleId)
-> ((Path -> Const (Endo Path) Path)
    -> ModuleLocation -> Const (Endo Path) ModuleLocation)
-> Getting (Endo Path) ModuleId Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const (Endo Path) Path)
-> ModuleLocation -> Const (Endo Path) ModuleLocation
Traversal' ModuleLocation Path
moduleFile
			projRoot :: Maybe Path
projRoot = Preloaded -> ModuleId
_preloadedId Preloaded
p ModuleId -> Getting (First Path) ModuleId Path -> Maybe Path
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ModuleLocation -> Const (First Path) ModuleLocation)
-> ModuleId -> Const (First Path) ModuleId
Lens' ModuleId ModuleLocation
moduleLocation ((ModuleLocation -> Const (First Path) ModuleLocation)
 -> ModuleId -> Const (First Path) ModuleId)
-> ((Path -> Const (First Path) Path)
    -> ModuleLocation -> Const (First Path) ModuleLocation)
-> Getting (First Path) ModuleId Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Project -> Const (First Path) (Maybe Project))
-> ModuleLocation -> Const (First Path) ModuleLocation
Traversal' ModuleLocation (Maybe Project)
moduleProject ((Maybe Project -> Const (First Path) (Maybe Project))
 -> ModuleLocation -> Const (First Path) ModuleLocation)
-> ((Path -> Const (First Path) Path)
    -> Maybe Project -> Const (First Path) (Maybe Project))
-> (Path -> Const (First Path) Path)
-> ModuleLocation
-> Const (First Path) ModuleLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Project -> Const (First Path) Project)
-> Maybe Project -> Const (First Path) (Maybe Project)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Project -> Const (First Path) Project)
 -> Maybe Project -> Const (First Path) (Maybe Project))
-> ((Path -> Const (First Path) Path)
    -> Project -> Const (First Path) Project)
-> (Path -> Const (First Path) Path)
-> Maybe Project
-> Const (First Path) (Maybe Project)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const (First Path) Path)
-> Project -> Const (First Path) Project
Lens' Project Path
projectPath
			mroot :: Path
mroot = Path -> Maybe Path -> Path
forall a. a -> Maybe a -> a
fromMaybe
				(Path -> Path -> Path
sourceModuleRoot (Getting Path ModuleId Path -> ModuleId -> Path
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Path ModuleId Path
Lens' ModuleId Path
moduleName (ModuleId -> Path) -> ModuleId -> Path
forall a b. (a -> b) -> a -> b
$ Preloaded -> ModuleId
_preloadedId Preloaded
p) Path
mfile)
				Maybe Path
projRoot
			dirs :: [Path]
dirs = do
				Project
proj <- Preloaded -> ModuleId
_preloadedId Preloaded
p ModuleId -> Getting (Endo [Project]) ModuleId Project -> [Project]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (ModuleLocation -> Const (Endo [Project]) ModuleLocation)
-> ModuleId -> Const (Endo [Project]) ModuleId
Lens' ModuleId ModuleLocation
moduleLocation ((ModuleLocation -> Const (Endo [Project]) ModuleLocation)
 -> ModuleId -> Const (Endo [Project]) ModuleId)
-> ((Project -> Const (Endo [Project]) Project)
    -> ModuleLocation -> Const (Endo [Project]) ModuleLocation)
-> Getting (Endo [Project]) ModuleId Project
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Project -> Const (Endo [Project]) (Maybe Project))
-> ModuleLocation -> Const (Endo [Project]) ModuleLocation
Traversal' ModuleLocation (Maybe Project)
moduleProject ((Maybe Project -> Const (Endo [Project]) (Maybe Project))
 -> ModuleLocation -> Const (Endo [Project]) ModuleLocation)
-> ((Project -> Const (Endo [Project]) Project)
    -> Maybe Project -> Const (Endo [Project]) (Maybe Project))
-> (Project -> Const (Endo [Project]) Project)
-> ModuleLocation
-> Const (Endo [Project]) ModuleLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Project -> Const (Endo [Project]) Project)
-> Maybe Project -> Const (Endo [Project]) (Maybe Project)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just
				Info
i <- Project -> Path -> [Info]
fileTargets Project
proj Path
mfile
				Getting [Path] Info [Path] -> Info -> [Path]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Path] Info [Path]
Lens' Info [Path]
infoSourceDirs Info
i
			ifiles :: [Path]
ifiles = [Path -> Path
normPath ([Path] -> Path
joinPaths [Path
mroot, Path
dir, Path -> Path
importPath Path
imod]) | Path
imod <- [Path]
imods, Path
dir <- if [Path] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Path]
dirs then [String -> Path
fromFilePath String
"."] else [Path]
dirs]

order :: [Preloaded] -> Either (DepsError Path) [Preloaded]
order :: [Preloaded] -> Either (DepsError Path) [Preloaded]
order = (Preloaded -> Maybe Preloaded)
-> [Preloaded] -> Either (DepsError Path) [Preloaded]
forall a.
(a -> Maybe Preloaded) -> [a] -> Either (DepsError Path) [a]
orderBy Preloaded -> Maybe Preloaded
forall a. a -> Maybe a
Just