{-# LANGUAGE ScopedTypeVariables, ExistentialQuantification, MultiParamTypeClasses #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

-- | This module defines implementations of syntax-awareness drivers.

module Yi.Syntax.Driver where

import           Data.Map        (Map)
import qualified Data.Map        as M (Map, assocs, empty, findWithDefault, fromList)
import           Yi.Buffer.Basic (WindowRef)
import           Yi.Lexer.Alex   (Tok)
import           Yi.Syntax       hiding (Cache)
import           Yi.Syntax.Tree  (IsTree, fromNodeToFinal)

type Path = [Int]

data Cache state tree tt = Cache {
                                   Cache state tree tt -> Map WindowRef Path
path :: M.Map WindowRef Path,
                                   Cache state tree tt -> [state]
cachedStates :: [state],
                                   Cache state tree tt -> tree (Tok tt)
root :: tree (Tok tt),
                                   Cache state tree tt -> Map WindowRef (tree (Tok tt))
focused :: !(M.Map WindowRef (tree (Tok tt)))
                                 }

mkHighlighter :: forall state tree tt. (IsTree tree, Show state) =>
                 (Scanner Point Char -> Scanner state (tree (Tok tt))) ->
                     Highlighter (Cache state tree tt) (tree (Tok tt))
mkHighlighter :: (Scanner Point Char -> Scanner state (tree (Tok tt)))
-> Highlighter (Cache state tree tt) (tree (Tok tt))
mkHighlighter Scanner Point Char -> Scanner state (tree (Tok tt))
scanner =
  SynHL :: forall cache syntax.
cache
-> (Scanner Point Char -> Point -> cache -> cache)
-> (cache -> WindowRef -> syntax)
-> (Map WindowRef Region -> cache -> cache)
-> Highlighter cache syntax
Yi.Syntax.SynHL
        { hlStartState :: Cache state tree tt
hlStartState   = Map WindowRef Path
-> [state]
-> tree (Tok tt)
-> Map WindowRef (tree (Tok tt))
-> Cache state tree tt
forall state (tree :: * -> *) tt.
Map WindowRef Path
-> [state]
-> tree (Tok tt)
-> Map WindowRef (tree (Tok tt))
-> Cache state tree tt
Cache Map WindowRef Path
forall k a. Map k a
M.empty [] tree (Tok tt)
emptyResult Map WindowRef (tree (Tok tt))
forall k a. Map k a
M.empty
        , hlRun :: Scanner Point Char
-> Point -> Cache state tree tt -> Cache state tree tt
hlRun          = Scanner Point Char
-> Point -> Cache state tree tt -> Cache state tree tt
updateCache
        , hlGetTree :: Cache state tree tt -> WindowRef -> tree (Tok tt)
hlGetTree      = \(Cache Map WindowRef Path
_ [state]
_ tree (Tok tt)
_ Map WindowRef (tree (Tok tt))
focused) WindowRef
w -> tree (Tok tt)
-> WindowRef -> Map WindowRef (tree (Tok tt)) -> tree (Tok tt)
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault tree (Tok tt)
emptyResult WindowRef
w Map WindowRef (tree (Tok tt))
focused
        , hlFocus :: Map WindowRef Region -> Cache state tree tt -> Cache state tree tt
hlFocus        = Map WindowRef Region -> Cache state tree tt -> Cache state tree tt
forall (tree :: * -> *) state tt.
IsTree tree =>
Map WindowRef Region -> Cache state tree tt -> Cache state tree tt
focus
        }
    where startState :: state
          startState :: state
startState = Scanner state (tree (Tok tt)) -> state
forall st a. Scanner st a -> st
scanInit    (Scanner Point Char -> Scanner state (tree (Tok tt))
scanner Scanner Point Char
emptyFileScan)
          emptyResult :: tree (Tok tt)
emptyResult = Scanner state (tree (Tok tt)) -> tree (Tok tt)
forall st a. Scanner st a -> a
scanEmpty (Scanner Point Char -> Scanner state (tree (Tok tt))
scanner Scanner Point Char
emptyFileScan)
          updateCache :: Scanner Point Char -> Point -> Cache state tree tt -> Cache state tree tt
          updateCache :: Scanner Point Char
-> Point -> Cache state tree tt -> Cache state tree tt
updateCache Scanner Point Char
newFileScan Point
dirtyOffset (Cache Map WindowRef Path
path [state]
cachedStates tree (Tok tt)
oldResult Map WindowRef (tree (Tok tt))
_) = Map WindowRef Path
-> [state]
-> tree (Tok tt)
-> Map WindowRef (tree (Tok tt))
-> Cache state tree tt
forall state (tree :: * -> *) tt.
Map WindowRef Path
-> [state]
-> tree (Tok tt)
-> Map WindowRef (tree (Tok tt))
-> Cache state tree tt
Cache Map WindowRef Path
path [state]
newCachedStates tree (Tok tt)
newResult Map WindowRef (tree (Tok tt))
forall k a. Map k a
M.empty
            where newScan :: Scanner state (tree (Tok tt))
newScan = Scanner Point Char -> Scanner state (tree (Tok tt))
scanner Scanner Point Char
newFileScan
                  reused :: [state]
                  reused :: [state]
reused = (state -> Bool) -> [state] -> [state]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
< Point
dirtyOffset) (Point -> Bool) -> (state -> Point) -> state -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scanner state (tree (Tok tt)) -> state -> Point
forall st a. Scanner st a -> st -> Point
scanLooked (Scanner Point Char -> Scanner state (tree (Tok tt))
scanner Scanner Point Char
newFileScan)) [state]
cachedStates
                  resumeState :: state
                  resumeState :: state
resumeState = if [state] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [state]
reused then state
startState else [state] -> state
forall a. [a] -> a
last [state]
reused

                  newCachedStates :: [state]
newCachedStates = [state]
reused [state] -> [state] -> [state]
forall a. [a] -> [a] -> [a]
++ ((state, tree (Tok tt)) -> state)
-> [(state, tree (Tok tt))] -> [state]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (state, tree (Tok tt)) -> state
forall a b. (a, b) -> a
fst [(state, tree (Tok tt))]
recomputed
                  recomputed :: [(state, tree (Tok tt))]
recomputed = Scanner state (tree (Tok tt)) -> state -> [(state, tree (Tok tt))]
forall st a. Scanner st a -> st -> [(st, a)]
scanRun Scanner state (tree (Tok tt))
newScan state
resumeState
                  newResult :: tree (Tok tt)
                  newResult :: tree (Tok tt)
newResult = if [(state, tree (Tok tt))] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(state, tree (Tok tt))]
recomputed then tree (Tok tt)
oldResult else (state, tree (Tok tt)) -> tree (Tok tt)
forall a b. (a, b) -> b
snd ((state, tree (Tok tt)) -> tree (Tok tt))
-> (state, tree (Tok tt)) -> tree (Tok tt)
forall a b. (a -> b) -> a -> b
$ [(state, tree (Tok tt))] -> (state, tree (Tok tt))
forall a. [a] -> a
head [(state, tree (Tok tt))]
recomputed
          focus :: Map WindowRef Region -> Cache state tree tt -> Cache state tree tt
focus Map WindowRef Region
r (Cache Map WindowRef Path
path [state]
states tree (Tok tt)
root Map WindowRef (tree (Tok tt))
_focused) =
              Map WindowRef Path
-> [state]
-> tree (Tok tt)
-> Map WindowRef (tree (Tok tt))
-> Cache state tree tt
forall state (tree :: * -> *) tt.
Map WindowRef Path
-> [state]
-> tree (Tok tt)
-> Map WindowRef (tree (Tok tt))
-> Cache state tree tt
Cache Map WindowRef Path
path' [state]
states tree (Tok tt)
root Map WindowRef (tree (Tok tt))
focused
              where (Map WindowRef Path
path', Map WindowRef (tree (Tok tt))
focused) = [(WindowRef, (Path, tree (Tok tt)))]
-> (Map WindowRef Path, Map WindowRef (tree (Tok tt)))
forall k u v. Ord k => [(k, (u, v))] -> (Map k u, Map k v)
unzipFM ([(WindowRef, (Path, tree (Tok tt)))]
 -> (Map WindowRef Path, Map WindowRef (tree (Tok tt))))
-> [(WindowRef, (Path, tree (Tok tt)))]
-> (Map WindowRef Path, Map WindowRef (tree (Tok tt)))
forall a b. (a -> b) -> a -> b
$ (Region -> Path -> (Path, tree (Tok tt)))
-> Path
-> Map WindowRef Region
-> Map WindowRef Path
-> [(WindowRef, (Path, tree (Tok tt)))]
forall k u v w.
Ord k =>
(u -> v -> w) -> v -> Map k u -> Map k v -> [(k, w)]
zipWithFM (\Region
newpath Path
oldpath -> Region -> (Path, tree (Tok tt)) -> (Path, tree (Tok tt))
forall (tree :: * -> *) a.
IsTree tree =>
Region -> Node (tree (Tok a)) -> Node (tree (Tok a))
fromNodeToFinal Region
newpath (Path
oldpath,tree (Tok tt)
root)) [] Map WindowRef Region
r Map WindowRef Path
path

unzipFM :: Ord k => [(k,(u,v))] -> (Map k u, Map k v)
unzipFM :: [(k, (u, v))] -> (Map k u, Map k v)
unzipFM [(k, (u, v))]
l = ([(k, u)] -> Map k u
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(k, u)]
mu, [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(k, v)]
mv)
    where ([(k, u)]
mu, [(k, v)]
mv) = [((k, u), (k, v))] -> ([(k, u)], [(k, v)])
forall a b. [(a, b)] -> ([a], [b])
unzip [((k
k,u
u),(k
k,v
v)) | (k
k,(u
u,v
v)) <- [(k, (u, v))]
l]

zipWithFM :: Ord k => (u -> v -> w) -> v -> Map k u -> Map k v -> [(k,w)]
zipWithFM :: (u -> v -> w) -> v -> Map k u -> Map k v -> [(k, w)]
zipWithFM u -> v -> w
f v
v0 Map k u
mu Map k v
mv = [ (k
k,u -> v -> w
f u
u (v -> k -> Map k v -> v
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault v
v0 k
k Map k v
mv) ) | (k
k,u
u) <- Map k u -> [(k, u)]
forall k a. Map k a -> [(k, a)]
M.assocs Map k u
mu]