>module Language.Haskell.Her.Parsec
> (haskellTokenStream
> ,litC
> ,opeC
> ,cloC
> ,uidC
> ,lidC
> ,kwC
> ,symC
> ,spcC
> ,comC
> ,urkC
> ,nlC
> ,lit
> ,ope
> ,clo
> ,uid
> ,lid
> ,kw
> ,sym
> ,semi
> ,spc
> ,com
> ,urk
> ,nl) where
>import Language.Haskell.Her.HaLay hiding
> (ope
> ,clo
> ,uid
> ,lid
> ,sym
> ,spc)
>import Text.ParserCombinators.Parsec
>import Text.Parsec.Prim
>import Data.Functor.Identity
>import Text.Parsec.Pos
>markLines
> :: String
> -> [(Int,Tok)]
> -> [(SourcePos,Tok)]
>markLines
> fileName
> toks
> = map
> (\((col,tok),line) ->
> (newPos fileName line col,tok))
> $ snd
> $ foldr
> markLines'
> (0,[])
> toks
> where
> markLines'
> tok
> (oldLine,markedToks)
> = case tok of
> (_,NL (_,newLine)) -> (newLine, (tok,newLine):markedToks)
> _ -> (oldLine,(tok,oldLine):markedToks)
>haskellTokenStream
> :: String
> -> String
> -> [(SourcePos,Tok)]
>haskellTokenStream
> haskellCode
> fileName
> = markLines
> fileName
> $ tokenize
> (((fileName,0),0),haskellCode)
>posTok (pos,_) = pos
>showT (_,t) = tokOut t
>justIf True v = Just v
>justIf False _ = Nothing
herToken
:: Text.Parsec.Prim.Stream
s
Data.Functor.Identity.Identity
(SourcePos, Tok)
=> ((SourcePos, Tok) -> Maybe a)
-> Text.Parsec.Prim.Parsec s u a
>herToken matchT = token showT posTok matchT
----
>litC
> checker
> = herToken matchT
> where
> matchT (_,t@(Lit c)) = justIf (checker c) t
> matchT (_,_) = Nothing
>lit
> content
> = litC (\c -> c == content)
----
>opeC
> checker
> = herToken matchT
> where
> matchT (_,t@(Ope c)) = justIf (checker c) t
> matchT (_,_) = Nothing
>ope
> content
> = opeC (\c -> c == content)
----
>cloC
> checker
> = herToken matchT
> where
> matchT (_,t@(Clo c)) = justIf (checker c) t
> matchT (_,_) = Nothing
>clo
> content
> = cloC (\c -> c == content)
----
>uidC
> checker
> = herToken matchT
> where
> matchT (_,t@(Uid c)) = justIf (checker c) t
> matchT (_,_) = Nothing
>uid
> content
> = uidC (\c -> c == content)
----
>lidC
> checker
> = herToken matchT
> where
> matchT (_,t@(Lid c)) = justIf (checker c) t
> matchT (_,_) = Nothing
>lid
> content
> = lidC (\c -> c == content)
----
>kwC
> checker
> = herToken matchT
> where
> matchT (_,t@(KW c)) = justIf (checker c) t
> matchT (_,_) = Nothing
>kw
> content
> = kwC (\c -> c == content)
----
>symC
> checker
> = herToken matchT
> where
> matchT (_,t@(Sym c)) = justIf (checker c) t
> matchT (_,_) = Nothing
>sym
> content
> = symC (\c -> c == content)
----
>semi :: GenParser (SourcePos,Tok) st Tok
>semi
> = herToken matchT
> where
> matchT (_,t@Semi) = Just t
> matchT (_,_) = Nothing
----
>spcC
> checker
> = herToken matchT
> where
> matchT (_,t@(Spc c)) = justIf (checker c) t
> matchT (_,_) = Nothing
>spc
> content
> = spcC (\c -> c == content)
----
>comC
> checker
> = herToken matchT
> where
> matchT (_,t@(Com c)) = justIf (checker c) t
> matchT (_,_) = Nothing
>com
> content
> = comC (\c -> c == content)
----
>urkC
> checker
> = herToken matchT
> where
> matchT (_,t@(Urk c)) = justIf (checker c) t
> matchT (_,_) = Nothing
>urk
> content
> = urkC (\c -> c == content)
----
>nlC
> checker
> = herToken matchT
> where
> matchT (_,t@(NL c)) = justIf (checker c) t
> matchT (_,_) = Nothing
>nl
> content
> = nlC (\c -> c == content)