{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
module FastTags.Token where
import Control.DeepSeq (NFData, rnf)
import Data.Text (Text)
import qualified Data.Text as Text
import GHC.Generics (Generic)
data Pos a = Pos {
posOf :: {-# UNPACK #-} !SrcPos
, valOf :: !a
} deriving (Eq, Ord)
instance (NFData a) => NFData (Pos a) where
rnf (Pos x y) = rnf x `seq` rnf y
instance Show a => Show (Pos a) where
show (Pos pos val) = show pos ++ ":" ++ show val
newtype Line = Line { unLine :: Int }
deriving (Show, Eq, Ord, NFData, Num)
newtype Offset = Offset { unOffset :: Int }
deriving (Show, Eq, Ord, NFData, Num)
increaseLine :: Line -> Line
increaseLine (Line n) = Line $! n + 1
data SrcPos = SrcPos {
posFile :: !FilePath
, posLine :: {-# UNPACK #-} !Line
, posOffset :: {-# UNPACK #-} !Offset
, posPrefix :: Text
, posSuffix :: Text
} deriving (Eq, Ord)
instance NFData SrcPos where
rnf (SrcPos v w x y z) = rnf v `seq` rnf w `seq` rnf x `seq` rnf y `seq` rnf z
instance Show SrcPos where
show (SrcPos fn line offset prefix suffix) =
fn ++ ":" ++ show (unLine line) ++ ":" ++ show (unOffset offset) ++ prefix' ++ suffix'
where
prefix' = clean prefix
suffix' = clean suffix
clean s | Text.null s = ""
| otherwise = ":/" ++ Text.unpack s ++ "/"
forallTokenVal :: TokenVal
forallTokenVal = T "forall"
patternTokenVal :: TokenVal
patternTokenVal = T "pattern"
data TokenVal =
KWCase
| KWClass
| KWData
| KWDefault
| KWDeriving
| KWDo
| KWElse
| KWFamily
| KWForeign
| KWIf
| KWImport
| KWIn
| KWInfix
| KWInfixl
| KWInfixr
| KWInstance
| KWLet
| KWModule
| KWNewtype
| KWOf
| KWThen
| KWType
| KWWhere
| Arrow
| At
| Backtick
| Comma
| Dot
| DoubleColon
| Equals
| ExclamationMark
| Implies
| LBrace
| LBracket
| LParen
| Pipe
| RBrace
| RBracket
| RParen
| Tilde
| Semicolon
| T {-# UNPACK #-} !Text
| Newline {-# UNPACK #-} !Int
| String
| Character
| Number
| QuasiquoterStart
| QuasiquoterEnd
| SpliceStart
| ToplevelSplice
| LambdaBackslash
| CppDefine {-# UNPACK #-} !Text
| HSCEnum
| HSCDirective
| HSCDirectiveBraced
| LBanana
| RBanana
| Error Text
| DQuote
| EOF
deriving (Show, Eq, Ord, Generic)
instance NFData TokenVal
type Token = Pos TokenVal