{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.Syntax
-- Copyright   :  (c) Don Stewart 2007
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- This module defines a common interface for syntax-awareness.
--
-- There have been many tens of wasted hours in this and lexer
-- modules. This note is to commemorate those who have fallen in
-- battle.

module Yi.Syntax
  ( Highlighter  ( .. )
  , Cache
  , Scanner (..)
  , ExtHL        ( .. )
  , noHighlighter, mkHighlighter, skipScanner, emptyFileScan
  , Point(..), Size(..), Length, Stroke
  , Span(..)
  )
where

import qualified  Data.Map as M
import Control.Arrow
import Yi.Style
import Yi.Buffer.Basic
import Yi.Region

type Length = Int                   -- size in #codepoints

type Stroke = Span StyleName
data Span a = Span {forall a. Span a -> Point
spanBegin :: !Point, forall a. Span a -> a
spanContents :: !a, forall a. Span a -> Point
spanEnd :: !Point}
    deriving (Int -> Span a -> ShowS
[Span a] -> ShowS
Span a -> String
(Int -> Span a -> ShowS)
-> (Span a -> String) -> ([Span a] -> ShowS) -> Show (Span a)
forall a. Show a => Int -> Span a -> ShowS
forall a. Show a => [Span a] -> ShowS
forall a. Show a => Span a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Span a -> ShowS
showsPrec :: Int -> Span a -> ShowS
$cshow :: forall a. Show a => Span a -> String
show :: Span a -> String
$cshowList :: forall a. Show a => [Span a] -> ShowS
showList :: [Span a] -> ShowS
Show, (forall a b. (a -> b) -> Span a -> Span b)
-> (forall a b. a -> Span b -> Span a) -> Functor Span
forall a b. a -> Span b -> Span a
forall a b. (a -> b) -> Span a -> Span b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Span a -> Span b
fmap :: forall a b. (a -> b) -> Span a -> Span b
$c<$ :: forall a b. a -> Span b -> Span a
<$ :: forall a b. a -> Span b -> Span a
Functor, (forall m. Monoid m => Span m -> m)
-> (forall m a. Monoid m => (a -> m) -> Span a -> m)
-> (forall m a. Monoid m => (a -> m) -> Span a -> m)
-> (forall a b. (a -> b -> b) -> b -> Span a -> b)
-> (forall a b. (a -> b -> b) -> b -> Span a -> b)
-> (forall b a. (b -> a -> b) -> b -> Span a -> b)
-> (forall b a. (b -> a -> b) -> b -> Span a -> b)
-> (forall a. (a -> a -> a) -> Span a -> a)
-> (forall a. (a -> a -> a) -> Span a -> a)
-> (forall a. Span a -> [a])
-> (forall a. Span a -> Bool)
-> (forall a. Span a -> Int)
-> (forall a. Eq a => a -> Span a -> Bool)
-> (forall a. Ord a => Span a -> a)
-> (forall a. Ord a => Span a -> a)
-> (forall a. Num a => Span a -> a)
-> (forall a. Num a => Span a -> a)
-> Foldable Span
forall a. Eq a => a -> Span a -> Bool
forall a. Num a => Span a -> a
forall a. Ord a => Span a -> a
forall m. Monoid m => Span m -> m
forall a. Span a -> Bool
forall a. Span a -> Int
forall a. Span a -> [a]
forall a. (a -> a -> a) -> Span a -> a
forall m a. Monoid m => (a -> m) -> Span a -> m
forall b a. (b -> a -> b) -> b -> Span a -> b
forall a b. (a -> b -> b) -> b -> Span a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Span m -> m
fold :: forall m. Monoid m => Span m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Span a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Span a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Span a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Span a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Span a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Span a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Span a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Span a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Span a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Span a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Span a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Span a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Span a -> a
foldr1 :: forall a. (a -> a -> a) -> Span a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Span a -> a
foldl1 :: forall a. (a -> a -> a) -> Span a -> a
$ctoList :: forall a. Span a -> [a]
toList :: forall a. Span a -> [a]
$cnull :: forall a. Span a -> Bool
null :: forall a. Span a -> Bool
$clength :: forall a. Span a -> Int
length :: forall a. Span a -> Int
$celem :: forall a. Eq a => a -> Span a -> Bool
elem :: forall a. Eq a => a -> Span a -> Bool
$cmaximum :: forall a. Ord a => Span a -> a
maximum :: forall a. Ord a => Span a -> a
$cminimum :: forall a. Ord a => Span a -> a
minimum :: forall a. Ord a => Span a -> a
$csum :: forall a. Num a => Span a -> a
sum :: forall a. Num a => Span a -> a
$cproduct :: forall a. Num a => Span a -> a
product :: forall a. Num a => Span a -> a
Foldable, Functor Span
Foldable Span
(Functor Span, Foldable Span) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Span a -> f (Span b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Span (f a) -> f (Span a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Span a -> m (Span b))
-> (forall (m :: * -> *) a. Monad m => Span (m a) -> m (Span a))
-> Traversable Span
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Span (m a) -> m (Span a)
forall (f :: * -> *) a. Applicative f => Span (f a) -> f (Span a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Span a -> m (Span b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Span a -> f (Span b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Span a -> f (Span b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Span a -> f (Span b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Span (f a) -> f (Span a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Span (f a) -> f (Span a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Span a -> m (Span b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Span a -> m (Span b)
$csequence :: forall (m :: * -> *) a. Monad m => Span (m a) -> m (Span a)
sequence :: forall (m :: * -> *) a. Monad m => Span (m a) -> m (Span a)
Traversable)

-- | The main type of syntax highlighters.  This record type combines all
-- the required functions, and is parametrized on the type of the internal
-- state.

-- FIXME: this is actually completely abstracted from syntax HL, so
-- the names are silly.

data Highlighter cache syntax =
  SynHL { forall cache syntax. Highlighter cache syntax -> cache
hlStartState :: cache -- ^ The start state for the highlighter.
        , forall cache syntax.
Highlighter cache syntax
-> Scanner Point Char -> Point -> cache -> cache
hlRun :: Scanner Point Char -> Point -> cache -> cache
        , forall cache syntax.
Highlighter cache syntax -> cache -> WindowRef -> syntax
hlGetTree :: cache -> WindowRef -> syntax
        , forall cache syntax.
Highlighter cache syntax -> Map WindowRef Region -> cache -> cache
hlFocus :: M.Map WindowRef Region -> cache -> cache
        -- ^ focus at a given point, and return the corresponding node.
        -- (hint -- the root can always be returned, at the cost of
        -- performance.)
        }

data ExtHL syntax = forall cache. ExtHL (Highlighter cache syntax)

data Scanner st a = Scanner
  { forall st a. Scanner st a -> st
scanInit :: st -- ^ Initial state
  , forall st a. Scanner st a -> st -> Point
scanLooked :: st -> Point
    -- ^ How far did the scanner look to produce this intermediate state?
    -- The state can be reused as long as nothing changes before that point.
  , forall st a. Scanner st a -> a
scanEmpty :: a      --  hack :/
  , forall st a. Scanner st a -> st -> [(st, a)]
scanRun  :: st -> [(st ,a)]
    -- ^ Running function returns a list of results and intermediate
    -- states. Note: the state is the state /before/ producing the
    -- result in the second component.
  }

skipScanner :: Int -> Scanner st a -> Scanner st a
skipScanner :: forall st a. Int -> Scanner st a -> Scanner st a
skipScanner Int
n (Scanner st
i st -> Point
l a
e st -> [(st, a)]
r) = st -> (st -> Point) -> a -> (st -> [(st, a)]) -> Scanner st a
forall st a.
st -> (st -> Point) -> a -> (st -> [(st, a)]) -> Scanner st a
Scanner st
i st -> Point
l a
e (Int -> [(st, a)] -> [(st, a)]
forall {a}. Int -> [a] -> [a]
other Int
0 ([(st, a)] -> [(st, a)]) -> (st -> [(st, a)]) -> st -> [(st, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. st -> [(st, a)]
r)
    where
      other :: Int -> [a] -> [a]
other Int
_ [] = []
      other Int
_ [a
x] = [a
x] -- we must return the final result (because if
                        -- the list is empty mkHighlighter thinks it
                        -- can reuse the previous result)
      other Int
0 (a
x:[a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Int -> [a] -> [a]
other Int
n [a]
xs
      other Int
m (a
_:[a]
xs) = Int -> [a] -> [a]
other (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [a]
xs

instance Functor (Scanner st) where
    fmap :: forall a b. (a -> b) -> Scanner st a -> Scanner st b
fmap a -> b
f (Scanner st
i st -> Point
l a
e st -> [(st, a)]
r) = st -> (st -> Point) -> b -> (st -> [(st, b)]) -> Scanner st b
forall st a.
st -> (st -> Point) -> a -> (st -> [(st, a)]) -> Scanner st a
Scanner st
i st -> Point
l (a -> b
f a
e) (((st, a) -> (st, b)) -> [(st, a)] -> [(st, b)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (st, a) -> (st, b)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second a -> b
f) ([(st, a)] -> [(st, b)]) -> (st -> [(st, a)]) -> st -> [(st, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. st -> [(st, a)]
r)

data Cache state result = Cache [state] result

emptyFileScan :: Scanner Point Char
emptyFileScan :: Scanner Point Char
emptyFileScan = Scanner
  { scanInit :: Point
scanInit = Point
0
  , scanRun :: Point -> [(Point, Char)]
scanRun = [(Point, Char)] -> Point -> [(Point, Char)]
forall a b. a -> b -> a
const []
  , scanLooked :: Point -> Point
scanLooked = Point -> Point
forall a. a -> a
id
  , scanEmpty :: Char
scanEmpty = String -> Char
forall a. HasCallStack => String -> a
error String
"emptyFileScan: no scanEmpty"
  }

-- | This takes as input a scanner that returns the "full" result at
-- each element in the list; perhaps in a different form for the
-- purpose of incremental-lazy eval.
mkHighlighter :: forall state result. Show state =>
                 (Scanner Point Char -> Scanner state result) ->
                     Highlighter (Cache state result) result
mkHighlighter :: forall state result.
Show state =>
(Scanner Point Char -> Scanner state result)
-> Highlighter (Cache state result) result
mkHighlighter Scanner Point Char -> Scanner state result
scanner =
  Yi.Syntax.SynHL
        { hlStartState :: Cache state result
hlStartState   = [state] -> result -> Cache state result
forall state result. [state] -> result -> Cache state result
Cache [] result
emptyResult
        , hlRun :: Scanner Point Char
-> Point -> Cache state result -> Cache state result
hlRun          = Scanner Point Char
-> Point -> Cache state result -> Cache state result
updateCache
        , hlGetTree :: Cache state result -> WindowRef -> result
hlGetTree      = \(Cache [state]
_ result
result) WindowRef
_windowRef -> result
result
        , hlFocus :: Map WindowRef Region -> Cache state result -> Cache state result
hlFocus        = \Map WindowRef Region
_ Cache state result
c -> Cache state result
c
        }
    where startState :: state
          startState :: state
startState = Scanner state result -> state
forall st a. Scanner st a -> st
scanInit    (Scanner Point Char -> Scanner state result
scanner Scanner Point Char
emptyFileScan)
          emptyResult :: result
emptyResult = Scanner state result -> result
forall st a. Scanner st a -> a
scanEmpty (Scanner Point Char -> Scanner state result
scanner Scanner Point Char
emptyFileScan)
          updateCache :: Scanner Point Char -> Point -> Cache state result -> Cache state result
          updateCache :: Scanner Point Char
-> Point -> Cache state result -> Cache state result
updateCache Scanner Point Char
newFileScan Point
dirtyOffset (Cache [state]
cachedStates result
oldResult) = [state] -> result -> Cache state result
forall state result. [state] -> result -> Cache state result
Cache [state]
newCachedStates result
newResult
            where newScan :: Scanner state result
newScan = Scanner Point Char -> Scanner state result
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 result -> state -> Point
forall st a. Scanner st a -> st -> Point
scanLooked (Scanner Point Char -> Scanner state result
scanner Scanner Point Char
newFileScan)) [state]
cachedStates
                  resumeState :: state
                  resumeState :: state
resumeState = if [state] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [state]
reused then state
startState else [state] -> state
forall a. HasCallStack => [a] -> a
last [state]
reused

                  newCachedStates :: [state]
newCachedStates = [state]
reused [state] -> [state] -> [state]
forall a. [a] -> [a] -> [a]
++ ((state, result) -> state) -> [(state, result)] -> [state]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (state, result) -> state
forall a b. (a, b) -> a
fst [(state, result)]
recomputed
                  recomputed :: [(state, result)]
recomputed = Scanner state result -> state -> [(state, result)]
forall st a. Scanner st a -> st -> [(st, a)]
scanRun Scanner state result
newScan state
resumeState
                  newResult :: result
                  newResult :: result
newResult = if [(state, result)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(state, result)]
recomputed then result
oldResult else (state, result) -> result
forall a b. (a, b) -> b
snd ((state, result) -> result) -> (state, result) -> result
forall a b. (a -> b) -> a -> b
$ [(state, result)] -> (state, result)
forall a. HasCallStack => [a] -> a
head [(state, result)]
recomputed

noHighlighter :: Highlighter () syntax
noHighlighter :: forall syntax. Highlighter () syntax
noHighlighter = SynHL
  { hlStartState :: ()
hlStartState = ()
  , hlRun :: Scanner Point Char -> Point -> () -> ()
hlRun = \Scanner Point Char
_ Point
_ ()
a -> ()
a
  , hlFocus :: Map WindowRef Region -> () -> ()
hlFocus = \Map WindowRef Region
_ ()
c -> ()
c
  , hlGetTree :: () -> WindowRef -> syntax
hlGetTree = \ ()
_ -> String -> WindowRef -> syntax
forall a. HasCallStack => String -> a
error String
"noHighlighter: tried to use syntax"
  }