    {-# LANGUAGE DeriveFoldable #-}
    {-# LANGUAGE DeriveFunctor  #-}
    {-# OPTIONS_HADDOCK show-extensions #-}

    -- |
    -- Module      :  Yi.Syntax.Paren
    -- License     :  GPL-2
    -- Maintainer  :  yi-devel@googlegroups.com
    -- Stability   :  experimental
    -- Portability :  portable
    --
    -- Parser for Haskell that only cares about parenthesis and layout.

    module Yi.Syntax.Paren where

    import Prelude hiding (elem)

    import           Control.Applicative (Alternative ((<|>), many))
    import           Data.Foldable       (elem, toList)
    import           Data.Maybe          (listToMaybe)
    import           Data.Monoid         (Endo (Endo, appEndo), (<>))
    import           Yi.IncrementalParse (P, Parser, eof, lookNext, recoverWith, symbol)
    import           Yi.Lexer.Alex       hiding (tokenToStyle)
    import           Yi.Lexer.Haskell
    import           Yi.Style            (StyleName, errorStyle, hintStyle)
    import           Yi.Syntax           (Point, Scanner, Span)
    import           Yi.Syntax.Layout    (State, layoutHandler)
    import           Yi.Syntax.Tree

    indentScanner :: Scanner (AlexState lexState) TT
                  -> Scanner (Yi.Syntax.Layout.State Token lexState) TT
    indentScanner :: forall lexState.
    Scanner (AlexState lexState) TT
    -> Scanner (State Token lexState) TT
    indentScanner = (Token -> Bool)
    -> [(Token, Token)]
    -> (TT -> Bool)
    -> (Token, Token, Token)
    -> (TT -> Bool)
    -> Scanner (AlexState lexState) TT
    -> Scanner (State Token lexState) TT
    forall t lexState.
    (Show t, Eq t) =>
    (t -> Bool)
    -> [(t, t)]
    -> (Tok t -> Bool)
    -> (t, t, t)
    -> (Tok t -> Bool)
    -> Scanner (AlexState lexState) (Tok t)
    -> Scanner (State t lexState) (Tok t)
    layoutHandler Token -> Bool
    startsLayout [(Char -> Token
    Special Char
    '(', Char -> Token
    Special Char
    ')'),
                                                (Char -> Token
    Special Char
    '[', Char -> Token
    Special Char
    ']'),
                                                (Char -> Token
    Special Char
    '{', Char -> Token
    Special Char
    '}')] TT -> Bool
    ignoredToken
                             (Char -> Token
    Special Char
    '<', Char -> Token
    Special Char
    '>', Char -> Token
    Special Char
    '.') TT -> Bool
    isBrace

    -- HACK: We insert the Special '<', '>', '.', that don't occur in normal haskell
    -- parsing.

    isBrace :: TT -> Bool
    isBrace :: TT -> Bool
    isBrace (Tok Token
    b Size
    _ Posn
    _) = Char -> Token
    Special Char
    '{' Token -> Token -> Bool
    forall a. Eq a => a -> a -> Bool
    == Token
    b

    ignoredToken :: TT -> Bool
    ignoredToken :: TT -> Bool
    ignoredToken (Tok Token
    t Size
    _ Posn
    _) = Token -> Bool
    isComment Token
    t Bool -> Bool -> Bool
    || Token
    t Token -> Token -> Bool
    forall a. Eq a => a -> a -> Bool
    == Token
    CppDirective

    isNoise :: Token -> Bool
    isNoise :: Token -> Bool
    isNoise (Special Char
    c) = Char
    c Char -> [Char] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ([Char]
    ";,`" :: String)
    isNoise Token
    _ = Bool
    True

    type Expr t = [Tree t]

    data Tree t
        = Paren t (Expr t) t -- A parenthesized expression (maybe with [ ] ...)
        | Block ([Tree t])      -- A list of things separated by layout (as in do; etc.)
        | Atom t
        | Error t
        | Expr [Tree t]
          deriving (Int -> Tree t -> ShowS
    [Tree t] -> ShowS
    Tree t -> [Char]
    (Int -> Tree t -> ShowS)
    -> (Tree t -> [Char]) -> ([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 -> [Char]
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([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 -> [Char]
    show :: Tree t -> [Char]
    $cshowList :: forall t. Show t => [Tree t] -> ShowS
    showList :: [Tree t] -> ShowS
    Show, (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, (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)

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

    -- | Search the given list, and return the 1st tree after the given
    -- point on the given line.  This is the tree that will be moved if
    -- something is inserted at the point.  Precondition: point is in the
    -- given line.

    -- TODO: this should be optimized by just giving the point of the end
    -- of the line
    getIndentingSubtree :: Tree TT -> Point -> Int -> Maybe (Tree TT)
    getIndentingSubtree :: Tree TT -> Point -> Int -> Maybe (Tree TT)
    getIndentingSubtree Tree TT
    root Point
    offset Int
    line =
        [Tree TT] -> Maybe (Tree TT)
    forall a. [a] -> Maybe a
    listToMaybe [Tree TT
    t | (Tree TT
    t,Posn
    posn) <- ((Tree TT, Posn) -> Bool) -> [(Tree TT, Posn)] -> [(Tree TT, Posn)]
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile ((Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    line) (Int -> Bool)
    -> ((Tree TT, Posn) -> Int) -> (Tree TT, Posn) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Posn -> Int
    posnLine (Posn -> Int)
    -> ((Tree TT, Posn) -> Posn) -> (Tree TT, Posn) -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Tree TT, Posn) -> Posn
    forall a b. (a, b) -> b
    snd) [(Tree TT, Posn)]
    allSubTreesPosn,
                    -- it's very important that we do a linear search
                    -- here (takeWhile), so that the tree is evaluated
                    -- lazily and therefore parsing it can be lazy.
                    Posn -> Point
    posnOfs Posn
    posn Point -> Point -> Bool
    forall a. Ord a => a -> a -> Bool
    > Point
    offset, Posn -> Int
    posnLine Posn
    posn Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    line]
        where allSubTreesPosn :: [(Tree TT, Posn)]
    allSubTreesPosn = [(Tree TT
    t',Posn
    posn) | t' :: Tree TT
    t'@(Block [Tree TT]
    _) <-(Tree TT -> Bool) -> [Tree TT] -> [Tree TT]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (Tree TT -> Bool) -> Tree TT -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [TT] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([TT] -> Bool) -> (Tree TT -> [TT]) -> Tree TT -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Tree TT -> [TT]
    forall a. Tree a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList) (Tree TT -> [Tree TT]
    forall (tree :: * -> *) t. IsTree tree => tree t -> [tree t]
    getAllSubTrees Tree TT
    root),
                                 let (TT
    tok:[TT]
    _) = Tree TT -> [TT]
    forall a. Tree a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList Tree TT
    t',
                                 let posn :: Posn
    posn = TT -> Posn
    forall t. Tok t -> Posn
    tokPosn TT
    tok]

    -- | Given a tree, return (first offset, number of lines).
    getSubtreeSpan :: Tree TT -> (Point, Int)
    getSubtreeSpan :: Tree TT -> (Point, Int)
    getSubtreeSpan Tree TT
    tree = (Posn -> Point
    posnOfs Posn
    first, Int
    lastLine Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    firstLine)
        where bounds :: [Posn]
    bounds@[Posn
    first, Posn
    _last] = (Maybe TT -> Posn) -> [Maybe TT] -> [Posn]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (TT -> Posn
    forall t. Tok t -> Posn
    tokPosn (TT -> Posn) -> (Maybe TT -> TT) -> Maybe TT -> Posn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe TT -> TT
    forall {a}. Maybe a -> a
    assertJust) [Tree TT -> Maybe TT
    forall (t :: * -> *) a. Foldable t => t a -> Maybe a
    getFirstElement Tree TT
    tree, Tree TT -> Maybe TT
    forall (t :: * -> *) a. Foldable t => t a -> Maybe a
    getLastElement Tree TT
    tree]
              [Int
    firstLine, Int
    lastLine] = (Posn -> Int) -> [Posn] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Posn -> Int
    posnLine [Posn]
    bounds
              assertJust :: Maybe a -> a
    assertJust (Just a
    x) = a
    x
              assertJust Maybe a
    _ = [Char] -> a
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "assertJust: Just expected"

    -- dropWhile' f = foldMap (\x -> if f x then mempty else Endo (x :))
    --
    -- isBefore l (Atom t) = isBefore' l t
    -- isBefore l (Error t) = isBefore l t
    -- isBefore l (Paren l g r) = isBefore l r
    -- isBefore l (Block s) = False
    --
    -- isBefore' l (Tok {tokPosn = Posn {posnLn = l'}}) =

    parse :: P TT (Tree TT)
    parse :: P TT (Tree TT)
    parse = [Tree TT] -> Tree TT
    forall t. [Tree t] -> Tree t
    Expr ([Tree TT] -> Tree TT) -> Parser TT [Tree TT] -> P TT (Tree TT)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (TT -> Token) -> (Token -> TT) -> Parser TT [Tree TT]
    parse' TT -> Token
    forall t. Tok t -> t
    tokT Token -> TT
    forall t. t -> Tok t
    tokFromT

    parse' :: (TT -> Token) -> (Token -> TT) -> P TT [Tree TT]
    parse' :: (TT -> Token) -> (Token -> TT) -> Parser TT [Tree TT]
    parse' TT -> Token
    toTok Token -> TT
    _ = Parser TT [Tree TT]
    pExpr Parser TT [Tree TT] -> Parser TT () -> Parser 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
          -- parse a special symbol
          sym :: Char -> Parser TT TT
    sym Char
    c = (TT -> Bool) -> Parser TT TT
    forall s. (s -> Bool) -> Parser s s
    symbol ([Char] -> Token -> Bool
    isSpecial [Char
    c] (Token -> Bool) -> (TT -> Token) -> TT -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TT -> Token
    toTok)

          pleaseSym :: Char -> Parser TT TT
    pleaseSym Char
    c = Parser TT TT -> Parser TT TT
    forall s a. Parser s a -> Parser s a
    recoverWith Parser TT TT
    forall t. Parser (Tok t) TT
    errTok 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
    <|> Char -> Parser TT TT
    sym Char
    c

          pExpr :: P TT (Expr TT)
          pExpr :: Parser TT [Tree TT]
    pExpr = P TT (Tree TT) -> Parser TT [Tree TT]
    forall a. Parser TT a -> Parser TT [a]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    many P TT (Tree TT)
    pTree

          pBlocks :: Parser TT [Tree TT]
    pBlocks = ([Tree TT] -> Tree TT
    forall t. [Tree t] -> Tree t
    Expr ([Tree TT] -> Tree TT) -> Parser TT [Tree TT] -> P TT (Tree TT)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser TT [Tree TT]
    pExpr) P TT (Tree TT) -> Parser TT TT -> Parser TT [Tree TT]
    forall (f :: * -> *) a v. Alternative f => f a -> f v -> f [a]
    `sepBy1` Char -> Parser TT TT
    sym Char
    '.' -- the '.' is generated by the layout, see HACK above
          -- note that we can have empty statements, hence we use sepBy1.

          pTree :: P TT (Tree TT)
          pTree :: P TT (Tree TT)
    pTree = (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
    <$>  Char -> Parser TT TT
    sym Char
    '(' Parser TT ([Tree TT] -> TT -> Tree TT)
    -> Parser 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
    <*> Parser TT [Tree TT]
    pExpr  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
    <*> Char -> Parser TT TT
    pleaseSym Char
    ')')
              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
    <$>  Char -> Parser TT TT
    sym Char
    '[' Parser TT ([Tree TT] -> TT -> Tree TT)
    -> Parser 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
    <*> Parser TT [Tree TT]
    pExpr  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
    <*> Char -> Parser TT TT
    pleaseSym Char
    ']')
              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
    <$>  Char -> Parser TT TT
    sym Char
    '{' Parser TT ([Tree TT] -> TT -> Tree TT)
    -> Parser 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
    <*> Parser TT [Tree TT]
    pExpr  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
    <*> Char -> Parser TT TT
    pleaseSym Char
    '}')

              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
    <|> ([Tree TT] -> Tree TT
    forall t. [Tree t] -> Tree t
    Block ([Tree TT] -> Tree TT) -> Parser TT [Tree TT] -> P TT (Tree TT)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Char -> Parser TT TT
    sym Char
    '<' Parser TT TT -> Parser TT [Tree TT] -> Parser TT [Tree TT]
    forall a b. Parser TT a -> Parser TT b -> Parser TT b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser TT [Tree TT]
    pBlocks Parser TT [Tree TT] -> Parser TT TT -> Parser 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
    <* Char -> Parser TT TT
    sym Char
    '>')) -- see HACK above

              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
    <$> (TT -> Bool) -> Parser TT TT
    forall s. (s -> Bool) -> Parser s s
    symbol (Token -> Bool
    isNoise (Token -> Bool) -> (TT -> Token) -> TT -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TT -> Token
    toTok))
              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 ((TT -> Bool) -> Parser TT TT
    forall s. (s -> Bool) -> Parser s s
    symbol ([Char] -> Token -> Bool
    isSpecial [Char]
    "})]" (Token -> Bool) -> (TT -> Token) -> TT -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TT -> Token
    toTok)))

          -- note that, by construction, '<' and '>' will always be matched, so
          -- we don't try to recover errors with them.

    getStrokes :: Point -> Point -> Point -> Tree TT -> [Stroke]
    getStrokes :: Point -> Point -> Point -> Tree TT -> [Stroke]
    getStrokes Point
    point Point
    _begin Point
    _end Tree TT
    t0 = -- trace (show t0)
                                      [Stroke]
    result
        where getStrokes' :: Tree TT -> Endo [Stroke]
    getStrokes' (Atom TT
    t) = Stroke -> Endo [Stroke]
    forall {a}. a -> Endo [a]
    one (TT -> Stroke
    ts TT
    t)
              getStrokes' (Error TT
    t) = Stroke -> Endo [Stroke]
    forall {a}. a -> Endo [a]
    one (StyleName -> Stroke -> Stroke
    modStroke StyleName
    errorStyle (TT -> Stroke
    ts TT
    t)) -- paint in red
              getStrokes' (Block [Tree TT]
    s) = [Tree TT] -> Endo [Stroke]
    getStrokesL [Tree TT]
    s
              getStrokes' (Expr [Tree TT]
    g) = [Tree TT] -> Endo [Stroke]
    getStrokesL [Tree TT]
    g
              getStrokes' (Paren TT
    l [Tree TT]
    g TT
    r)
                  | Token -> Bool
    isErrorTok (Token -> Bool) -> Token -> Bool
    forall a b. (a -> b) -> a -> b
    $ TT -> Token
    forall t. Tok t -> t
    tokT TT
    r = Stroke -> Endo [Stroke]
    forall {a}. a -> Endo [a]
    one (StyleName -> Stroke -> Stroke
    modStroke StyleName
    errorStyle (TT -> Stroke
    ts TT
    l)) Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> [Tree TT] -> Endo [Stroke]
    getStrokesL [Tree TT]
    g
                  -- 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
                   = Stroke -> Endo [Stroke]
    forall {a}. a -> Endo [a]
    one (StyleName -> Stroke -> Stroke
    modStroke StyleName
    hintStyle (TT -> Stroke
    ts TT
    l)) Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> [Tree TT] -> Endo [Stroke]
    getStrokesL [Tree TT]
    g Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> Stroke -> Endo [Stroke]
    forall {a}. a -> Endo [a]
    one (StyleName -> Stroke -> Stroke
    modStroke StyleName
    hintStyle (TT -> Stroke
    ts TT
    r))
                  | Bool
    otherwise  = Stroke -> Endo [Stroke]
    forall {a}. a -> Endo [a]
    one (TT -> Stroke
    ts TT
    l) Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> [Tree TT] -> Endo [Stroke]
    getStrokesL [Tree TT]
    g Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> Stroke -> Endo [Stroke]
    forall {a}. a -> Endo [a]
    one (TT -> Stroke
    ts TT
    r)
              getStrokesL :: [Tree TT] -> Endo [Stroke]
    getStrokesL = (Tree TT -> Endo [Stroke]) -> [Tree 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 :: TT -> Stroke
    ts = TT -> Stroke
    tokenToStroke
              result :: [Stroke]
    result = Endo [Stroke] -> [Stroke] -> [Stroke]
    forall a. Endo a -> a -> a
    appEndo (Tree TT -> Endo [Stroke]
    getStrokes' Tree TT
    t0) []
              one :: a -> Endo [a]
    one a
    x = ([a] -> [a]) -> Endo [a]
    forall a. (a -> a) -> Endo a
    Endo (a
    x a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :)

    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

    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`)

    tokenToAnnot :: TT -> Maybe (Span String)
    tokenToAnnot :: TT -> Maybe (Span [Char])
    tokenToAnnot = Span (Maybe [Char]) -> Maybe (Span [Char])
    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 [Char]) -> Maybe (Span [Char]))
    -> (TT -> Span (Maybe [Char])) -> TT -> Maybe (Span [Char])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Tok (Maybe [Char]) -> Span (Maybe [Char])
    forall t. Tok t -> Span t
    tokToSpan (Tok (Maybe [Char]) -> Span (Maybe [Char]))
    -> (TT -> Tok (Maybe [Char])) -> TT -> Span (Maybe [Char])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Token -> Maybe [Char]) -> TT -> Tok (Maybe [Char])
    forall a b. (a -> b) -> Tok a -> Tok b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Token -> Maybe [Char]
    tokenToText

    -- | Create a special error token. (e.g. fill in where there is no correct token to parse)
    -- Note that the position of the token has to be correct for correct computation of
    -- node spans.
    errTok :: Parser (Tok t) (Tok Token)
    errTok :: forall t. Parser (Tok t) TT
    errTok = Point -> TT
    mkTok (Point -> TT) -> Parser (Tok t) Point -> Parser (Tok t) TT
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser (Tok t) Point
    forall {t}. Parser (Tok t) Point
    curPos
       where curPos :: Parser (Tok t) Point
    curPos = Maybe (Tok t) -> Point
    forall {t}. Maybe (Tok t) -> Point
    tB (Maybe (Tok t) -> Point)
    -> Parser (Tok t) (Maybe (Tok t)) -> Parser (Tok t) Point
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser (Tok t) (Maybe (Tok t))
    forall s. Parser s (Maybe s)
    lookNext
             tB :: Maybe (Tok t) -> Point
    tB Maybe (Tok t)
    Nothing = Point
    forall a. Bounded a => a
    maxBound
             tB (Just Tok t
    x) = Tok t -> Point
    forall t. Tok t -> Point
    tokBegin Tok t
    x
             mkTok :: Point -> TT
    mkTok Point
    p = Token -> Size -> Posn -> TT
    forall t. t -> Size -> Posn -> Tok t
    Tok (Char -> Token
    Special Char
    '!') Size
    0 (Posn
    startPosn {posnOfs = p})