{-# 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 {
    Pos a -> SrcPos
posOf   :: {-# UNPACK #-} !SrcPos
    , Pos a -> a
valOf :: !a
    } deriving (Pos a -> Pos a -> Bool
(Pos a -> Pos a -> Bool) -> (Pos a -> Pos a -> Bool) -> Eq (Pos a)
forall a. Eq a => Pos a -> Pos a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pos a -> Pos a -> Bool
$c/= :: forall a. Eq a => Pos a -> Pos a -> Bool
== :: Pos a -> Pos a -> Bool
$c== :: forall a. Eq a => Pos a -> Pos a -> Bool
Eq, Eq (Pos a)
Eq (Pos a)
-> (Pos a -> Pos a -> Ordering)
-> (Pos a -> Pos a -> Bool)
-> (Pos a -> Pos a -> Bool)
-> (Pos a -> Pos a -> Bool)
-> (Pos a -> Pos a -> Bool)
-> (Pos a -> Pos a -> Pos a)
-> (Pos a -> Pos a -> Pos a)
-> Ord (Pos a)
Pos a -> Pos a -> Bool
Pos a -> Pos a -> Ordering
Pos a -> Pos a -> Pos a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Pos a)
forall a. Ord a => Pos a -> Pos a -> Bool
forall a. Ord a => Pos a -> Pos a -> Ordering
forall a. Ord a => Pos a -> Pos a -> Pos a
min :: Pos a -> Pos a -> Pos a
$cmin :: forall a. Ord a => Pos a -> Pos a -> Pos a
max :: Pos a -> Pos a -> Pos a
$cmax :: forall a. Ord a => Pos a -> Pos a -> Pos a
>= :: Pos a -> Pos a -> Bool
$c>= :: forall a. Ord a => Pos a -> Pos a -> Bool
> :: Pos a -> Pos a -> Bool
$c> :: forall a. Ord a => Pos a -> Pos a -> Bool
<= :: Pos a -> Pos a -> Bool
$c<= :: forall a. Ord a => Pos a -> Pos a -> Bool
< :: Pos a -> Pos a -> Bool
$c< :: forall a. Ord a => Pos a -> Pos a -> Bool
compare :: Pos a -> Pos a -> Ordering
$ccompare :: forall a. Ord a => Pos a -> Pos a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Pos a)
Ord)

instance (NFData a) => NFData (Pos a) where
    rnf :: Pos a -> ()
rnf (Pos SrcPos
x a
y) = SrcPos -> ()
forall a. NFData a => a -> ()
rnf SrcPos
x () -> () -> ()
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
y

instance Show a => Show (Pos a) where
    show :: Pos a -> String
show (Pos SrcPos
pos a
val) = SrcPos -> String
forall a. Show a => a -> String
show SrcPos
pos String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
val

newtype Line = Line { Line -> Int
unLine :: Int }
    deriving (Int -> Line -> ShowS
[Line] -> ShowS
Line -> String
(Int -> Line -> ShowS)
-> (Line -> String) -> ([Line] -> ShowS) -> Show Line
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Line] -> ShowS
$cshowList :: [Line] -> ShowS
show :: Line -> String
$cshow :: Line -> String
showsPrec :: Int -> Line -> ShowS
$cshowsPrec :: Int -> Line -> ShowS
Show, Line -> Line -> Bool
(Line -> Line -> Bool) -> (Line -> Line -> Bool) -> Eq Line
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Line -> Line -> Bool
$c/= :: Line -> Line -> Bool
== :: Line -> Line -> Bool
$c== :: Line -> Line -> Bool
Eq, Eq Line
Eq Line
-> (Line -> Line -> Ordering)
-> (Line -> Line -> Bool)
-> (Line -> Line -> Bool)
-> (Line -> Line -> Bool)
-> (Line -> Line -> Bool)
-> (Line -> Line -> Line)
-> (Line -> Line -> Line)
-> Ord Line
Line -> Line -> Bool
Line -> Line -> Ordering
Line -> Line -> Line
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Line -> Line -> Line
$cmin :: Line -> Line -> Line
max :: Line -> Line -> Line
$cmax :: Line -> Line -> Line
>= :: Line -> Line -> Bool
$c>= :: Line -> Line -> Bool
> :: Line -> Line -> Bool
$c> :: Line -> Line -> Bool
<= :: Line -> Line -> Bool
$c<= :: Line -> Line -> Bool
< :: Line -> Line -> Bool
$c< :: Line -> Line -> Bool
compare :: Line -> Line -> Ordering
$ccompare :: Line -> Line -> Ordering
$cp1Ord :: Eq Line
Ord, Line -> ()
(Line -> ()) -> NFData Line
forall a. (a -> ()) -> NFData a
rnf :: Line -> ()
$crnf :: Line -> ()
NFData, Integer -> Line
Line -> Line
Line -> Line -> Line
(Line -> Line -> Line)
-> (Line -> Line -> Line)
-> (Line -> Line -> Line)
-> (Line -> Line)
-> (Line -> Line)
-> (Line -> Line)
-> (Integer -> Line)
-> Num Line
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Line
$cfromInteger :: Integer -> Line
signum :: Line -> Line
$csignum :: Line -> Line
abs :: Line -> Line
$cabs :: Line -> Line
negate :: Line -> Line
$cnegate :: Line -> Line
* :: Line -> Line -> Line
$c* :: Line -> Line -> Line
- :: Line -> Line -> Line
$c- :: Line -> Line -> Line
+ :: Line -> Line -> Line
$c+ :: Line -> Line -> Line
Num)

newtype Offset = Offset { Offset -> Int
unOffset :: Int }
    deriving (Int -> Offset -> ShowS
[Offset] -> ShowS
Offset -> String
(Int -> Offset -> ShowS)
-> (Offset -> String) -> ([Offset] -> ShowS) -> Show Offset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Offset] -> ShowS
$cshowList :: [Offset] -> ShowS
show :: Offset -> String
$cshow :: Offset -> String
showsPrec :: Int -> Offset -> ShowS
$cshowsPrec :: Int -> Offset -> ShowS
Show, Offset -> Offset -> Bool
(Offset -> Offset -> Bool)
-> (Offset -> Offset -> Bool) -> Eq Offset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Offset -> Offset -> Bool
$c/= :: Offset -> Offset -> Bool
== :: Offset -> Offset -> Bool
$c== :: Offset -> Offset -> Bool
Eq, Eq Offset
Eq Offset
-> (Offset -> Offset -> Ordering)
-> (Offset -> Offset -> Bool)
-> (Offset -> Offset -> Bool)
-> (Offset -> Offset -> Bool)
-> (Offset -> Offset -> Bool)
-> (Offset -> Offset -> Offset)
-> (Offset -> Offset -> Offset)
-> Ord Offset
Offset -> Offset -> Bool
Offset -> Offset -> Ordering
Offset -> Offset -> Offset
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Offset -> Offset -> Offset
$cmin :: Offset -> Offset -> Offset
max :: Offset -> Offset -> Offset
$cmax :: Offset -> Offset -> Offset
>= :: Offset -> Offset -> Bool
$c>= :: Offset -> Offset -> Bool
> :: Offset -> Offset -> Bool
$c> :: Offset -> Offset -> Bool
<= :: Offset -> Offset -> Bool
$c<= :: Offset -> Offset -> Bool
< :: Offset -> Offset -> Bool
$c< :: Offset -> Offset -> Bool
compare :: Offset -> Offset -> Ordering
$ccompare :: Offset -> Offset -> Ordering
$cp1Ord :: Eq Offset
Ord, Offset -> ()
(Offset -> ()) -> NFData Offset
forall a. (a -> ()) -> NFData a
rnf :: Offset -> ()
$crnf :: Offset -> ()
NFData, Integer -> Offset
Offset -> Offset
Offset -> Offset -> Offset
(Offset -> Offset -> Offset)
-> (Offset -> Offset -> Offset)
-> (Offset -> Offset -> Offset)
-> (Offset -> Offset)
-> (Offset -> Offset)
-> (Offset -> Offset)
-> (Integer -> Offset)
-> Num Offset
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Offset
$cfromInteger :: Integer -> Offset
signum :: Offset -> Offset
$csignum :: Offset -> Offset
abs :: Offset -> Offset
$cabs :: Offset -> Offset
negate :: Offset -> Offset
$cnegate :: Offset -> Offset
* :: Offset -> Offset -> Offset
$c* :: Offset -> Offset -> Offset
- :: Offset -> Offset -> Offset
$c- :: Offset -> Offset -> Offset
+ :: Offset -> Offset -> Offset
$c+ :: Offset -> Offset -> Offset
Num)

increaseLine :: Line -> Line
increaseLine :: Line -> Line
increaseLine (Line Int
n) = Int -> Line
Line (Int -> Line) -> Int -> Line
forall a b. (a -> b) -> a -> b
$! Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

data SrcPos = SrcPos {
    SrcPos -> String
posFile     :: !FilePath
    , SrcPos -> Line
posLine   :: {-# UNPACK #-} !Line
    , SrcPos -> Offset
posOffset :: {-# UNPACK #-} !Offset
    -- | No need to keep prefix strict since most of the prefixes will not be
    -- used.
    , SrcPos -> Text
posPrefix :: Text
    , SrcPos -> Text
posSuffix :: Text
    } deriving (SrcPos -> SrcPos -> Bool
(SrcPos -> SrcPos -> Bool)
-> (SrcPos -> SrcPos -> Bool) -> Eq SrcPos
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SrcPos -> SrcPos -> Bool
$c/= :: SrcPos -> SrcPos -> Bool
== :: SrcPos -> SrcPos -> Bool
$c== :: SrcPos -> SrcPos -> Bool
Eq, Eq SrcPos
Eq SrcPos
-> (SrcPos -> SrcPos -> Ordering)
-> (SrcPos -> SrcPos -> Bool)
-> (SrcPos -> SrcPos -> Bool)
-> (SrcPos -> SrcPos -> Bool)
-> (SrcPos -> SrcPos -> Bool)
-> (SrcPos -> SrcPos -> SrcPos)
-> (SrcPos -> SrcPos -> SrcPos)
-> Ord SrcPos
SrcPos -> SrcPos -> Bool
SrcPos -> SrcPos -> Ordering
SrcPos -> SrcPos -> SrcPos
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SrcPos -> SrcPos -> SrcPos
$cmin :: SrcPos -> SrcPos -> SrcPos
max :: SrcPos -> SrcPos -> SrcPos
$cmax :: SrcPos -> SrcPos -> SrcPos
>= :: SrcPos -> SrcPos -> Bool
$c>= :: SrcPos -> SrcPos -> Bool
> :: SrcPos -> SrcPos -> Bool
$c> :: SrcPos -> SrcPos -> Bool
<= :: SrcPos -> SrcPos -> Bool
$c<= :: SrcPos -> SrcPos -> Bool
< :: SrcPos -> SrcPos -> Bool
$c< :: SrcPos -> SrcPos -> Bool
compare :: SrcPos -> SrcPos -> Ordering
$ccompare :: SrcPos -> SrcPos -> Ordering
$cp1Ord :: Eq SrcPos
Ord)

instance NFData SrcPos where
    rnf :: SrcPos -> ()
rnf (SrcPos String
v Line
w Offset
x Text
y Text
z) = String -> ()
forall a. NFData a => a -> ()
rnf String
v () -> () -> ()
`seq` Line -> ()
forall a. NFData a => a -> ()
rnf Line
w () -> () -> ()
`seq` Offset -> ()
forall a. NFData a => a -> ()
rnf Offset
x () -> () -> ()
`seq` Text -> ()
forall a. NFData a => a -> ()
rnf Text
y () -> () -> ()
`seq` Text -> ()
forall a. NFData a => a -> ()
rnf Text
z

instance Show SrcPos where
    show :: SrcPos -> String
show (SrcPos String
fn Line
line Offset
offset Text
prefix Text
suffix) =
        String
fn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Line -> Int
unLine Line
line) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Offset -> Int
unOffset Offset
offset) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
prefix' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
suffix'
        where
        prefix' :: String
prefix' = Text -> String
clean Text
prefix
        suffix' :: String
suffix' = Text -> String
clean Text
suffix
        clean :: Text -> String
clean Text
s | Text -> Bool
Text.null Text
s = String
""
                | Bool
otherwise   = String
":/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/"

forallTokenVal :: TokenVal
forallTokenVal :: TokenVal
forallTokenVal = Text -> TokenVal
T Text
"forall"

patternTokenVal :: TokenVal
patternTokenVal :: TokenVal
patternTokenVal = Text -> TokenVal
T Text
"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
    -- | Special token, not part of Haskell spec. Stores indentation.
    | Newline {-# UNPACK #-} !Int
    -- | String contents is not tracked since it's irrelevant.
    | String
    -- | Actual character not tracked since it's irrelevant.
    | Character
    -- | Actual value not tracked since it's irrelevant.
    | Number
    | QuasiquoterStart
    | QuasiquoterEnd
    | SpliceStart -- \$(, ends with RParen
    | ToplevelSplice -- e.g. \$foo
    | LambdaBackslash -- \
    | CppDefine {-# UNPACK #-} !Text
    | HSCEnum      -- #{enum...}
    | HSCDirective -- e.g. #define foo bar...
    | HSCDirectiveBraced
      -- ^ e.g. #{define foo...\nbar}, #{\ndefine foo...\nbar}, ends with RBrace
    | LBanana      -- Arrows: (|
    | RBanana      -- Arrows: |)
    | Error Text
    | DQuote -- '"' when not part of string in Alex or Happy
    | EOF
    deriving (Int -> TokenVal -> ShowS
[TokenVal] -> ShowS
TokenVal -> String
(Int -> TokenVal -> ShowS)
-> (TokenVal -> String) -> ([TokenVal] -> ShowS) -> Show TokenVal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenVal] -> ShowS
$cshowList :: [TokenVal] -> ShowS
show :: TokenVal -> String
$cshow :: TokenVal -> String
showsPrec :: Int -> TokenVal -> ShowS
$cshowsPrec :: Int -> TokenVal -> ShowS
Show, TokenVal -> TokenVal -> Bool
(TokenVal -> TokenVal -> Bool)
-> (TokenVal -> TokenVal -> Bool) -> Eq TokenVal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenVal -> TokenVal -> Bool
$c/= :: TokenVal -> TokenVal -> Bool
== :: TokenVal -> TokenVal -> Bool
$c== :: TokenVal -> TokenVal -> Bool
Eq, Eq TokenVal
Eq TokenVal
-> (TokenVal -> TokenVal -> Ordering)
-> (TokenVal -> TokenVal -> Bool)
-> (TokenVal -> TokenVal -> Bool)
-> (TokenVal -> TokenVal -> Bool)
-> (TokenVal -> TokenVal -> Bool)
-> (TokenVal -> TokenVal -> TokenVal)
-> (TokenVal -> TokenVal -> TokenVal)
-> Ord TokenVal
TokenVal -> TokenVal -> Bool
TokenVal -> TokenVal -> Ordering
TokenVal -> TokenVal -> TokenVal
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TokenVal -> TokenVal -> TokenVal
$cmin :: TokenVal -> TokenVal -> TokenVal
max :: TokenVal -> TokenVal -> TokenVal
$cmax :: TokenVal -> TokenVal -> TokenVal
>= :: TokenVal -> TokenVal -> Bool
$c>= :: TokenVal -> TokenVal -> Bool
> :: TokenVal -> TokenVal -> Bool
$c> :: TokenVal -> TokenVal -> Bool
<= :: TokenVal -> TokenVal -> Bool
$c<= :: TokenVal -> TokenVal -> Bool
< :: TokenVal -> TokenVal -> Bool
$c< :: TokenVal -> TokenVal -> Bool
compare :: TokenVal -> TokenVal -> Ordering
$ccompare :: TokenVal -> TokenVal -> Ordering
$cp1Ord :: Eq TokenVal
Ord, (forall x. TokenVal -> Rep TokenVal x)
-> (forall x. Rep TokenVal x -> TokenVal) -> Generic TokenVal
forall x. Rep TokenVal x -> TokenVal
forall x. TokenVal -> Rep TokenVal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TokenVal x -> TokenVal
$cfrom :: forall x. TokenVal -> Rep TokenVal x
Generic)

instance NFData TokenVal

type Token = Pos TokenVal