module HsDev.Tools.Tabs (
	recalcNotesTabs
	) where

import Control.Lens
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Data.Text (Text)

import System.Directory.Paths
import HsDev.Symbols.Location
import HsDev.Tools.Types
import HsDev.Util

-- | Some tools counts tab as 8 symbols and return such file positions; convert them (consider tab = one symbol)
recalcNotesTabs :: Map Path Text -> [Note a] -> IO [Note a]
recalcNotesTabs :: Map Path Path -> [Note a] -> IO [Note a]
recalcNotesTabs Map Path Path
srcs [Note a]
notes = do
	Map Path Path
ctsMap <- ([(Path, Path)] -> Map Path Path)
-> IO [(Path, Path)] -> IO (Map Path Path)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Path, Path)] -> Map Path Path
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (IO [(Path, Path)] -> IO (Map Path Path))
-> IO [(Path, Path)] -> IO (Map Path Path)
forall a b. (a -> b) -> a -> b
$ (Path -> IO (Path, Path)) -> [Path] -> IO [(Path, Path)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Path -> IO (Path, Path)
loadFileContents [Path]
files
	let
		recalc' :: Note a -> Note a
recalc' Note a
n = Note a -> Maybe (Note a) -> Note a
forall a. a -> Maybe a -> a
fromMaybe Note a
n (Maybe (Note a) -> Note a) -> Maybe (Note a) -> Note a
forall a b. (a -> b) -> a -> b
$ do
			Path
fname <- Getting (First Path) (Note a) Path -> Note a -> Maybe Path
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((ModuleLocation -> Const (First Path) ModuleLocation)
-> Note a -> Const (First Path) (Note a)
forall a. Lens' (Note a) ModuleLocation
noteSource ((ModuleLocation -> Const (First Path) ModuleLocation)
 -> Note a -> Const (First Path) (Note a))
-> ((Path -> Const (First Path) Path)
    -> ModuleLocation -> Const (First Path) ModuleLocation)
-> Getting (First Path) (Note a) Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const (First Path) Path)
-> ModuleLocation -> Const (First Path) ModuleLocation
Traversal' ModuleLocation Path
moduleFile) Note a
n
			Path
cts' <- Path -> Map Path Path -> Maybe Path
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Path
fname Map Path Path
ctsMap
			Note a -> Maybe (Note a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Note a -> Maybe (Note a)) -> Note a -> Maybe (Note a)
forall a b. (a -> b) -> a -> b
$ Path -> Int -> Note a -> Note a
forall a. RecalcTabs a => Path -> Int -> a -> a
recalcTabs Path
cts' Int
8 Note a
n
	[Note a] -> IO [Note a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Note a] -> IO [Note a]) -> [Note a] -> IO [Note a]
forall a b. (a -> b) -> a -> b
$ (Note a -> Note a) -> [Note a] -> [Note a]
forall a b. (a -> b) -> [a] -> [b]
map Note a -> Note a
forall a. Note a -> Note a
recalc' [Note a]
notes
	where
		files :: [Path]
files = [Path] -> [Path]
forall a. Ord a => [a] -> [a]
ordNub ([Path] -> [Path]) -> [Path] -> [Path]
forall a b. (a -> b) -> a -> b
$ [Note a]
notes [Note a] -> Getting (Endo [Path]) [Note a] Path -> [Path]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Note a -> Const (Endo [Path]) (Note a))
-> [Note a] -> Const (Endo [Path]) [Note a]
forall s t a b. Each s t a b => Traversal s t a b
each ((Note a -> Const (Endo [Path]) (Note a))
 -> [Note a] -> Const (Endo [Path]) [Note a])
-> ((Path -> Const (Endo [Path]) Path)
    -> Note a -> Const (Endo [Path]) (Note a))
-> Getting (Endo [Path]) [Note a] Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleLocation -> Const (Endo [Path]) ModuleLocation)
-> Note a -> Const (Endo [Path]) (Note a)
forall a. Lens' (Note a) ModuleLocation
noteSource ((ModuleLocation -> Const (Endo [Path]) ModuleLocation)
 -> Note a -> Const (Endo [Path]) (Note a))
-> ((Path -> Const (Endo [Path]) Path)
    -> ModuleLocation -> Const (Endo [Path]) ModuleLocation)
-> (Path -> Const (Endo [Path]) Path)
-> Note a
-> Const (Endo [Path]) (Note a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const (Endo [Path]) Path)
-> ModuleLocation -> Const (Endo [Path]) ModuleLocation
Traversal' ModuleLocation Path
moduleFile
		loadFileContents :: Path -> IO (Path, Path)
loadFileContents Path
f = do
			Path
cts <- IO Path -> (Path -> IO Path) -> Maybe Path -> IO Path
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> IO Path
readFileUtf8 (FilePath -> IO Path) -> FilePath -> IO Path
forall a b. (a -> b) -> a -> b
$ Getting FilePath Path FilePath -> Path -> FilePath
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting FilePath Path FilePath
Lens' Path FilePath
path Path
f) Path -> IO Path
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Path -> IO Path) -> Maybe Path -> IO Path
forall a b. (a -> b) -> a -> b
$ Path -> Map Path Path -> Maybe Path
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Path
f Map Path Path
srcs
			(Path, Path) -> IO (Path, Path)
forall (m :: * -> *) a. Monad m => a -> m a
return (Path
f, Path
cts)