    {-# 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"
      }