module Language.Haskell.HsColour.Anchors
  ( insertAnchors
  ) where

import Language.Haskell.HsColour.Classify
import Language.Haskell.HsColour.General
import Data.List
import Data.Char (isUpper, isLower, isDigit, ord, intToDigit)

-- This is an attempt to find the first defining occurrence of an
-- identifier (function, datatype, class) in a Haskell source file.
-- Rather than parse the module properly, we try to get by with just
-- a finite state automaton.  Keeping a record of identifiers we
-- have already seen, we look at the beginning of every line to see
-- if it starts with the right tokens to introduce a defn.  If so,
-- we look a little bit further until we can be certain.  Then plonk
-- (or not) an anchor at the beginning of the line.

type Anchor = String

-- | 'insertAnchors' places an anchor marker in the token stream before the
--   first defining occurrence of any identifier.  Here, /before/ means
--   immediately preceding its type signature, or preceding a (haddock)
--   comment that comes immediately before the type signature, or failing
--   either of those, before the first equation.
insertAnchors :: [(TokenType,String)] -> [Either Anchor (TokenType,String)]
insertAnchors :: [(TokenType, [Char])] -> [Either [Char] (TokenType, [Char])]
insertAnchors = ST -> [(TokenType, [Char])] -> [Either [Char] (TokenType, [Char])]
anchor ST
emptyST

-- looks at first token in the left-most position of each line
-- precondition: have just seen a newline token.
anchor :: ST -> [(TokenType, String)] -> [Either String (TokenType, String)]
anchor :: ST -> [(TokenType, [Char])] -> [Either [Char] (TokenType, [Char])]
anchor ST
st [(TokenType, [Char])]
s = case ST -> [(TokenType, [Char])] -> Maybe [Char]
identifier ST
st [(TokenType, [Char])]
s of
                Maybe [Char]
Nothing -> ST -> [(TokenType, [Char])] -> [Either [Char] (TokenType, [Char])]
emit ST
st [(TokenType, [Char])]
s
                Just [Char]
v  -> [Char] -> Either [Char] (TokenType, [Char])
forall a b. a -> Either a b
Left ([Char] -> [Char]
escape [Char]
v)Either [Char] (TokenType, [Char])
-> [Either [Char] (TokenType, [Char])]
-> [Either [Char] (TokenType, [Char])]
forall a. a -> [a] -> [a]
: ST -> [(TokenType, [Char])] -> [Either [Char] (TokenType, [Char])]
emit ([Char] -> ST -> ST
insertST [Char]
v ST
st) [(TokenType, [Char])]
s

-- some chars are not valid in anchor URIs: http://www.ietf.org/rfc/rfc3986
-- NOTE: This code assumes characters are 8-bit.
--       Ideally, it should transcode to utf8 octets first.
escape :: String -> String
escape :: [Char] -> [Char]
escape = (Char -> [Char]) -> [Char] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> [Char]
enc
    where enc :: Char -> [Char]
enc Char
x | Char -> Bool
isDigit Char
x
                Bool -> Bool -> Bool
|| Char -> Bool
isURIFragmentValid Char
x
                Bool -> Bool -> Bool
|| Char -> Bool
isLower Char
x
                Bool -> Bool -> Bool
|| Char -> Bool
isUpper Char
x = [Char
x]
                | Char -> Int
ord Char
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
256 = [Char
x] -- not correct, but better than nothing
                | Bool
otherwise  = [Char
'%',Int -> Char
hexHi (Char -> Int
ord Char
x), Int -> Char
hexLo (Char -> Int
ord Char
x)]
          hexHi :: Int -> Char
hexHi Int
d = Int -> Char
intToDigit (Int
dInt -> Int -> Int
forall a. Integral a => a -> a -> a
`div`Int
16)
          hexLo :: Int -> Char
hexLo Int
d = Int -> Char
intToDigit (Int
dInt -> Int -> Int
forall a. Integral a => a -> a -> a
`mod`Int
16)
          isURIFragmentValid :: Char -> Bool
isURIFragmentValid Char
x = Char
x Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
"!$&'()*+,;=/?-._~:@"

-- emit passes stuff through until the next newline has been encountered,
-- then jumps back into the anchor function
-- pre-condition: newlines are explicitly single tokens
emit :: ST -> [(TokenType, String)] -> [Either String (TokenType, String)]
emit :: ST -> [(TokenType, [Char])] -> [Either [Char] (TokenType, [Char])]
emit ST
st (t :: (TokenType, [Char])
t@(TokenType
Space,[Char]
"\n"):[(TokenType, [Char])]
stream) = (TokenType, [Char]) -> Either [Char] (TokenType, [Char])
forall a b. b -> Either a b
Right (TokenType, [Char])
tEither [Char] (TokenType, [Char])
-> [Either [Char] (TokenType, [Char])]
-> [Either [Char] (TokenType, [Char])]
forall a. a -> [a] -> [a]
: ST -> [(TokenType, [Char])] -> [Either [Char] (TokenType, [Char])]
anchor ST
st [(TokenType, [Char])]
stream
emit ST
st ((TokenType, [Char])
t:[(TokenType, [Char])]
stream)              = (TokenType, [Char]) -> Either [Char] (TokenType, [Char])
forall a b. b -> Either a b
Right (TokenType, [Char])
tEither [Char] (TokenType, [Char])
-> [Either [Char] (TokenType, [Char])]
-> [Either [Char] (TokenType, [Char])]
forall a. a -> [a] -> [a]
: ST -> [(TokenType, [Char])] -> [Either [Char] (TokenType, [Char])]
emit ST
st [(TokenType, [Char])]
stream
emit ST
_  []                      = []

-- Given that we are at the beginning of a line, determine whether there
-- is an identifier defined here, and if so, return it.
-- precondition: have just seen a newline token.
identifier ::  ST -> [(TokenType, String)] -> Maybe String
identifier :: ST -> [(TokenType, [Char])] -> Maybe [Char]
identifier ST
st t :: [(TokenType, [Char])]
t@((TokenType
kind,[Char]
v):[(TokenType, [Char])]
stream) | TokenType
kindTokenType -> [TokenType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`[TokenType
Varid,TokenType
Definition] =
    case [(TokenType, [Char])] -> [(TokenType, [Char])]
forall t. [(TokenType, t)] -> [(TokenType, t)]
skip [(TokenType, [Char])]
stream of
        ((TokenType
Varop,[Char]
v):[(TokenType, [Char])]
_) | Bool -> Bool
not ([Char]
v[Char] -> ST -> Bool
`inST`ST
st) -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> [Char]
fix [Char]
v)
        [(TokenType, [Char])]
notVarop  --  | typesig stream  -> Nothing    -- not a defn
                      | [Char]
v [Char] -> ST -> Bool
`inST` ST
st     -> Maybe [Char]
forall a. Maybe a
Nothing    -- already defined
                      | Bool
otherwise       -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
v
identifier ST
st t :: [(TokenType, [Char])]
t@((TokenType
Layout,[Char]
"("):[(TokenType, [Char])]
stream) =
    case [(TokenType, [Char])]
stream of
      ((TokenType
Varop,[Char]
v):(TokenType
Layout,[Char]
")"):[(TokenType, [Char])]
_)
                  --  | typesig stream  -> Nothing
	              | [Char]
v [Char] -> ST -> Bool
`inST` ST
st     -> Maybe [Char]
forall a. Maybe a
Nothing
	              | Bool
otherwise	-> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> [Char]
fix [Char]
v)
      [(TokenType, [Char])]
notVarop -> case [(TokenType, [Char])] -> [(TokenType, [Char])]
forall t. [(TokenType, t)] -> [(TokenType, t)]
skip ([(TokenType, [Char])] -> [(TokenType, [Char])]
munchParens [(TokenType, [Char])]
stream) of
          ((TokenType
Varop,[Char]
v):[(TokenType, [Char])]
_) | Bool -> Bool
not ([Char]
v[Char] -> ST -> Bool
`inST`ST
st) -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> [Char]
fix [Char]
v)
          [(TokenType, [Char])]
_             -> Maybe [Char]
forall a. Maybe a
Nothing
identifier ST
st t :: [(TokenType, [Char])]
t@((TokenType
Keyword,[Char]
"foreign"):[(TokenType, [Char])]
stream) = Maybe [Char]
forall a. Maybe a
Nothing -- not yet implemented
identifier ST
st t :: [(TokenType, [Char])]
t@((TokenType
Keyword,[Char]
"data"):(TokenType
Space,[Char]
_):(TokenType
Keyword,[Char]
"family"):[(TokenType, [Char])]
stream)
                                             = [(TokenType, [Char])] -> Maybe [Char]
getConid [(TokenType, [Char])]
stream
identifier ST
st t :: [(TokenType, [Char])]
t@((TokenType
Keyword,[Char]
"data"):[(TokenType, [Char])]
stream)    = [(TokenType, [Char])] -> Maybe [Char]
getConid [(TokenType, [Char])]
stream
identifier ST
st t :: [(TokenType, [Char])]
t@((TokenType
Keyword,[Char]
"newtype"):[(TokenType, [Char])]
stream) = [(TokenType, [Char])] -> Maybe [Char]
getConid [(TokenType, [Char])]
stream
identifier ST
st t :: [(TokenType, [Char])]
t@((TokenType
Keyword,[Char]
"type"):(TokenType
Space,[Char]
_):(TokenType
Keyword,[Char]
"family"):[(TokenType, [Char])]
stream)
                                             = [(TokenType, [Char])] -> Maybe [Char]
getConid [(TokenType, [Char])]
stream
identifier ST
st t :: [(TokenType, [Char])]
t@((TokenType
Keyword,[Char]
"type"):(TokenType
Space,[Char]
_):(TokenType
Keyword,[Char]
"data"):[(TokenType, [Char])]
stream)
                                             = [(TokenType, [Char])] -> Maybe [Char]
getConid [(TokenType, [Char])]
stream
identifier ST
st t :: [(TokenType, [Char])]
t@((TokenType
Keyword,[Char]
"type"):[(TokenType, [Char])]
stream)    = [(TokenType, [Char])] -> Maybe [Char]
getConid [(TokenType, [Char])]
stream
identifier ST
st t :: [(TokenType, [Char])]
t@((TokenType
Keyword,[Char]
"class"):[(TokenType, [Char])]
stream)   = [(TokenType, [Char])] -> Maybe [Char]
getConid [(TokenType, [Char])]
stream
identifier ST
st t :: [(TokenType, [Char])]
t@((TokenType
Keyword,[Char]
"instance"):[(TokenType, [Char])]
stream)= [(TokenType, [Char])] -> Maybe [Char]
getInstance [(TokenType, [Char])]
stream
identifier ST
st t :: [(TokenType, [Char])]
t@((TokenType
Comment,[Char]
_):(TokenType
Space,[Char]
"\n"):[(TokenType, [Char])]
stream) = ST -> [(TokenType, [Char])] -> Maybe [Char]
identifier ST
st [(TokenType, [Char])]
stream
identifier ST
st [(TokenType, [Char])]
stream = Maybe [Char]
forall a. Maybe a
Nothing

-- Is this really a type signature?  (no longer used)
typesig :: [(TokenType,String)] -> Bool
typesig :: [(TokenType, [Char])] -> Bool
typesig ((TokenType
Keyglyph,[Char]
"::"):[(TokenType, [Char])]
_)   = Bool
True
typesig ((TokenType
Varid,[Char]
_):[(TokenType, [Char])]
stream)    = [(TokenType, [Char])] -> Bool
typesig [(TokenType, [Char])]
stream
typesig ((TokenType
Layout,[Char]
"("):(TokenType
Varop,[Char]
_):(TokenType
Layout,[Char]
")"):[(TokenType, [Char])]
stream)    = [(TokenType, [Char])] -> Bool
typesig [(TokenType, [Char])]
stream
typesig ((TokenType
Layout,[Char]
","):[(TokenType, [Char])]
stream) = [(TokenType, [Char])] -> Bool
typesig [(TokenType, [Char])]
stream
typesig ((TokenType
Space,[Char]
_):[(TokenType, [Char])]
stream)    = [(TokenType, [Char])] -> Bool
typesig [(TokenType, [Char])]
stream
typesig ((TokenType
Comment,[Char]
_):[(TokenType, [Char])]
stream)  = [(TokenType, [Char])] -> Bool
typesig [(TokenType, [Char])]
stream
typesig [(TokenType, [Char])]
_                     = Bool
False

-- throw away everything from opening paren to matching close
munchParens ::  [(TokenType, String)] -> [(TokenType, String)]
munchParens :: [(TokenType, [Char])] -> [(TokenType, [Char])]
munchParens =  Int -> [(TokenType, [Char])] -> [(TokenType, [Char])]
forall {t}.
(Eq t, Num t) =>
t -> [(TokenType, [Char])] -> [(TokenType, [Char])]
munch (Int
0::Int)	-- already seen open paren
  where munch :: t -> [(TokenType, [Char])] -> [(TokenType, [Char])]
munch t
0 ((TokenType
Layout,[Char]
")"):[(TokenType, [Char])]
rest) = [(TokenType, [Char])]
rest
        munch t
n ((TokenType
Layout,[Char]
")"):[(TokenType, [Char])]
rest) = t -> [(TokenType, [Char])] -> [(TokenType, [Char])]
munch (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1) [(TokenType, [Char])]
rest
        munch t
n ((TokenType
Layout,[Char]
"("):[(TokenType, [Char])]
rest) = t -> [(TokenType, [Char])] -> [(TokenType, [Char])]
munch (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
1) [(TokenType, [Char])]
rest
        munch t
n ((TokenType, [Char])
_:[(TokenType, [Char])]
rest)            = t -> [(TokenType, [Char])] -> [(TokenType, [Char])]
munch t
n [(TokenType, [Char])]
rest
        munch t
_ []                  = []	-- source is ill-formed

-- ensure anchor name is correct for a Varop
fix ::  String -> String
fix :: [Char] -> [Char]
fix (Char
'`':[Char]
v) = Char -> [Char] -> [Char]
forall a. Eq a => a -> [a] -> [a]
dropLast Char
'`' [Char]
v
fix [Char]
v       = [Char]
v

-- look past whitespace and comments to next "real" token
skip ::  [(TokenType, t)] -> [(TokenType, t)]
skip :: forall t. [(TokenType, t)] -> [(TokenType, t)]
skip ((TokenType
Space,t
_):[(TokenType, t)]
stream)   = [(TokenType, t)] -> [(TokenType, t)]
forall t. [(TokenType, t)] -> [(TokenType, t)]
skip [(TokenType, t)]
stream
skip ((TokenType
Comment,t
_):[(TokenType, t)]
stream) = [(TokenType, t)] -> [(TokenType, t)]
forall t. [(TokenType, t)] -> [(TokenType, t)]
skip [(TokenType, t)]
stream
skip [(TokenType, t)]
stream               = [(TokenType, t)]
stream

-- skip possible context up to and including "=>", returning next Conid token
-- (this function is highly partial - relies on source being parse-correct)
getConid ::  [(TokenType, String)] -> Maybe String
getConid :: [(TokenType, [Char])] -> Maybe [Char]
getConid [(TokenType, [Char])]
stream =
    case [(TokenType, [Char])] -> [(TokenType, [Char])]
forall t. [(TokenType, t)] -> [(TokenType, t)]
skip [(TokenType, [Char])]
stream of
        ((TokenType
Conid,[Char]
c):[(TokenType, [Char])]
rest) -> case [(TokenType, [Char])] -> [(TokenType, [Char])]
context [(TokenType, [Char])]
rest of
                              ((TokenType
Keyglyph,[Char]
"="):[(TokenType, [Char])]
_)     -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
c
                              ((TokenType
Keyglyph,[Char]
"=>"):[(TokenType, [Char])]
more) ->
                                  case [(TokenType, [Char])] -> [(TokenType, [Char])]
forall t. [(TokenType, t)] -> [(TokenType, t)]
skip [(TokenType, [Char])]
more of
                                      ((TokenType
Conid,[Char]
c'):[(TokenType, [Char])]
_) -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
c'
                                      [(TokenType, [Char])]
v -> [(TokenType, [Char])] -> [Char] -> Maybe [Char]
forall {p} {p} {a}. p -> p -> Maybe a
debug [(TokenType, [Char])]
v ([Char]
"Conid "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
c[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" =>")
                              [(TokenType, [Char])]
v -> [(TokenType, [Char])] -> [Char] -> Maybe [Char]
forall {p} {p} {a}. p -> p -> Maybe a
debug [(TokenType, [Char])]
v ([Char]
"Conid "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
c[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" no = or =>")
        ((TokenType
Layout,[Char]
"("):[(TokenType, [Char])]
rest) -> case [(TokenType, [Char])] -> [(TokenType, [Char])]
context [(TokenType, [Char])]
rest of
                                   ((TokenType
Keyglyph,[Char]
"=>"):[(TokenType, [Char])]
more) ->
                                       case [(TokenType, [Char])] -> [(TokenType, [Char])]
forall t. [(TokenType, t)] -> [(TokenType, t)]
skip [(TokenType, [Char])]
more of
                                           ((TokenType
Conid,[Char]
c'):[(TokenType, [Char])]
_) -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
c'
                                           [(TokenType, [Char])]
v -> [(TokenType, [Char])] -> [Char] -> Maybe [Char]
forall {p} {p} {a}. p -> p -> Maybe a
debug [(TokenType, [Char])]
v ([Char]
"(...) =>")
                                   [(TokenType, [Char])]
v -> [(TokenType, [Char])] -> [Char] -> Maybe [Char]
forall {p} {p} {a}. p -> p -> Maybe a
debug [(TokenType, [Char])]
v ([Char]
"(...) no =>")
        [(TokenType, [Char])]
v -> [(TokenType, [Char])] -> [Char] -> Maybe [Char]
forall {p} {p} {a}. p -> p -> Maybe a
debug [(TokenType, [Char])]
v ([Char]
"no Conid or (...)")
    where debug :: p -> p -> Maybe a
debug   p
_   p
_ = Maybe a
forall a. Maybe a
Nothing
       -- debug (s:t) c = error ("HsColour: getConid failed: "++show s
       --                       ++"\n  in the context of: "++c)

-- jump past possible class context
context ::  [(TokenType, String)] -> [(TokenType, String)]
context :: [(TokenType, [Char])] -> [(TokenType, [Char])]
context stream :: [(TokenType, [Char])]
stream@((TokenType
Keyglyph,[Char]
"="):[(TokenType, [Char])]
_) = [(TokenType, [Char])]
stream
context stream :: [(TokenType, [Char])]
stream@((TokenType
Keyglyph,[Char]
"=>"):[(TokenType, [Char])]
_) = [(TokenType, [Char])]
stream
context stream :: [(TokenType, [Char])]
stream@((TokenType
Keyglyph,[Char]
"⇒"):[(TokenType, [Char])]
_) = [(TokenType, [Char])]
stream
context ((TokenType, [Char])
_:[(TokenType, [Char])]
stream) = [(TokenType, [Char])] -> [(TokenType, [Char])]
context [(TokenType, [Char])]
stream
context [] = []

-- the anchor name for an instance is just the entire instance head, minus
-- any extra context clause
getInstance :: [(TokenType, [Char])] -> Maybe [Char]
getInstance = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char])
-> ([(TokenType, [Char])] -> [Char])
-> [(TokenType, [Char])]
-> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ST -> [Char]
unwords (ST -> [Char])
-> ([(TokenType, [Char])] -> ST) -> [(TokenType, [Char])] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"instance"[Char] -> ST -> ST
forall a. a -> [a] -> [a]
:) (ST -> ST)
-> ([(TokenType, [Char])] -> ST) -> [(TokenType, [Char])] -> ST
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ST
words ([Char] -> ST)
-> ([(TokenType, [Char])] -> [Char]) -> [(TokenType, [Char])] -> ST
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ST -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (ST -> [Char])
-> ([(TokenType, [Char])] -> ST) -> [(TokenType, [Char])] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TokenType, [Char]) -> [Char]) -> [(TokenType, [Char])] -> ST
forall a b. (a -> b) -> [a] -> [b]
map (TokenType, [Char]) -> [Char]
forall a b. (a, b) -> b
snd
              ([(TokenType, [Char])] -> ST)
-> ([(TokenType, [Char])] -> [(TokenType, [Char])])
-> [(TokenType, [Char])]
-> ST
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(TokenType, [Char])] -> [(TokenType, [Char])]
trimContext ([(TokenType, [Char])] -> [(TokenType, [Char])])
-> ([(TokenType, [Char])] -> [(TokenType, [Char])])
-> [(TokenType, [Char])]
-> [(TokenType, [Char])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TokenType, [Char]) -> Bool)
-> [(TokenType, [Char])] -> [(TokenType, [Char])]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool)
-> ((TokenType, [Char]) -> Bool) -> (TokenType, [Char]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TokenType, [Char]) -> Bool
terminator)
  where
    trimContext :: [(TokenType, [Char])] -> [(TokenType, [Char])]
trimContext [(TokenType, [Char])]
ts = if (TokenType
Keyglyph,[Char]
"=>") (TokenType, [Char]) -> [(TokenType, [Char])] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(TokenType, [Char])]
ts
                     Bool -> Bool -> Bool
||  (TokenType
Keyglyph,[Char]
"⇒") (TokenType, [Char]) -> [(TokenType, [Char])] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(TokenType, [Char])]
ts
                     then [(TokenType, [Char])] -> [(TokenType, [Char])]
forall a. HasCallStack => [a] -> [a]
tail ([(TokenType, [Char])] -> [(TokenType, [Char])])
-> ([(TokenType, [Char])] -> [(TokenType, [Char])])
-> [(TokenType, [Char])]
-> [(TokenType, [Char])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TokenType, [Char]) -> Bool)
-> [(TokenType, [Char])] -> [(TokenType, [Char])]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((TokenType, [Char]) -> [(TokenType, [Char])] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem`[(TokenType
Keyglyph,[Char]
"=>")
                                                     ,(TokenType
Keyglyph,[Char]
"⇒")]) ([(TokenType, [Char])] -> [(TokenType, [Char])])
-> [(TokenType, [Char])] -> [(TokenType, [Char])]
forall a b. (a -> b) -> a -> b
$ [(TokenType, [Char])]
ts
                     else [(TokenType, [Char])]
ts
    terminator :: (TokenType, [Char]) -> Bool
terminator (TokenType
Keyword, [Char]
_)   = Bool
True
    terminator (TokenType
Comment, [Char]
_)   = Bool
True
    terminator (TokenType
Cpp,     [Char]
_)   = Bool
True
    terminator (TokenType
Keyglyph,[Char]
"|") = Bool
True
    terminator (TokenType
Layout,  [Char]
";") = Bool
True
    terminator (TokenType
Layout,  [Char]
"{") = Bool
True
    terminator (TokenType
Layout,  [Char]
"}") = Bool
True
    terminator (TokenType, [Char])
_              = Bool
False

-- simple implementation of a string lookup table.
-- replace this with something more sophisticated if needed.
type ST = [String]

emptyST :: ST
emptyST :: ST
emptyST = []

insertST :: String -> ST -> ST
insertST :: [Char] -> ST -> ST
insertST [Char]
k ST
st = [Char] -> ST -> ST
forall a. Ord a => a -> [a] -> [a]
insert [Char]
k ST
st

inST :: String -> ST -> Bool
inST :: [Char] -> ST -> Bool
inST [Char]
k ST
st = [Char]
k [Char] -> ST -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ST
st