    {-# LANGUAGE OverloadedStrings #-}
    {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
    {-# OPTIONS_HADDOCK show-extensions #-}

    -- |
    -- Module      :  Yi.Syntax.Strokes.Haskell
    -- License     :  GPL-2
    -- Maintainer  :  yi-devel@googlegroups.com
    -- Stability   :  experimental
    -- Portability :  portable
    --
    -- Produces 'Stroke's from a tree of tokens, used by some of the
    -- Haskell modes.

    module Yi.Syntax.Strokes.Haskell (getStrokes, tokenToAnnot) where

    import           Prelude           hiding (any, error, exp)

    import           Data.Foldable     (any)
    import           Data.Monoid       (Endo (..), (<>))
    import           Yi.Debug          (error, trace)
    import           Yi.Lexer.Alex     (Posn (posnOfs), Stroke, Tok (tokPosn, tokT), tokToSpan)
    import           Yi.Lexer.Haskell
    import           Yi.String         (showT)
    import           Yi.Style
    import           Yi.Syntax         (Point, Span)
    import           Yi.Syntax.Haskell
    import           Yi.Syntax.Tree    (subtrees)

    -- TODO: (optimization) make sure we take in account the begin, so we
    -- don't return useless strokes
    getStrokes :: Point -> Point -> Point -> Tree TT -> [Stroke]
    getStrokes :: Point -> Point -> Point -> Tree TT -> [Stroke]
    getStrokes Point
    point Point
    begin Point
    _end Tree TT
    t0 = Text -> [Stroke] -> [Stroke]
    forall a. Text -> a -> a
    trace (Tree TT -> Text
    forall a. Show a => a -> Text
    showT Tree TT
    t0) [Stroke]
    result
        where result :: [Stroke]
    result = Endo [Stroke] -> [Stroke] -> [Stroke]
    forall a. Endo a -> a -> a
    appEndo ((TT -> Endo [Stroke])
    -> Point -> Point -> Point -> Tree TT -> Endo [Stroke]
    getStr TT -> Endo [Stroke]
    tkDConst Point
    point Point
    begin Point
    _end Tree TT
    t0) []

    -- | Get strokes Module for module
    getStrokeMod :: Point -> Point -> Point -> PModuleDecl TT -> Endo [Stroke]
    getStrokeMod :: Point -> Point -> Point -> Tree TT -> Endo [Stroke]
    getStrokeMod Point
    point Point
    begin Point
    _end tm :: Tree TT
    tm@(PModuleDecl Tree TT
    m Tree TT
    na Tree TT
    e Tree TT
    w)
        = Tree TT -> Tree TT -> Endo [Stroke]
    forall {v :: * -> *}.
    Foldable v =>
    v TT -> Tree TT -> Endo [Stroke]
    pKW Tree TT
    tm Tree TT
    m Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> (TT -> Endo [Stroke])
    -> Point -> Point -> Point -> Tree TT -> Endo [Stroke]
    getStr TT -> Endo [Stroke]
    tkImport Point
    point Point
    begin Point
    _end Tree TT
    na
       Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> Tree TT -> Endo [Stroke]
    getStrokes' Tree TT
    e Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> Tree TT -> Endo [Stroke]
    getStrokes' Tree TT
    w
            where getStrokes' :: Tree TT -> Endo [Stroke]
    getStrokes' = (TT -> Endo [Stroke])
    -> Point -> Point -> Point -> Tree TT -> Endo [Stroke]
    getStr TT -> Endo [Stroke]
    tkDConst Point
    point Point
    begin Point
    _end
                  pKW :: v TT -> Tree TT -> Endo [Stroke]
    pKW v TT
    b Tree TT
    word | v TT -> Bool
    forall (v :: * -> *). Foldable v => v TT -> Bool
    isErrN v TT
    b = StyleName -> Tree TT -> Endo [Stroke]
    paintAtom StyleName
    errorStyle Tree TT
    word
                             | Bool
    otherwise = Tree TT -> Endo [Stroke]
    getStrokes' Tree TT
    word

    -- | Get strokes for Imports
    getStrokeImp ::  Point -> Point -> Point -> PImport TT -> Endo [Stroke]
    getStrokeImp :: Point -> Point -> Point -> Tree TT -> Endo [Stroke]
    getStrokeImp Point
    point Point
    begin Point
    _end imp :: Tree TT
    imp@(PImport Tree TT
    m Tree TT
    qu Tree TT
    na Tree TT
    t Tree TT
    t')
        = Tree TT -> Tree TT -> Endo [Stroke]
    forall {v :: * -> *}.
    Foldable v =>
    v TT -> Tree TT -> Endo [Stroke]
    pKW Tree TT
    imp Tree TT
    m Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> Tree TT -> Endo [Stroke]
    paintQu Tree TT
    qu
       Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> (TT -> Endo [Stroke])
    -> Point -> Point -> Point -> Tree TT -> Endo [Stroke]
    getStr TT -> Endo [Stroke]
    tkImport Point
    point Point
    begin Point
    _end Tree TT
    na Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> Tree TT -> Endo [Stroke]
    paintAs Tree TT
    t  Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> Tree TT -> Endo [Stroke]
    paintHi Tree TT
    t'
        where getStrokes' :: Tree TT -> Endo [Stroke]
    getStrokes' = (TT -> Endo [Stroke])
    -> Point -> Point -> Point -> Tree TT -> Endo [Stroke]
    getStr TT -> Endo [Stroke]
    tkDConst Point
    point Point
    begin Point
    _end
              paintAs :: Tree TT -> Endo [Stroke]
    paintAs (Opt (Just (Bin (PAtom TT
    n [TT]
    c) Tree TT
    tw)))
                  = Stroke -> Endo [Stroke]
    one (((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 (StyleName -> Token -> StyleName
    forall a b. a -> b -> a
    const StyleName
    keywordStyle) (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) TT
    n) Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> [TT] -> Endo [Stroke]
    com [TT]
    c
                 Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> (TT -> Endo [Stroke])
    -> Point -> Point -> Point -> Tree TT -> Endo [Stroke]
    getStr TT -> Endo [Stroke]
    tkImport Point
    point Point
    begin Point
    _end Tree TT
    tw
              paintAs Tree TT
    a = Tree TT -> Endo [Stroke]
    getStrokes' Tree TT
    a
              paintQu :: Tree TT -> Endo [Stroke]
    paintQu (Opt (Just (PAtom TT
    n [TT]
    c))) = Stroke -> Endo [Stroke]
    one (((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 (StyleName -> Token -> StyleName
    forall a b. a -> b -> a
    const StyleName
    keywordStyle) (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) TT
    n) Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> [TT] -> Endo [Stroke]
    com [TT]
    c
              paintQu Tree TT
    a = Tree TT -> Endo [Stroke]
    getStrokes' Tree TT
    a
              paintHi :: Tree TT -> Endo [Stroke]
    paintHi (TC (Bin (Bin (PAtom TT
    n [TT]
    c) Tree TT
    tw) Tree TT
    r)) = Stroke -> Endo [Stroke]
    one (((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 (StyleName -> Token -> StyleName
    forall a b. a -> b -> a
    const StyleName
    keywordStyle) (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) TT
    n)
                                                 Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> [TT] -> Endo [Stroke]
    com [TT]
    c Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> (TT -> Endo [Stroke])
    -> Point -> Point -> Point -> Tree TT -> Endo [Stroke]
    getStr TT -> Endo [Stroke]
    tkImport Point
    point Point
    begin Point
    _end Tree TT
    tw
                                                 Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> Tree TT -> Endo [Stroke]
    getStrokes' Tree TT
    r
              paintHi Tree TT
    a = Tree TT -> Endo [Stroke]
    getStrokes' Tree TT
    a
              pKW :: v TT -> Tree TT -> Endo [Stroke]
    pKW v TT
    b Tree TT
    word | v TT -> Bool
    forall (v :: * -> *). Foldable v => v TT -> Bool
    isErrN v TT
    b = StyleName -> Tree TT -> Endo [Stroke]
    paintAtom StyleName
    errorStyle Tree TT
    word
                         | Bool
    otherwise = Tree TT -> Endo [Stroke]
    getStrokes' Tree TT
    word

    -- | Get strokes for expressions and declarations
    getStr :: (TT -> Endo [Stroke]) -> Point -> Point -> Point -> Exp TT
              -> Endo [Stroke]
    getStr :: (TT -> Endo [Stroke])
    -> Point -> Point -> Point -> Tree TT -> Endo [Stroke]
    getStr TT -> Endo [Stroke]
    tk Point
    point Point
    begin Point
    _end = Tree TT -> Endo [Stroke]
    getStrokes'
        where getStrokes' :: Exp TT -> Endo [Stroke]
              getStrokes' :: Tree TT -> Endo [Stroke]
    getStrokes' t :: Tree TT
    t@(PImport {}) = Point -> Point -> Point -> Tree TT -> Endo [Stroke]
    getStrokeImp Point
    point Point
    begin Point
    _end Tree TT
    t
              getStrokes' t :: Tree TT
    t@(PModuleDecl {}) = Point -> Point -> Point -> Tree TT -> Endo [Stroke]
    getStrokeMod Point
    point Point
    begin Point
    _end Tree TT
    t
              getStrokes' (PModule [TT]
    c Maybe (Tree TT)
    m) = [TT] -> Endo [Stroke]
    com [TT]
    c Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> (Tree TT -> Endo [Stroke]) -> Maybe (Tree TT) -> Endo [Stroke]
    forall m a. Monoid m => (a -> m) -> Maybe a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Tree TT -> Endo [Stroke]
    getStrokes' Maybe (Tree TT)
    m
              getStrokes' (PAtom TT
    t [TT]
    c) = TT -> Endo [Stroke]
    tk TT
    t Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> [TT] -> Endo [Stroke]
    com [TT]
    c
              getStrokes' (TS TT
    col [Tree TT]
    ts') = TT -> Endo [Stroke]
    tk TT
    col Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> (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 ((TT -> Endo [Stroke])
    -> Point -> Point -> Point -> Tree TT -> Endo [Stroke]
    getStr TT -> Endo [Stroke]
    tkTConst Point
    point Point
    begin Point
    _end) [Tree TT]
    ts'
              getStrokes' (Modid TT
    t [TT]
    c) = TT -> Endo [Stroke]
    tkImport TT
    t Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> [TT] -> Endo [Stroke]
    com [TT]
    c
              getStrokes' (Paren (PAtom TT
    l [TT]
    c) [Tree TT]
    g (PAtom TT
    r [TT]
    c'))
                  | TT -> Bool
    isErr TT
    r = TT -> Endo [Stroke]
    errStyle 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
                   = StyleName -> TT -> Endo [Stroke]
    pStyle StyleName
    hintStyle TT
    l Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> [TT] -> Endo [Stroke]
    com [TT]
    c 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
    <> StyleName -> TT -> Endo [Stroke]
    pStyle StyleName
    hintStyle TT
    r Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> [TT] -> Endo [Stroke]
    com [TT]
    c'
                  | Bool
    otherwise  = TT -> Endo [Stroke]
    tk TT
    l Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> [TT] -> Endo [Stroke]
    com [TT]
    c 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
    <> TT -> Endo [Stroke]
    tk TT
    r Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> [TT] -> Endo [Stroke]
    com [TT]
    c'
              getStrokes' (PError TT
    t TT
    _ [TT]
    c) = TT -> Endo [Stroke]
    errStyle TT
    t Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> [TT] -> Endo [Stroke]
    com [TT]
    c
              getStrokes' da :: Tree TT
    da@(PData Tree TT
    kw Tree TT
    na Tree TT
    exp Tree TT
    eq)
                   = Tree TT -> Tree TT -> Endo [Stroke]
    forall {v :: * -> *}.
    Foldable v =>
    v TT -> Tree TT -> Endo [Stroke]
    pKW Tree TT
    da Tree TT
    kw Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> Tree TT -> Endo [Stroke]
    getStrokes' Tree TT
    na
                  Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> Tree TT -> Endo [Stroke]
    getStrokes' Tree TT
    exp Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> Tree TT -> Endo [Stroke]
    getStrokes' Tree TT
    eq
              getStrokes' (PIn TT
    t [Tree TT]
    l) = TT -> Endo [Stroke]
    tk TT
    t Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> [Tree TT] -> Endo [Stroke]
    getStrokesL [Tree TT]
    l
              getStrokes' (TC Tree TT
    l) = (TT -> Endo [Stroke])
    -> Point -> Point -> Point -> Tree TT -> Endo [Stroke]
    getStr TT -> Endo [Stroke]
    tkTConst Point
    point Point
    begin Point
    _end Tree TT
    l
              getStrokes' (DC (PAtom TT
    l [TT]
    c)) = TT -> Endo [Stroke]
    tkDConst TT
    l Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> [TT] -> Endo [Stroke]
    com [TT]
    c
              getStrokes' (DC Tree TT
    r) = Tree TT -> Endo [Stroke]
    getStrokes' Tree TT
    r -- do not color operator dc
              getStrokes' g :: Tree TT
    g@(PGuard' Tree TT
    t Tree TT
    e Tree TT
    t')
                  = Tree TT -> Tree TT -> Endo [Stroke]
    forall {v :: * -> *}.
    Foldable v =>
    v TT -> Tree TT -> Endo [Stroke]
    pKW Tree TT
    g Tree TT
    t Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> Tree TT -> Endo [Stroke]
    getStrokes' Tree TT
    e Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> Tree TT -> Endo [Stroke]
    getStrokes' Tree TT
    t'
              getStrokes' cl :: Tree TT
    cl@(PClass Tree TT
    e Tree TT
    e' Tree TT
    exp)
                  = Tree TT -> Tree TT -> Endo [Stroke]
    forall {v :: * -> *}.
    Foldable v =>
    v TT -> Tree TT -> Endo [Stroke]
    pKW Tree TT
    cl Tree TT
    e Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> Tree TT -> Endo [Stroke]
    getStrokes' Tree TT
    e'
                 Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> Tree TT -> Endo [Stroke]
    getStrokes' Tree TT
    exp
              getStrokes' Tree TT
    t = (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' (Tree TT -> [Tree TT]
    forall t. Exp t -> [Exp t]
    forall (tree :: * -> *) t. IsTree tree => tree t -> [tree t]
    subtrees Tree TT
    t) -- by default deal with subtrees
              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'
              pKW :: v TT -> Tree TT -> Endo [Stroke]
    pKW v TT
    b Tree TT
    word | v TT -> Bool
    forall (v :: * -> *). Foldable v => v TT -> Bool
    isErrN v TT
    b = StyleName -> Tree TT -> Endo [Stroke]
    paintAtom StyleName
    errorStyle Tree TT
    word
                         | Bool
    otherwise = Tree TT -> Endo [Stroke]
    getStrokes' Tree TT
    word

    -- Stroke helpers follows

    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

    ts :: TT -> Stroke
    ts :: TT -> Stroke
    ts = TT -> Stroke
    tokenToStroke

    pStyle :: StyleName -> TT -> Endo [Stroke]
    pStyle :: StyleName -> TT -> Endo [Stroke]
    pStyle StyleName
    style = Stroke -> Endo [Stroke]
    one (Stroke -> Endo [Stroke]) -> (TT -> Stroke) -> TT -> Endo [Stroke]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StyleName -> Stroke -> Stroke
    modStroke StyleName
    style (Stroke -> Stroke) -> (TT -> Stroke) -> TT -> Stroke
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TT -> Stroke
    ts

    one :: Stroke -> Endo [Stroke]
    one :: Stroke -> Endo [Stroke]
    one Stroke
    x = ([Stroke] -> [Stroke]) -> Endo [Stroke]
    forall a. (a -> a) -> Endo a
    Endo (Stroke
    x Stroke -> [Stroke] -> [Stroke]
    forall a. a -> [a] -> [a]
    :)

    paintAtom :: StyleName -> Exp TT -> Endo [Stroke]
    paintAtom :: StyleName -> Tree TT -> Endo [Stroke]
    paintAtom StyleName
    col (PAtom TT
    a [TT]
    c) = StyleName -> TT -> Endo [Stroke]
    pStyle StyleName
    col TT
    a Endo [Stroke] -> Endo [Stroke] -> Endo [Stroke]
    forall a. Semigroup a => a -> a -> a
    <> [TT] -> Endo [Stroke]
    com [TT]
    c
    paintAtom StyleName
    _ Tree TT
    _ = Text -> Endo [Stroke]
    forall a. Text -> a
    error Text
    "wrong usage of paintAtom"

    isErr :: TT -> Bool
    isErr :: TT -> Bool
    isErr = Token -> Bool
    isErrorTok (Token -> Bool) -> (TT -> Token) -> TT -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TT -> Token
    forall t. Tok t -> t
    tokT

    isErrN :: (Foldable v) => v TT -> Bool
    isErrN :: forall (v :: * -> *). Foldable v => v TT -> Bool
    isErrN = (TT -> Bool) -> v TT -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any TT -> Bool
    isErr
    --
    --         || not $ null $ isError' t

    errStyle :: TT -> Endo [Stroke]
    errStyle :: TT -> Endo [Stroke]
    errStyle = StyleName -> TT -> Endo [Stroke]
    pStyle StyleName
    errorStyle

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

    com :: [TT] -> Endo [Stroke]
    com :: [TT] -> Endo [Stroke]
    com = (TT -> Endo [Stroke]) -> [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 TT -> Endo [Stroke]
    tkDConst

    tk' :: (TT -> Bool) -> (TT -> Endo [Stroke]) -> TT -> Endo [Stroke]
    tk' :: (TT -> Bool) -> (TT -> Endo [Stroke]) -> TT -> Endo [Stroke]
    tk' TT -> Bool
    f TT -> Endo [Stroke]
    s TT
    t | TT -> Bool
    isErr TT
    t = TT -> Endo [Stroke]
    errStyle TT
    t
              | TT -> Token
    forall t. Tok t -> t
    tokT TT
    t Token -> [Token] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` (ReservedType -> Token) -> [ReservedType] -> [Token]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ReservedType -> Token
    Reserved [ReservedType
    As, ReservedType
    Qualified, ReservedType
    Hiding]
                = Stroke -> Endo [Stroke]
    one (Stroke -> Endo [Stroke]) -> Stroke -> Endo [Stroke]
    forall a b. (a -> b) -> a -> b
    $ ((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 (StyleName -> Token -> StyleName
    forall a b. a -> b -> a
    const StyleName
    variableStyle) (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) TT
    t
              | TT -> Bool
    f TT
    t = TT -> Endo [Stroke]
    s TT
    t
              | Bool
    otherwise = Stroke -> Endo [Stroke]
    one (TT -> Stroke
    ts TT
    t)

    tkTConst :: TT -> Endo [Stroke]
    tkTConst :: TT -> Endo [Stroke]
    tkTConst = (TT -> Bool) -> (TT -> Endo [Stroke]) -> TT -> Endo [Stroke]
    tk' (Bool -> TT -> Bool
    forall a b. a -> b -> a
    const Bool
    False) (Endo [Stroke] -> TT -> Endo [Stroke]
    forall a b. a -> b -> a
    const (([Stroke] -> [Stroke]) -> Endo [Stroke]
    forall a. (a -> a) -> Endo a
    Endo [Stroke] -> [Stroke]
    forall a. a -> a
    id))

    tkDConst :: TT -> Endo [Stroke]
    tkDConst :: TT -> Endo [Stroke]
    tkDConst = (TT -> Bool) -> (TT -> Endo [Stroke]) -> TT -> Endo [Stroke]
    tk' ((Token -> Token -> Bool
    forall a. Eq a => a -> a -> Bool
    == Token
    ConsIdent) (Token -> Bool) -> (TT -> Token) -> TT -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TT -> Token
    forall t. Tok t -> t
    tokT) (StyleName -> TT -> Endo [Stroke]
    pStyle StyleName
    dataConstructorStyle)

    tkImport :: TT -> Endo [Stroke]
    tkImport :: TT -> Endo [Stroke]
    tkImport = (TT -> Bool) -> (TT -> Endo [Stroke]) -> TT -> Endo [Stroke]
    tk' ((Token -> Token -> Bool
    forall a. Eq a => a -> a -> Bool
    == Token
    ConsIdent) (Token -> Bool) -> (TT -> Token) -> TT -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TT -> Token
    forall t. Tok t -> t
    tokT) (StyleName -> TT -> Endo [Stroke]
    pStyle StyleName
    importStyle)