Parsec.lhs

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