    {-# LANGUAGE DeriveFoldable #-}
    {-# LANGUAGE DeriveFunctor  #-}
    {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} -- uniplate patterns
    {-# OPTIONS_HADDOCK show-extensions #-}

    -- |
    -- Module      :  Yi.Syntax.Latex
    -- License     :  GPL-2
    -- Maintainer  :  yi-devel@googlegroups.com
    -- Stability   :  experimental
    -- Portability :  portable
    --
    -- Parser used by the LaTeX modes.

    module Yi.Syntax.Latex where

    import           Control.Applicative (Alternative ((<|>), empty, many))
    import           Data.Monoid         (Endo (..), (<>))
    import           Yi.IncrementalParse (P, eof, recoverWith, symbol)
    import           Yi.Lexer.Alex       hiding (tokenToStyle)
    import           Yi.Lexer.Latex      (Token (..), tokenToText)
    import           Yi.Style
    import           Yi.Syntax           (Point, Span)
    import           Yi.Syntax.Tree      (IsTree (emptyNode, uniplate))

    isNoise :: Token -> Bool
    isNoise :: Token -> Bool
    isNoise Token
    Text = Bool
    True
    isNoise Token
    Comment = Bool
    True
    isNoise (Command String
    _) = Bool
    True
    isNoise Token
    NewCommand = Bool
    True
    isNoise (Special Char
    ' ') = Bool
    True
    isNoise (Special Char
    _) = Bool
    False
    isNoise (Begin String
    _) = Bool
    False
    isNoise (End String
    _) = Bool
    False

    type TT = Tok Token

    type Expr t = [Tree t]

    data Tree t
        = Paren t (Tree t) t -- A parenthesized expression (maybe with [ ] ...)
        | Atom t
        | Error t
        | Expr (Expr t)
          deriving (Int -> Tree t -> ShowS
    [Tree t] -> ShowS
    Tree t -> String
    (Int -> Tree t -> ShowS)
    -> (Tree t -> String) -> ([Tree t] -> ShowS) -> Show (Tree t)
    forall t. Show t => Int -> Tree t -> ShowS
    forall t. Show t => [Tree t] -> ShowS
    forall t. Show t => Tree t -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall t. Show t => Int -> Tree t -> ShowS
    showsPrec :: Int -> Tree t -> ShowS
    $cshow :: forall t. Show t => Tree t -> String
    show :: Tree t -> String
    $cshowList :: forall t. Show t => [Tree t] -> ShowS
    showList :: [Tree t] -> ShowS
    Show, (forall a b. (a -> b) -> Tree a -> Tree b)
    -> (forall a b. a -> Tree b -> Tree a) -> Functor Tree
    forall a b. a -> Tree b -> Tree a
    forall a b. (a -> b) -> Tree a -> Tree 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) -> Tree a -> Tree b
    fmap :: forall a b. (a -> b) -> Tree a -> Tree b
    $c<$ :: forall a b. a -> Tree b -> Tree a
    <$ :: forall a b. a -> Tree b -> Tree a
    Functor, (forall m. Monoid m => Tree m -> m)
    -> (forall m a. Monoid m => (a -> m) -> Tree a -> m)
    -> (forall m a. Monoid m => (a -> m) -> Tree a -> m)
    -> (forall a b. (a -> b -> b) -> b -> Tree a -> b)
    -> (forall a b. (a -> b -> b) -> b -> Tree a -> b)
    -> (forall b a. (b -> a -> b) -> b -> Tree a -> b)
    -> (forall b a. (b -> a -> b) -> b -> Tree a -> b)
    -> (forall a. (a -> a -> a) -> Tree a -> a)
    -> (forall a. (a -> a -> a) -> Tree a -> a)
    -> (forall a. Tree a -> [a])
    -> (forall a. Tree a -> Bool)
    -> (forall a. Tree a -> Int)
    -> (forall a. Eq a => a -> Tree a -> Bool)
    -> (forall a. Ord a => Tree a -> a)
    -> (forall a. Ord a => Tree a -> a)
    -> (forall a. Num a => Tree a -> a)
    -> (forall a. Num a => Tree a -> a)
    -> Foldable Tree
    forall a. Eq a => a -> Tree a -> Bool
    forall a. Num a => Tree a -> a
    forall a. Ord a => Tree a -> a
    forall m. Monoid m => Tree m -> m
    forall a. Tree a -> Bool
    forall a. Tree a -> Int
    forall a. Tree a -> [a]
    forall a. (a -> a -> a) -> Tree a -> a
    forall m a. Monoid m => (a -> m) -> Tree a -> m
    forall b a. (b -> a -> b) -> b -> Tree a -> b
    forall a b. (a -> b -> b) -> b -> Tree 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 => Tree m -> m
    fold :: forall m. Monoid m => Tree m -> m
    $cfoldMap :: forall m a. Monoid m => (a -> m) -> Tree a -> m
    foldMap :: forall m a. Monoid m => (a -> m) -> Tree a -> m
    $cfoldMap' :: forall m a. Monoid m => (a -> m) -> Tree a -> m
    foldMap' :: forall m a. Monoid m => (a -> m) -> Tree a -> m
    $cfoldr :: forall a b. (a -> b -> b) -> b -> Tree a -> b
    foldr :: forall a b. (a -> b -> b) -> b -> Tree a -> b
    $cfoldr' :: forall a b. (a -> b -> b) -> b -> Tree a -> b
    foldr' :: forall a b. (a -> b -> b) -> b -> Tree a -> b
    $cfoldl :: forall b a. (b -> a -> b) -> b -> Tree a -> b
    foldl :: forall b a. (b -> a -> b) -> b -> Tree a -> b
    $cfoldl' :: forall b a. (b -> a -> b) -> b -> Tree a -> b
    foldl' :: forall b a. (b -> a -> b) -> b -> Tree a -> b
    $cfoldr1 :: forall a. (a -> a -> a) -> Tree a -> a
    foldr1 :: forall a. (a -> a -> a) -> Tree a -> a
    $cfoldl1 :: forall a. (a -> a -> a) -> Tree a -> a
    foldl1 :: forall a. (a -> a -> a) -> Tree a -> a
    $ctoList :: forall a. Tree a -> [a]
    toList :: forall a. Tree a -> [a]
    $cnull :: forall a. Tree a -> Bool
    null :: forall a. Tree a -> Bool
    $clength :: forall a. Tree a -> Int
    length :: forall a. Tree a -> Int
    $celem :: forall a. Eq a => a -> Tree a -> Bool
    elem :: forall a. Eq a => a -> Tree a -> Bool
    $cmaximum :: forall a. Ord a => Tree a -> a
    maximum :: forall a. Ord a => Tree a -> a
    $cminimum :: forall a. Ord a => Tree a -> a
    minimum :: forall a. Ord a => Tree a -> a
    $csum :: forall a. Num a => Tree a -> a
    sum :: forall a. Num a => Tree a -> a
    $cproduct :: forall a. Num a => Tree a -> a
    product :: forall a. Num a => Tree a -> a
    Foldable)

    instance IsTree Tree where
        uniplate :: forall t. Tree t -> ([Tree t], [Tree t] -> Tree t)
    uniplate (Paren t
    l Tree t
    g t
    r) = ([Tree t
    g], \[Tree t
    g'] -> t -> Tree t -> t -> Tree t
    forall t. t -> Tree t -> t -> Tree t
    Paren t
    l Tree t
    g' t
    r)
        uniplate (Expr [Tree t]
    g) = ([Tree t]
    g, [Tree t] -> Tree t
    forall t. Expr t -> Tree t
    Expr)
        uniplate Tree t
    t = ([],Tree t -> [Tree t] -> Tree t
    forall a b. a -> b -> a
    const Tree t
    t)
        emptyNode :: forall t. Tree t
    emptyNode = Expr t -> Tree t
    forall t. Expr t -> Tree t
    Expr []

    parse :: P TT (Tree TT)
    parse :: P TT (Tree TT)
    parse = Bool -> P TT (Tree TT)
    pExpr Bool
    True P TT (Tree TT) -> Parser TT () -> P TT (Tree TT)
    forall a b. Parser TT a -> Parser TT b -> Parser TT a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Parser TT ()
    forall s. Parser s ()
    eof
        where
          -- Create a special character symbol
          newT :: Char -> TT
    newT Char
    c = Token -> TT
    forall t. t -> Tok t
    tokFromT (Char -> Token
    Special Char
    c)
          -- errT = (\next -> case next of
          --     Nothing -> newT '!'
          --     Just (Tok {tokPosn = posn}) -> Tok { tokT = Special '!', tokPosn = posn-1, tokSize = 1 -- FIXME: size should be 1 char, not one byte!
          --                      }) <$> lookNext
          errT :: Parser TT TT
    errT = TT -> Parser TT TT
    forall a. a -> Parser TT a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Char -> TT
    newT Char
    '!')
          -- parse a special symbol
          sym' :: (b -> Bool) -> Parser (Tok b) (Tok b)
    sym' b -> Bool
    p = (Tok b -> Bool) -> Parser (Tok b) (Tok b)
    forall s. (s -> Bool) -> Parser s s
    symbol (b -> Bool
    p (b -> Bool) -> (Tok b -> b) -> Tok b -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Tok b -> b
    forall t. Tok t -> t
    tokT)
          sym :: b -> Parser (Tok b) (Tok b)
    sym b
    t = (b -> Bool) -> Parser (Tok b) (Tok b)
    forall {b}. (b -> Bool) -> Parser (Tok b) (Tok b)
    sym' (b -> b -> Bool
    forall a. Eq a => a -> a -> Bool
    == b
    t)

          pleaseSym :: Token -> Parser TT TT
    pleaseSym Token
    c = Parser TT TT -> Parser TT TT
    forall s a. Parser s a -> Parser s a
    recoverWith Parser TT TT
    errT Parser TT TT -> Parser TT TT -> Parser TT TT
    forall a. Parser TT a -> Parser TT a -> Parser TT a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Token -> Parser TT TT
    forall {b}. Eq b => b -> Parser (Tok b) (Tok b)
    sym Token
    c
          -- pleaseSym' c = recoverWith errT <|> sym' c

          -- pExpr :: P TT [Expr TT]
          pExpr :: Bool -> P TT (Tree TT)
    pExpr Bool
    outsideMath = Expr TT -> Tree TT
    forall t. Expr t -> Tree t
    Expr (Expr TT -> Tree TT) -> Parser TT (Expr TT) -> P TT (Tree TT)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> P TT (Tree TT) -> Parser TT (Expr TT)
    forall a. Parser TT a -> Parser TT [a]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    many (Bool -> P TT (Tree TT)
    pTree Bool
    outsideMath)

          parens :: [(Token, Token)]
    parens = [(Char -> Token
    Special Char
    x, Char -> Token
    Special Char
    y) | (Char
    x,Char
    y) <- String -> String -> [(Char, Char)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip String
    "({[" String
    ")}]"]
          openParens :: [Token]
    openParens = ((Token, Token) -> Token) -> [(Token, Token)] -> [Token]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Token, Token) -> Token
    forall a b. (a, b) -> a
    fst [(Token, Token)]
    parens

          pBlock :: P TT (Tree TT)
    pBlock = (Token -> Bool) -> Parser TT TT
    forall {b}. (b -> Bool) -> Parser (Tok b) (Tok b)
    sym' Token -> Bool
    isBegin Parser TT TT -> (TT -> P TT (Tree TT)) -> P TT (Tree TT)
    forall a b. Parser TT a -> (a -> Parser TT b) -> Parser TT b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \beg :: TT
    beg@Tok {tokT :: forall t. Tok t -> t
    tokT = Begin String
    env} -> TT -> Tree TT -> TT -> Tree TT
    forall t. t -> Tree t -> t -> Tree t
    Paren (TT -> Tree TT -> TT -> Tree TT)
    -> Parser TT TT -> Parser TT (Tree TT -> TT -> Tree TT)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TT -> Parser TT TT
    forall a. a -> Parser TT a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure TT
    beg Parser TT (Tree TT -> TT -> Tree TT)
    -> P TT (Tree TT) -> Parser TT (TT -> Tree TT)
    forall a b. Parser TT (a -> b) -> Parser TT a -> Parser TT b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Bool -> P TT (Tree TT)
    pExpr Bool
    True Parser TT (TT -> Tree TT) -> Parser TT TT -> P TT (Tree TT)
    forall a b. Parser TT (a -> b) -> Parser TT a -> Parser TT b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Token -> Parser TT TT
    pleaseSym (String -> Token
    End String
    env)

          pTree :: Bool -> P TT (Tree TT)
          pTree :: Bool -> P TT (Tree TT)
    pTree Bool
    outsideMath =
              (if Bool
    outsideMath then P TT (Tree TT)
    pBlock P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
    forall a. Parser TT a -> Parser TT a -> Parser TT a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (TT -> Tree TT -> TT -> Tree TT
    forall t. t -> Tree t -> t -> Tree t
    Paren (TT -> Tree TT -> TT -> Tree TT)
    -> Parser TT TT -> Parser TT (Tree TT -> TT -> Tree TT)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Token -> Parser TT TT
    forall {b}. Eq b => b -> Parser (Tok b) (Tok b)
    sym (Char -> Token
    Special Char
    '$') Parser TT (Tree TT -> TT -> Tree TT)
    -> P TT (Tree TT) -> Parser TT (TT -> Tree TT)
    forall a b. Parser TT (a -> b) -> Parser TT a -> Parser TT b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Bool -> P TT (Tree TT)
    pExpr Bool
    False Parser TT (TT -> Tree TT) -> Parser TT TT -> P TT (Tree TT)
    forall a b. Parser TT (a -> b) -> Parser TT a -> Parser TT b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Token -> Parser TT TT
    pleaseSym (Char -> Token
    Special Char
    '$'))
                               else P TT (Tree TT)
    forall a. Parser TT a
    forall (f :: * -> *) a. Alternative f => f a
    empty)
              P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
    forall a. Parser TT a -> Parser TT a -> Parser TT a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT))
    -> [P TT (Tree TT)] -> P TT (Tree TT)
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
    forall a. Parser TT a -> Parser TT a -> Parser TT a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    (<|>) [TT -> Tree TT -> TT -> Tree TT
    forall t. t -> Tree t -> t -> Tree t
    Paren (TT -> Tree TT -> TT -> Tree TT)
    -> Parser TT TT -> Parser TT (Tree TT -> TT -> Tree TT)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Token -> Parser TT TT
    forall {b}. Eq b => b -> Parser (Tok b) (Tok b)
    sym Token
    l Parser TT (Tree TT -> TT -> Tree TT)
    -> P TT (Tree TT) -> Parser TT (TT -> Tree TT)
    forall a b. Parser TT (a -> b) -> Parser TT a -> Parser TT b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Bool -> P TT (Tree TT)
    pExpr Bool
    outsideMath Parser TT (TT -> Tree TT) -> Parser TT TT -> P TT (Tree TT)
    forall a b. Parser TT (a -> b) -> Parser TT a -> Parser TT b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Token -> Parser TT TT
    pleaseSym Token
    r | (Token
    l,Token
    r) <- [(Token, Token)]
    parens]
              P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
    forall a. Parser TT a -> Parser TT a -> Parser TT a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (TT -> Tree TT
    forall t. t -> Tree t
    Atom (TT -> Tree TT) -> Parser TT TT -> P TT (Tree TT)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Token -> Bool) -> Parser TT TT
    forall {b}. (b -> Bool) -> Parser (Tok b) (Tok b)
    sym' Token -> Bool
    isNoise)
              P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
    forall a. Parser TT a -> Parser TT a -> Parser TT a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (TT -> Tree TT
    forall t. t -> Tree t
    Error (TT -> Tree TT) -> Parser TT TT -> P TT (Tree TT)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser TT TT -> Parser TT TT
    forall s a. Parser s a -> Parser s a
    recoverWith ((Token -> Bool) -> Parser TT TT
    forall {b}. (b -> Bool) -> Parser (Tok b) (Tok b)
    sym' (Bool -> Bool
    not (Bool -> Bool) -> (Token -> Bool) -> Token -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Bool -> Bool -> Bool
    (||) (Bool -> Bool -> Bool) -> (Token -> Bool) -> Token -> Bool -> Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Token -> Bool
    isNoise (Token -> Bool -> Bool) -> (Token -> Bool) -> Token -> Bool
    forall a b. (Token -> a -> b) -> (Token -> a) -> Token -> b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (Token -> [Token] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Token]
    openParens)))))

    getStrokes :: Point -> Point -> Point -> Tree TT -> [Stroke]
    getStrokes :: Point -> Point -> Point -> Tree TT -> [Stroke]
    getStrokes Point
    point Point
    _begin Point
    _end Tree TT
    t0 = Endo [Stroke] -> [Stroke] -> [Stroke]
    forall a. Endo a -> a -> a
    appEndo Endo [Stroke]
    result []
        where getStrokes' :: Tree TT -> Endo [Stroke]
              getStrokes' :: Tree TT -> Endo [Stroke]
    getStrokes' (Expr Expr TT
    g) = Expr TT -> Endo [Stroke]
    getStrokesL Expr TT
    g
              getStrokes' (Atom TT
    t) = (Stroke -> Stroke) -> TT -> Endo [Stroke]
    forall {a}. (Stroke -> a) -> TT -> Endo [a]
    ts Stroke -> Stroke
    forall a. a -> a
    id TT
    t
              getStrokes' (Error TT
    t) = (Stroke -> Stroke) -> TT -> Endo [Stroke]
    forall {a}. (Stroke -> a) -> TT -> Endo [a]
    ts (StyleName -> Stroke -> Stroke
    modStroke StyleName
    errorStyle) TT
    t -- paint in red
              getStrokes' (Paren TT
    l Tree TT
    g TT
    r)
                  -- we have special treatment for (Begin, End) because these blocks are typically very large.
                  -- we don't force the "end" part to prevent parsing the whole file.
                  | Token -> Bool
    isBegin (TT -> Token
    forall t. Tok t -> t
    tokT TT
    l) = if Posn -> Point
    posnOfs (TT -> Posn
    forall t. Tok t -> Posn
    tokPosn TT
    l) Point -> Point -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Point
    point
                      then Endo [Stroke]
    normalPaint
                      else case (TT -> Token
    forall t. Tok t -> t
    tokT TT
    l, TT -> Token
    forall t. Tok t -> t
    tokT TT
    r) of
                             (Begin String
    b, End String
    e) | String
    b String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    e -> Endo [Stroke]
    hintPaint
                             (Token, Token)
    _ -> Endo [Stroke]
    errPaint
                  | Token -> Bool
    isErrorTok (TT -> Token
    forall t. Tok t -> t
    tokT TT
    r) = Endo [Stroke]
    errPaint
                  -- left paren wasn't matched: paint it in red.
                  -- note that testing this on the "Paren" node actually forces the parsing of the
                  -- right paren, undermining online behaviour.
                  | Posn -> Point
    posnOfs (TT -> Posn
    forall t. Tok t -> Posn
    tokPosn TT
    l) Point -> Point -> Bool
    forall a. Eq a => a -> a -> Bool
    == Point
    point Bool -> Bool -> Bool
    || Posn -> Point
    posnOfs (TT -> Posn
    forall t. Tok t -> Posn
    tokPosn TT
    r) Point -> Point -> Bool
    forall a. Eq a => a -> a -> Bool
    == Point
    point Point -> Point -> Point
    forall a. Num a => a -> a -> a
    - Point
    1 = Endo [Stroke]
    hintPaint
                  | Bool
    otherwise = Endo [Stroke]
    normalPaint
                  where normalPaint :: Endo [Stroke]
    normalPaint = (Stroke -> Stroke) -> TT -> Endo [Stroke]
    forall {a}. (Stroke -> a) -> TT -> Endo [a]
    ts Stroke -> Stroke
    forall a. a -> a
    id TT
    l Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> Tree TT -> Endo [Stroke]
    getStrokes' Tree TT
    g Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> (Stroke -> Stroke) -> TT -> TT -> Endo [Stroke]
    tsEnd Stroke -> Stroke
    forall a. a -> a
    id TT
    l TT
    r
                        hintPaint :: Endo [Stroke]
    hintPaint = (Stroke -> Stroke) -> TT -> Endo [Stroke]
    forall {a}. (Stroke -> a) -> TT -> Endo [a]
    ts (StyleName -> Stroke -> Stroke
    modStroke StyleName
    hintStyle) TT
    l Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> Tree TT -> Endo [Stroke]
    getStrokes' Tree TT
    g Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> (Stroke -> Stroke) -> TT -> TT -> Endo [Stroke]
    tsEnd (StyleName -> Stroke -> Stroke
    modStroke StyleName
    hintStyle) TT
    l TT
    r
                        errPaint :: Endo [Stroke]
    errPaint = (Stroke -> Stroke) -> TT -> Endo [Stroke]
    forall {a}. (Stroke -> a) -> TT -> Endo [a]
    ts (StyleName -> Stroke -> Stroke
    modStroke StyleName
    errorStyle) TT
    l Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> Tree TT -> Endo [Stroke]
    getStrokes' Tree TT
    g

              tsEnd :: (Stroke -> Stroke) -> TT -> TT -> Endo [Stroke]
    tsEnd Stroke -> Stroke
    _ (Tok{tokT :: forall t. Tok t -> t
    tokT = Begin String
    b}) t :: TT
    t@(Tok{tokT :: forall t. Tok t -> t
    tokT = End String
    e})
                  | String
    b String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    e = (Stroke -> Stroke) -> TT -> Endo [Stroke]
    forall {a}. (Stroke -> a) -> TT -> Endo [a]
    ts (StyleName -> Stroke -> Stroke
    modStroke StyleName
    errorStyle) TT
    t
              tsEnd Stroke -> Stroke
    f TT
    _ TT
    t = (Stroke -> Stroke) -> TT -> Endo [Stroke]
    forall {a}. (Stroke -> a) -> TT -> Endo [a]
    ts Stroke -> Stroke
    f TT
    t
              getStrokesL :: Expr TT -> Endo [Stroke]
              getStrokesL :: Expr TT -> Endo [Stroke]
    getStrokesL = (Tree TT -> Endo [Stroke]) -> Expr TT -> Endo [Stroke]
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Tree TT -> Endo [Stroke]
    getStrokes'
              ts :: (Stroke -> a) -> TT -> Endo [a]
    ts Stroke -> a
    f TT
    t
                  | Token -> Bool
    isErrorTok (TT -> Token
    forall t. Tok t -> t
    tokT TT
    t) = Endo [a]
    forall a. Monoid a => a
    mempty
                  | Bool
    otherwise = ([a] -> [a]) -> Endo [a]
    forall a. (a -> a) -> Endo a
    Endo (Stroke -> a
    f (TT -> Stroke
    tokenToStroke TT
    t) a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :)
              result :: Endo [Stroke]
    result = Tree TT -> Endo [Stroke]
    getStrokes' Tree TT
    t0

    modStroke :: StyleName -> Stroke -> Stroke
    modStroke :: StyleName -> Stroke -> Stroke
    modStroke StyleName
    f = (StyleName -> StyleName) -> Stroke -> Stroke
    forall a b. (a -> b) -> Span a -> Span b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (StyleName
    f StyleName -> StyleName -> StyleName
    forall a. Monoid a => a -> a -> a
    `mappend`)

    tokenToStroke :: TT -> Stroke
    tokenToStroke :: TT -> Stroke
    tokenToStroke = (Token -> StyleName) -> Span Token -> Stroke
    forall a b. (a -> b) -> Span a -> Span b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Token -> StyleName
    tokenToStyle (Span Token -> Stroke) -> (TT -> Span Token) -> TT -> Stroke
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TT -> Span Token
    forall t. Tok t -> Span t
    tokToSpan

    tokenToAnnot :: TT -> Maybe (Span String)
    tokenToAnnot :: TT -> Maybe (Span String)
    tokenToAnnot = Span (Maybe String) -> Maybe (Span String)
    forall (t :: * -> *) (f :: * -> *) a.
    (Traversable t, Applicative f) =>
    t (f a) -> f (t a)
    forall (f :: * -> *) a. Applicative f => Span (f a) -> f (Span a)
    sequenceA (Span (Maybe String) -> Maybe (Span String))
    -> (TT -> Span (Maybe String)) -> TT -> Maybe (Span String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Tok (Maybe String) -> Span (Maybe String)
    forall t. Tok t -> Span t
    tokToSpan (Tok (Maybe String) -> Span (Maybe String))
    -> (TT -> Tok (Maybe String)) -> TT -> Span (Maybe String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Token -> Maybe String) -> TT -> Tok (Maybe String)
    forall a b. (a -> b) -> Tok a -> Tok b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Token -> Maybe String
    tokenToText

    tokenToStyle :: Token -> StyleName
    tokenToStyle :: Token -> StyleName
    tokenToStyle Token
    t =
      case Token
    t of
        Token
    Comment -> StyleName
    commentStyle
        Token
    Text -> StyleName
    defaultStyle
        Special Char
    _ -> StyleName
    defaultStyle
        Command String
    _ -> StyleName
    typeStyle
        Begin String
    _ -> StyleName
    keywordStyle
        End String
    _ -> StyleName
    keywordStyle
        Token
    NewCommand -> StyleName
    keywordStyle

    isSpecial :: String -> Token -> Bool
    isSpecial :: String -> Token -> Bool
    isSpecial String
    cs (Special Char
    c) = Char
    c Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    cs
    isSpecial String
    _  Token
    _ = Bool
    False

    isBegin, isEnd :: Token -> Bool
    isBegin :: Token -> Bool
    isBegin (Begin String
    _) = Bool
    True
    isBegin Token
    _ = Bool
    False
    isEnd :: Token -> Bool
    isEnd (End String
    _) = Bool
    True
    isEnd Token
    _ = Bool
    False

    isErrorTok :: Token -> Bool
    isErrorTok :: Token -> Bool
    isErrorTok = String -> Token -> Bool
    isSpecial String
    "!"