-- |
-- Module      :  Cryptol.Parser.LexerUtils
-- Copyright   :  (c) 2013-2016 Galois, Inc.
-- License     :  BSD3
-- Maintainer  :  cryptol@galois.com
-- Stability   :  provisional
-- Portability :  portable

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
module Cryptol.Parser.LexerUtils where

import Cryptol.Parser.Position
import Cryptol.Parser.Unlit(PreProc(None))
import Cryptol.Utils.PP
import Cryptol.Utils.Panic

import           Data.Char(toLower,generalCategory,isAscii,ord,isSpace)
import qualified Data.Char as Char
import           Data.Text(Text)
import qualified Data.Text as T
import           Data.Word(Word8)

import GHC.Generics (Generic)
import Control.DeepSeq

data Config = Config
  { Config -> FilePath
cfgSource      :: !FilePath     -- ^ File that we are working on
  , Config -> Layout
cfgLayout      :: !Layout       -- ^ Settings for layout processing
  , Config -> PreProc
cfgPreProc     :: PreProc       -- ^ Preprocessor settings
  , Config -> [FilePath]
cfgAutoInclude :: [FilePath]    -- ^ Implicit includes
  , Config -> Bool
cfgModuleScope :: Bool          -- ^ When we do layout processing
                                    -- should we add a vCurly (i.e., are
                                    -- we parsing a list of things).
  }

defaultConfig :: Config
defaultConfig :: Config
defaultConfig  = $WConfig :: FilePath -> Layout -> PreProc -> [FilePath] -> Bool -> Config
Config
  { cfgSource :: FilePath
cfgSource      = ""
  , cfgLayout :: Layout
cfgLayout      = Layout
Layout
  , cfgPreProc :: PreProc
cfgPreProc     = PreProc
None
  , cfgAutoInclude :: [FilePath]
cfgAutoInclude = []
  , cfgModuleScope :: Bool
cfgModuleScope = Bool
True
  }


type Action = Config -> Position -> Text -> LexS
           -> (Maybe (Located Token), LexS)

data LexS   = Normal
            | InComment Bool Position ![Position] [Text]
            | InString Position Text
            | InChar   Position Text


startComment :: Bool -> Action
startComment :: Bool -> Action
startComment isDoc :: Bool
isDoc _ p :: Position
p txt :: Text
txt s :: LexS
s = (Maybe (Located Token)
forall a. Maybe a
Nothing, Bool -> Position -> [Position] -> [Text] -> LexS
InComment Bool
d Position
p [Position]
stack [Text]
chunks)
  where (d :: Bool
d,stack :: [Position]
stack,chunks :: [Text]
chunks) = case LexS
s of
                           Normal                -> (Bool
isDoc, [], [Text
txt])
                           InComment doc :: Bool
doc q :: Position
q qs :: [Position]
qs cs :: [Text]
cs -> (Bool
doc, Position
q Position -> [Position] -> [Position]
forall a. a -> [a] -> [a]
: [Position]
qs, Text
txt Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
cs)
                           _                     -> FilePath -> [FilePath] -> (Bool, [Position], [Text])
forall a. HasCallStack => FilePath -> [FilePath] -> a
panic "[Lexer] startComment" ["in a string"]

endComment :: Action
endComment :: Action
endComment cfg :: Config
cfg p :: Position
p txt :: Text
txt s :: LexS
s =
  case LexS
s of
    InComment d :: Bool
d f :: Position
f [] cs :: [Text]
cs     -> (Located Token -> Maybe (Located Token)
forall a. a -> Maybe a
Just (Bool -> Position -> [Text] -> Located Token
mkToken Bool
d Position
f [Text]
cs), LexS
Normal)
    InComment d :: Bool
d _ (q :: Position
q:qs :: [Position]
qs) cs :: [Text]
cs -> (Maybe (Located Token)
forall a. Maybe a
Nothing, Bool -> Position -> [Position] -> [Text] -> LexS
InComment Bool
d Position
q [Position]
qs (Text
txt Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
cs))
    _                     -> FilePath -> [FilePath] -> (Maybe (Located Token), LexS)
forall a. HasCallStack => FilePath -> [FilePath] -> a
panic "[Lexer] endComment" ["outside comment"]
  where
  mkToken :: Bool -> Position -> [Text] -> Located Token
mkToken isDoc :: Bool
isDoc f :: Position
f cs :: [Text]
cs =
    let r :: Range
r   = $WRange :: Position -> Position -> FilePath -> Range
Range { from :: Position
from = Position
f, to :: Position
to = Position -> Text -> Position
moves Position
p Text
txt, source :: FilePath
source = Config -> FilePath
cfgSource Config
cfg }
        str :: Text
str = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text
txt Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
cs

        tok :: TokenW
tok = if Bool
isDoc then TokenW
DocStr else TokenW
BlockComment
    in $WLocated :: forall a. Range -> a -> Located a
Located { srcRange :: Range
srcRange = Range
r, thing :: Token
thing = TokenT -> Text -> Token
Token (TokenW -> TokenT
White TokenW
tok) Text
str }

addToComment :: Action
addToComment :: Action
addToComment _ _ txt :: Text
txt s :: LexS
s = (Maybe (Located Token)
forall a. Maybe a
Nothing, Bool -> Position -> [Position] -> [Text] -> LexS
InComment Bool
doc Position
p [Position]
stack (Text
txt Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
chunks))
  where
  (doc :: Bool
doc, p :: Position
p, stack :: [Position]
stack, chunks :: [Text]
chunks) =
     case LexS
s of
       InComment d :: Bool
d q :: Position
q qs :: [Position]
qs cs :: [Text]
cs -> (Bool
d,Position
q,[Position]
qs,[Text]
cs)
       _                   -> FilePath -> [FilePath] -> (Bool, Position, [Position], [Text])
forall a. HasCallStack => FilePath -> [FilePath] -> a
panic "[Lexer] addToComment" ["outside comment"]

startEndComment :: Action
startEndComment :: Action
startEndComment cfg :: Config
cfg p :: Position
p txt :: Text
txt s :: LexS
s =
  case LexS
s of
    Normal -> (Located Token -> Maybe (Located Token)
forall a. a -> Maybe a
Just Located Token
tok, LexS
Normal)
      where tok :: Located Token
tok = $WLocated :: forall a. Range -> a -> Located a
Located
                    { srcRange :: Range
srcRange = $WRange :: Position -> Position -> FilePath -> Range
Range { from :: Position
from   = Position
p
                                       , to :: Position
to     = Position -> Text -> Position
moves Position
p Text
txt
                                       , source :: FilePath
source = Config -> FilePath
cfgSource Config
cfg
                                       }
                    , thing :: Token
thing = TokenT -> Text -> Token
Token (TokenW -> TokenT
White TokenW
BlockComment) Text
txt
                    }
    InComment d :: Bool
d p1 :: Position
p1 ps :: [Position]
ps cs :: [Text]
cs -> (Maybe (Located Token)
forall a. Maybe a
Nothing, Bool -> Position -> [Position] -> [Text] -> LexS
InComment Bool
d Position
p1 [Position]
ps (Text
txt Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
cs))
    _ -> FilePath -> [FilePath] -> (Maybe (Located Token), LexS)
forall a. HasCallStack => FilePath -> [FilePath] -> a
panic "[Lexer] startEndComment" ["in string or char?"]

startString :: Action
startString :: Action
startString _ p :: Position
p txt :: Text
txt _ = (Maybe (Located Token)
forall a. Maybe a
Nothing,Position -> Text -> LexS
InString Position
p Text
txt)

endString :: Action
endString :: Action
endString cfg :: Config
cfg pe :: Position
pe txt :: Text
txt s :: LexS
s = case LexS
s of
  InString ps :: Position
ps str :: Text
str -> (Located Token -> Maybe (Located Token)
forall a. a -> Maybe a
Just (Position -> Text -> Located Token
mkToken Position
ps Text
str), LexS
Normal)
  _               -> FilePath -> [FilePath] -> (Maybe (Located Token), LexS)
forall a. HasCallStack => FilePath -> [FilePath] -> a
panic "[Lexer] endString" ["outside string"]
  where
  parseStr :: FilePath -> TokenT
parseStr s1 :: FilePath
s1 = case ReadS FilePath
forall a. Read a => ReadS a
reads FilePath
s1 of
                  [(cs :: FilePath
cs, "")] -> FilePath -> TokenT
StrLit FilePath
cs
                  _          -> TokenErr -> TokenT
Err TokenErr
InvalidString

  mkToken :: Position -> Text -> Located Token
mkToken ps :: Position
ps str :: Text
str = $WLocated :: forall a. Range -> a -> Located a
Located { srcRange :: Range
srcRange = $WRange :: Position -> Position -> FilePath -> Range
Range
                               { from :: Position
from   = Position
ps
                               , to :: Position
to     = Position -> Text -> Position
moves Position
pe Text
txt
                               , source :: FilePath
source = Config -> FilePath
cfgSource Config
cfg
                               }
                           , thing :: Token
thing    = $WToken :: TokenT -> Text -> Token
Token
                               { tokenType :: TokenT
tokenType = FilePath -> TokenT
parseStr (Text -> FilePath
T.unpack Text
tokStr)
                               , tokenText :: Text
tokenText = Text
tokStr
                               }
                           }
    where
    tokStr :: Text
tokStr = Text
str Text -> Text -> Text
`T.append` Text
txt


addToString :: Action
addToString :: Action
addToString _ _ txt :: Text
txt s :: LexS
s = case LexS
s of
  InString p :: Position
p str :: Text
str -> (Maybe (Located Token)
forall a. Maybe a
Nothing,Position -> Text -> LexS
InString Position
p (Text
str Text -> Text -> Text
`T.append` Text
txt))
  _              -> FilePath -> [FilePath] -> (Maybe (Located Token), LexS)
forall a. HasCallStack => FilePath -> [FilePath] -> a
panic "[Lexer] addToString" ["outside string"]


startChar :: Action
startChar :: Action
startChar _ p :: Position
p txt :: Text
txt _   = (Maybe (Located Token)
forall a. Maybe a
Nothing,Position -> Text -> LexS
InChar Position
p Text
txt)

endChar :: Action
endChar :: Action
endChar cfg :: Config
cfg pe :: Position
pe txt :: Text
txt s :: LexS
s =
  case LexS
s of
    InChar ps :: Position
ps str :: Text
str -> (Located Token -> Maybe (Located Token)
forall a. a -> Maybe a
Just (Position -> Text -> Located Token
mkToken Position
ps Text
str), LexS
Normal)
    _             -> FilePath -> [FilePath] -> (Maybe (Located Token), LexS)
forall a. HasCallStack => FilePath -> [FilePath] -> a
panic "[Lexer] endString" ["outside character"]

  where
  parseChar :: FilePath -> TokenT
parseChar s1 :: FilePath
s1 = case ReadS Char
forall a. Read a => ReadS a
reads FilePath
s1 of
                   [(cs :: Char
cs, "")] -> Char -> TokenT
ChrLit Char
cs
                   _          -> TokenErr -> TokenT
Err TokenErr
InvalidChar

  mkToken :: Position -> Text -> Located Token
mkToken ps :: Position
ps str :: Text
str = $WLocated :: forall a. Range -> a -> Located a
Located { srcRange :: Range
srcRange = $WRange :: Position -> Position -> FilePath -> Range
Range
                               { from :: Position
from   = Position
ps
                               , to :: Position
to     = Position -> Text -> Position
moves Position
pe Text
txt
                               , source :: FilePath
source = Config -> FilePath
cfgSource Config
cfg
                               }
                           , thing :: Token
thing    = $WToken :: TokenT -> Text -> Token
Token
                               { tokenType :: TokenT
tokenType = FilePath -> TokenT
parseChar (Text -> FilePath
T.unpack Text
tokStr)
                               , tokenText :: Text
tokenText = Text
tokStr
                               }
                           }
    where
    tokStr :: Text
tokStr = Text
str Text -> Text -> Text
`T.append` Text
txt



addToChar :: Action
addToChar :: Action
addToChar _ _ txt :: Text
txt s :: LexS
s = case LexS
s of
  InChar p :: Position
p str :: Text
str -> (Maybe (Located Token)
forall a. Maybe a
Nothing,Position -> Text -> LexS
InChar Position
p (Text
str Text -> Text -> Text
`T.append` Text
txt))
  _              -> FilePath -> [FilePath] -> (Maybe (Located Token), LexS)
forall a. HasCallStack => FilePath -> [FilePath] -> a
panic "[Lexer] addToChar" ["outside character"]


mkIdent :: Action
mkIdent :: Action
mkIdent cfg :: Config
cfg p :: Position
p s :: Text
s z :: LexS
z = (Located Token -> Maybe (Located Token)
forall a. a -> Maybe a
Just $WLocated :: forall a. Range -> a -> Located a
Located { srcRange :: Range
srcRange = Range
r, thing :: Token
thing = TokenT -> Text -> Token
Token TokenT
t Text
s }, LexS
z)
  where
  r :: Range
r = $WRange :: Position -> Position -> FilePath -> Range
Range { from :: Position
from = Position
p, to :: Position
to = Position -> Text -> Position
moves Position
p Text
s, source :: FilePath
source = Config -> FilePath
cfgSource Config
cfg }
  t :: TokenT
t = [Text] -> Text -> TokenT
Ident [] Text
s

mkQualIdent :: Action
mkQualIdent :: Action
mkQualIdent cfg :: Config
cfg p :: Position
p s :: Text
s z :: LexS
z = (Located Token -> Maybe (Located Token)
forall a. a -> Maybe a
Just $WLocated :: forall a. Range -> a -> Located a
Located { srcRange :: Range
srcRange = Range
r, thing :: Token
thing = TokenT -> Text -> Token
Token TokenT
t Text
s}, LexS
z)
  where
  r :: Range
r = $WRange :: Position -> Position -> FilePath -> Range
Range { from :: Position
from = Position
p, to :: Position
to = Position -> Text -> Position
moves Position
p Text
s, source :: FilePath
source = Config -> FilePath
cfgSource Config
cfg }
  t :: TokenT
t = [Text] -> Text -> TokenT
Ident [Text]
ns Text
i
  (ns :: [Text]
ns,i :: Text
i) = Text -> ([Text], Text)
splitQual Text
s

mkQualOp :: Action
mkQualOp :: Action
mkQualOp cfg :: Config
cfg p :: Position
p s :: Text
s z :: LexS
z = (Located Token -> Maybe (Located Token)
forall a. a -> Maybe a
Just $WLocated :: forall a. Range -> a -> Located a
Located { srcRange :: Range
srcRange = Range
r, thing :: Token
thing = TokenT -> Text -> Token
Token TokenT
t Text
s}, LexS
z)
  where
  r :: Range
r = $WRange :: Position -> Position -> FilePath -> Range
Range { from :: Position
from = Position
p, to :: Position
to = Position -> Text -> Position
moves Position
p Text
s, source :: FilePath
source = Config -> FilePath
cfgSource Config
cfg }
  t :: TokenT
t = TokenOp -> TokenT
Op ([Text] -> Text -> TokenOp
Other [Text]
ns Text
i)
  (ns :: [Text]
ns,i :: Text
i) = Text -> ([Text], Text)
splitQual Text
s

emit :: TokenT -> Action
emit :: TokenT -> Action
emit t :: TokenT
t cfg :: Config
cfg p :: Position
p s :: Text
s z :: LexS
z  = (Located Token -> Maybe (Located Token)
forall a. a -> Maybe a
Just $WLocated :: forall a. Range -> a -> Located a
Located { srcRange :: Range
srcRange = Range
r, thing :: Token
thing = TokenT -> Text -> Token
Token TokenT
t Text
s }, LexS
z)
  where r :: Range
r = $WRange :: Position -> Position -> FilePath -> Range
Range { from :: Position
from = Position
p, to :: Position
to = Position -> Text -> Position
moves Position
p Text
s, source :: FilePath
source = Config -> FilePath
cfgSource Config
cfg }


emitS :: (Text -> TokenT) -> Action
emitS :: (Text -> TokenT) -> Action
emitS t :: Text -> TokenT
t cfg :: Config
cfg p :: Position
p s :: Text
s z :: LexS
z  = TokenT -> Action
emit (Text -> TokenT
t Text
s) Config
cfg Position
p Text
s LexS
z


-- | Split out the prefix and name part of an identifier/operator.
splitQual :: T.Text -> ([T.Text], T.Text)
splitQual :: Text -> ([Text], Text)
splitQual t :: Text
t =
  case Text -> [Text]
splitNS ((Char -> Bool) -> Text -> Text
T.filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) Text
t) of
    []  -> FilePath -> [FilePath] -> ([Text], Text)
forall a. HasCallStack => FilePath -> [FilePath] -> a
panic "[Lexer] mkQualIdent" ["invalid qualified name", Text -> FilePath
forall a. Show a => a -> FilePath
show Text
t]
    [i :: Text
i] -> ([], Text
i)
    xs :: [Text]
xs  -> ([Text] -> [Text]
forall a. [a] -> [a]
init [Text]
xs, [Text] -> Text
forall a. [a] -> a
last [Text]
xs)

  where

  -- split on the namespace separator, `::`
  splitNS :: Text -> [Text]
splitNS s :: Text
s =
    case Text -> Text -> (Text, Text)
T.breakOn "::" Text
s of
      (l :: Text
l,r :: Text
r) | Text -> Bool
T.null Text
r  -> [Text
l]
            | Bool
otherwise -> Text
l Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text -> [Text]
splitNS (Int -> Text -> Text
T.drop 2 Text
r)



--------------------------------------------------------------------------------
numToken :: Integer -> Text -> TokenT
numToken :: Integer -> Text -> TokenT
numToken rad :: Integer
rad ds :: Text
ds = Integer -> Int -> Int -> TokenT
Num (Text -> Integer
toVal Text
ds') (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
rad) (Text -> Int
T.length Text
ds')
  where
  ds' :: Text
ds' = (Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '_') Text
ds
  toVal :: Text -> Integer
toVal = (Integer -> Char -> Integer) -> Integer -> Text -> Integer
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' (\x :: Integer
x c :: Char
c -> Integer
rad Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Char -> Integer
fromDigit Char
c) 0

fromDigit :: Char -> Integer
fromDigit :: Char -> Integer
fromDigit x' :: Char
x'
  | 'a' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
x Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= 'z'  = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
forall a. Enum a => a -> Int
fromEnum 'a')
  | Bool
otherwise             = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
forall a. Enum a => a -> Int
fromEnum '0')
  where x :: Char
x                 = Char -> Char
toLower Char
x'

-------------------------------------------------------------------------------

data AlexInput            = Inp { AlexInput -> Position
alexPos           :: !Position
                                , AlexInput -> Char
alexInputPrevChar :: !Char
                                , AlexInput -> Text
input             :: !Text
                                } deriving Int -> AlexInput -> ShowS
[AlexInput] -> ShowS
AlexInput -> FilePath
(Int -> AlexInput -> ShowS)
-> (AlexInput -> FilePath)
-> ([AlexInput] -> ShowS)
-> Show AlexInput
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [AlexInput] -> ShowS
$cshowList :: [AlexInput] -> ShowS
show :: AlexInput -> FilePath
$cshow :: AlexInput -> FilePath
showsPrec :: Int -> AlexInput -> ShowS
$cshowsPrec :: Int -> AlexInput -> ShowS
Show

alexGetByte :: AlexInput -> Maybe (Word8, AlexInput)
alexGetByte :: AlexInput -> Maybe (Word8, AlexInput)
alexGetByte i :: AlexInput
i =
  do (c :: Char
c,rest :: Text
rest) <- Text -> Maybe (Char, Text)
T.uncons (AlexInput -> Text
input AlexInput
i)
     let i' :: AlexInput
i' = AlexInput
i { alexPos :: Position
alexPos = Position -> Char -> Position
move (AlexInput -> Position
alexPos AlexInput
i) Char
c, input :: Text
input = Text
rest }
         b :: Word8
b  = Char -> Word8
byteForChar Char
c
     (Word8, AlexInput) -> Maybe (Word8, AlexInput)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8
b,AlexInput
i')

data Layout = Layout | NoLayout


--------------------------------------------------------------------------------

-- | Drop white-space tokens from the input.
dropWhite :: [Located Token] -> [Located Token]
dropWhite :: [Located Token] -> [Located Token]
dropWhite = (Located Token -> Bool) -> [Located Token] -> [Located Token]
forall a. (a -> Bool) -> [a] -> [a]
filter (TokenT -> Bool
notWhite (TokenT -> Bool)
-> (Located Token -> TokenT) -> Located Token -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> TokenT
tokenType (Token -> TokenT)
-> (Located Token -> Token) -> Located Token -> TokenT
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located Token -> Token
forall a. Located a -> a
thing)
  where notWhite :: TokenT -> Bool
notWhite (White w :: TokenW
w) = TokenW
w TokenW -> TokenW -> Bool
forall a. Eq a => a -> a -> Bool
== TokenW
DocStr
        notWhite _         = Bool
True


data Block = Virtual Int     -- ^ Virtual layout block
           | Explicit TokenT -- ^ An explicit layout block, expecting this ending
                             -- token.
             deriving (Int -> Block -> ShowS
[Block] -> ShowS
Block -> FilePath
(Int -> Block -> ShowS)
-> (Block -> FilePath) -> ([Block] -> ShowS) -> Show Block
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Block] -> ShowS
$cshowList :: [Block] -> ShowS
show :: Block -> FilePath
$cshow :: Block -> FilePath
showsPrec :: Int -> Block -> ShowS
$cshowsPrec :: Int -> Block -> ShowS
Show)

isExplicit :: Block -> Bool
isExplicit :: Block -> Bool
isExplicit Explicit{} = Bool
True
isExplicit Virtual{}  = Bool
False

startsLayout :: TokenT -> Bool
startsLayout :: TokenT -> Bool
startsLayout (KW KW_where)    = Bool
True
startsLayout (KW KW_private)  = Bool
True
startsLayout (KW KW_parameter) = Bool
True
startsLayout _                = Bool
False

-- Add separators computed from layout
layout :: Config -> [Located Token] -> [Located Token]
layout :: Config -> [Located Token] -> [Located Token]
layout cfg :: Config
cfg ts0 :: [Located Token]
ts0 = Bool -> Bool -> [Block] -> [Located Token] -> [Located Token]
loop Bool
False Bool
implicitScope [] [Located Token]
ts0
  where

  (_pos0 :: Position
_pos0,implicitScope :: Bool
implicitScope) = case [Located Token]
ts0 of
    t :: Located Token
t : _ -> (Range -> Position
from (Located Token -> Range
forall a. Located a -> Range
srcRange Located Token
t), Config -> Bool
cfgModuleScope Config
cfg Bool -> Bool -> Bool
&& Token -> TokenT
tokenType (Located Token -> Token
forall a. Located a -> a
thing Located Token
t) TokenT -> TokenT -> Bool
forall a. Eq a => a -> a -> Bool
/= TokenKW -> TokenT
KW TokenKW
KW_module)
    _     -> (Position
start,Bool
False)


  loop :: Bool -> Bool -> [Block] -> [Located Token] -> [Located Token]
  loop :: Bool -> Bool -> [Block] -> [Located Token] -> [Located Token]
loop afterDoc :: Bool
afterDoc startBlock :: Bool
startBlock stack :: [Block]
stack (t :: Located Token
t : ts :: [Located Token]
ts)
    | TokenT -> Bool
startsLayout TokenT
ty    = [Located Token]
toks [Located Token] -> [Located Token] -> [Located Token]
forall a. [a] -> [a] -> [a]
++ Bool -> Bool -> [Block] -> [Located Token] -> [Located Token]
loop Bool
False Bool
True                             [Block]
stack'  [Located Token]
ts

    -- We don't do layout within these delimeters
    | Sym ParenL   <- TokenT
ty = [Located Token]
toks [Located Token] -> [Located Token] -> [Located Token]
forall a. [a] -> [a] -> [a]
++ Bool -> Bool -> [Block] -> [Located Token] -> [Located Token]
loop Bool
False Bool
False (TokenT -> Block
Explicit (TokenSym -> TokenT
Sym TokenSym
ParenR)   Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
stack') [Located Token]
ts
    | Sym CurlyL   <- TokenT
ty = [Located Token]
toks [Located Token] -> [Located Token] -> [Located Token]
forall a. [a] -> [a] -> [a]
++ Bool -> Bool -> [Block] -> [Located Token] -> [Located Token]
loop Bool
False Bool
False (TokenT -> Block
Explicit (TokenSym -> TokenT
Sym TokenSym
CurlyR)   Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
stack') [Located Token]
ts
    | Sym BracketL <- TokenT
ty = [Located Token]
toks [Located Token] -> [Located Token] -> [Located Token]
forall a. [a] -> [a] -> [a]
++ Bool -> Bool -> [Block] -> [Located Token] -> [Located Token]
loop Bool
False Bool
False (TokenT -> Block
Explicit (TokenSym -> TokenT
Sym TokenSym
BracketR) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
stack') [Located Token]
ts

    | TokenT
EOF          <- TokenT
ty = [Located Token]
toks
    | White DocStr <- TokenT
ty = [Located Token]
toks [Located Token] -> [Located Token] -> [Located Token]
forall a. [a] -> [a] -> [a]
++ Bool -> Bool -> [Block] -> [Located Token] -> [Located Token]
loop Bool
True  Bool
False                            [Block]
stack'  [Located Token]
ts
    | Bool
otherwise          = [Located Token]
toks [Located Token] -> [Located Token] -> [Located Token]
forall a. [a] -> [a] -> [a]
++ Bool -> Bool -> [Block] -> [Located Token] -> [Located Token]
loop Bool
False Bool
False                            [Block]
stack'  [Located Token]
ts

    where
    ty :: TokenT
ty  = Token -> TokenT
tokenType (Located Token -> Token
forall a. Located a -> a
thing Located Token
t)
    pos :: Range
pos = Located Token -> Range
forall a. Located a -> Range
srcRange Located Token
t

    (toks :: [Located Token]
toks,offStack :: [Block]
offStack)
      | Bool
afterDoc  = ([Located Token
t], [Block]
stack)
      | Bool
otherwise = [Located Token]
-> Located Token -> [Block] -> ([Located Token], [Block])
offsides [Located Token]
startToks Located Token
t [Block]
stack

    -- add any block start tokens, and push a level on the stack
    (startToks :: [Located Token]
startToks,stack' :: [Block]
stack')
      | Bool
startBlock Bool -> Bool -> Bool
&& TokenT
ty TokenT -> TokenT -> Bool
forall a. Eq a => a -> a -> Bool
== TokenT
EOF = ( [ Config -> Position -> TokenV -> Located Token
virt Config
cfg (Range -> Position
to Range
pos) TokenV
VCurlyR
                                    , Config -> Position -> TokenV -> Located Token
virt Config
cfg (Range -> Position
to Range
pos) TokenV
VCurlyL ]
                                  , [Block]
offStack )
      | Bool
startBlock = ( [ Config -> Position -> TokenV -> Located Token
virt Config
cfg (Range -> Position
to Range
pos) TokenV
VCurlyL ], Int -> Block
Virtual (Position -> Int
col (Range -> Position
from Range
pos)) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
offStack )
      | Bool
otherwise  = ( [], [Block]
offStack )

  loop _ _ _ [] = FilePath -> [FilePath] -> [Located Token]
forall a. HasCallStack => FilePath -> [FilePath] -> a
panic "[Lexer] layout" ["Missing EOF token"]


  offsides :: [Located Token] -> Located Token -> [Block] -> ([Located Token], [Block])
  offsides :: [Located Token]
-> Located Token -> [Block] -> ([Located Token], [Block])
offsides startToks :: [Located Token]
startToks t :: Located Token
t = [Located Token] -> [Block] -> ([Located Token], [Block])
go [Located Token]
startToks
    where
    go :: [Located Token] -> [Block] -> ([Located Token], [Block])
go virts :: [Located Token]
virts stack :: [Block]
stack = case [Block]
stack of

      -- delimit or close a layout block
      Virtual c :: Int
c : rest :: [Block]
rest
          -- commas only close to an explicit marker, so if there is none, the
          -- comma doesn't close anything
        | TokenSym -> TokenT
Sym TokenSym
Comma TokenT -> TokenT -> Bool
forall a. Eq a => a -> a -> Bool
== TokenT
ty     ->
                         if (Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Block -> Bool
isExplicit [Block]
rest
                            then [Located Token] -> [Block] -> ([Located Token], [Block])
go   (Config -> Position -> TokenV -> Located Token
virt Config
cfg (Range -> Position
to Range
pos) TokenV
VCurlyR Located Token -> [Located Token] -> [Located Token]
forall a. a -> [a] -> [a]
: [Located Token]
virts) [Block]
rest
                            else [Located Token] -> [Block] -> ([Located Token], [Block])
forall b. [Located Token] -> b -> ([Located Token], b)
done                              [Located Token]
virts  [Block]
stack

        | Bool
closingToken        -> [Located Token] -> [Block] -> ([Located Token], [Block])
go   (Config -> Position -> TokenV -> Located Token
virt Config
cfg (Range -> Position
to Range
pos) TokenV
VCurlyR Located Token -> [Located Token] -> [Located Token]
forall a. a -> [a] -> [a]
: [Located Token]
virts) [Block]
rest
        | Position -> Int
col (Range -> Position
from Range
pos) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
c -> [Located Token] -> [Block] -> ([Located Token], [Block])
forall b. [Located Token] -> b -> ([Located Token], b)
done (Config -> Position -> TokenV -> Located Token
virt Config
cfg (Range -> Position
to Range
pos) TokenV
VSemi   Located Token -> [Located Token] -> [Located Token]
forall a. a -> [a] -> [a]
: [Located Token]
virts) [Block]
stack
        | Position -> Int
col (Range -> Position
from Range
pos) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  Int
c -> [Located Token] -> [Block] -> ([Located Token], [Block])
go   (Config -> Position -> TokenV -> Located Token
virt Config
cfg (Range -> Position
to Range
pos) TokenV
VCurlyR Located Token -> [Located Token] -> [Located Token]
forall a. a -> [a] -> [a]
: [Located Token]
virts) [Block]
rest

      -- close an explicit block
      Explicit close :: TokenT
close : rest :: [Block]
rest | TokenT
close     TokenT -> TokenT -> Bool
forall a. Eq a => a -> a -> Bool
== TokenT
ty -> [Located Token] -> [Block] -> ([Located Token], [Block])
forall b. [Located Token] -> b -> ([Located Token], b)
done [Located Token]
virts [Block]
rest
                            | TokenSym -> TokenT
Sym TokenSym
Comma TokenT -> TokenT -> Bool
forall a. Eq a => a -> a -> Bool
== TokenT
ty -> [Located Token] -> [Block] -> ([Located Token], [Block])
forall b. [Located Token] -> b -> ([Located Token], b)
done [Located Token]
virts [Block]
stack

      _ -> [Located Token] -> [Block] -> ([Located Token], [Block])
forall b. [Located Token] -> b -> ([Located Token], b)
done [Located Token]
virts [Block]
stack

    ty :: TokenT
ty  = Token -> TokenT
tokenType (Located Token -> Token
forall a. Located a -> a
thing Located Token
t)
    pos :: Range
pos = Located Token -> Range
forall a. Located a -> Range
srcRange Located Token
t

    done :: [Located Token] -> b -> ([Located Token], b)
done ts :: [Located Token]
ts s :: b
s = ([Located Token] -> [Located Token]
forall a. [a] -> [a]
reverse (Located Token
tLocated Token -> [Located Token] -> [Located Token]
forall a. a -> [a] -> [a]
:[Located Token]
ts), b
s)

    closingToken :: Bool
closingToken = TokenT
ty TokenT -> [TokenT] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ TokenSym -> TokenT
Sym TokenSym
ParenR, TokenSym -> TokenT
Sym TokenSym
BracketR, TokenSym -> TokenT
Sym TokenSym
CurlyR ]

virt :: Config -> Position -> TokenV -> Located Token
virt :: Config -> Position -> TokenV -> Located Token
virt cfg :: Config
cfg pos :: Position
pos x :: TokenV
x = $WLocated :: forall a. Range -> a -> Located a
Located { srcRange :: Range
srcRange = $WRange :: Position -> Position -> FilePath -> Range
Range
                             { from :: Position
from = Position
pos
                             , to :: Position
to = Position
pos
                             , source :: FilePath
source = Config -> FilePath
cfgSource Config
cfg
                             }
                         , thing :: Token
thing = Token
t }
  where t :: Token
t = TokenT -> Text -> Token
Token (TokenV -> TokenT
Virt TokenV
x) (Text -> Token) -> Text -> Token
forall a b. (a -> b) -> a -> b
$ case TokenV
x of
                               VCurlyL -> "beginning of layout block"
                               VCurlyR -> "end of layout block"
                               VSemi   -> "layout block separator"

--------------------------------------------------------------------------------

data Token    = Token { Token -> TokenT
tokenType :: !TokenT, Token -> Text
tokenText :: !Text }
                deriving (Int -> Token -> ShowS
[Token] -> ShowS
Token -> FilePath
(Int -> Token -> ShowS)
-> (Token -> FilePath) -> ([Token] -> ShowS) -> Show Token
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Token] -> ShowS
$cshowList :: [Token] -> ShowS
show :: Token -> FilePath
$cshow :: Token -> FilePath
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> Token -> ShowS
Show, (forall x. Token -> Rep Token x)
-> (forall x. Rep Token x -> Token) -> Generic Token
forall x. Rep Token x -> Token
forall x. Token -> Rep Token x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Token x -> Token
$cfrom :: forall x. Token -> Rep Token x
Generic, Token -> ()
(Token -> ()) -> NFData Token
forall a. (a -> ()) -> NFData a
rnf :: Token -> ()
$crnf :: Token -> ()
NFData)

-- | Virtual tokens, inserted by layout processing.
data TokenV   = VCurlyL| VCurlyR | VSemi
                deriving (TokenV -> TokenV -> Bool
(TokenV -> TokenV -> Bool)
-> (TokenV -> TokenV -> Bool) -> Eq TokenV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenV -> TokenV -> Bool
$c/= :: TokenV -> TokenV -> Bool
== :: TokenV -> TokenV -> Bool
$c== :: TokenV -> TokenV -> Bool
Eq, Int -> TokenV -> ShowS
[TokenV] -> ShowS
TokenV -> FilePath
(Int -> TokenV -> ShowS)
-> (TokenV -> FilePath) -> ([TokenV] -> ShowS) -> Show TokenV
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TokenV] -> ShowS
$cshowList :: [TokenV] -> ShowS
show :: TokenV -> FilePath
$cshow :: TokenV -> FilePath
showsPrec :: Int -> TokenV -> ShowS
$cshowsPrec :: Int -> TokenV -> ShowS
Show, (forall x. TokenV -> Rep TokenV x)
-> (forall x. Rep TokenV x -> TokenV) -> Generic TokenV
forall x. Rep TokenV x -> TokenV
forall x. TokenV -> Rep TokenV x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TokenV x -> TokenV
$cfrom :: forall x. TokenV -> Rep TokenV x
Generic, TokenV -> ()
(TokenV -> ()) -> NFData TokenV
forall a. (a -> ()) -> NFData a
rnf :: TokenV -> ()
$crnf :: TokenV -> ()
NFData)

data TokenW   = BlockComment | LineComment | Space | DocStr
                deriving (TokenW -> TokenW -> Bool
(TokenW -> TokenW -> Bool)
-> (TokenW -> TokenW -> Bool) -> Eq TokenW
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenW -> TokenW -> Bool
$c/= :: TokenW -> TokenW -> Bool
== :: TokenW -> TokenW -> Bool
$c== :: TokenW -> TokenW -> Bool
Eq, Int -> TokenW -> ShowS
[TokenW] -> ShowS
TokenW -> FilePath
(Int -> TokenW -> ShowS)
-> (TokenW -> FilePath) -> ([TokenW] -> ShowS) -> Show TokenW
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TokenW] -> ShowS
$cshowList :: [TokenW] -> ShowS
show :: TokenW -> FilePath
$cshow :: TokenW -> FilePath
showsPrec :: Int -> TokenW -> ShowS
$cshowsPrec :: Int -> TokenW -> ShowS
Show, (forall x. TokenW -> Rep TokenW x)
-> (forall x. Rep TokenW x -> TokenW) -> Generic TokenW
forall x. Rep TokenW x -> TokenW
forall x. TokenW -> Rep TokenW x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TokenW x -> TokenW
$cfrom :: forall x. TokenW -> Rep TokenW x
Generic, TokenW -> ()
(TokenW -> ()) -> NFData TokenW
forall a. (a -> ()) -> NFData a
rnf :: TokenW -> ()
$crnf :: TokenW -> ()
NFData)

data TokenKW  = KW_else
              | KW_extern
              | KW_fin
              | KW_if
              | KW_private
              | KW_include
              | KW_inf
              | KW_lg2
              | KW_lengthFromThen
              | KW_lengthFromThenTo
              | KW_max
              | KW_min
              | KW_module
              | KW_newtype
              | KW_pragma
              | KW_property
              | KW_then
              | KW_type
              | KW_where
              | KW_let
              | KW_x
              | KW_import
              | KW_as
              | KW_hiding
              | KW_infixl
              | KW_infixr
              | KW_infix
              | KW_primitive
              | KW_parameter
              | KW_constraint
              | KW_Prop
                deriving (TokenKW -> TokenKW -> Bool
(TokenKW -> TokenKW -> Bool)
-> (TokenKW -> TokenKW -> Bool) -> Eq TokenKW
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenKW -> TokenKW -> Bool
$c/= :: TokenKW -> TokenKW -> Bool
== :: TokenKW -> TokenKW -> Bool
$c== :: TokenKW -> TokenKW -> Bool
Eq, Int -> TokenKW -> ShowS
[TokenKW] -> ShowS
TokenKW -> FilePath
(Int -> TokenKW -> ShowS)
-> (TokenKW -> FilePath) -> ([TokenKW] -> ShowS) -> Show TokenKW
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TokenKW] -> ShowS
$cshowList :: [TokenKW] -> ShowS
show :: TokenKW -> FilePath
$cshow :: TokenKW -> FilePath
showsPrec :: Int -> TokenKW -> ShowS
$cshowsPrec :: Int -> TokenKW -> ShowS
Show, (forall x. TokenKW -> Rep TokenKW x)
-> (forall x. Rep TokenKW x -> TokenKW) -> Generic TokenKW
forall x. Rep TokenKW x -> TokenKW
forall x. TokenKW -> Rep TokenKW x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TokenKW x -> TokenKW
$cfrom :: forall x. TokenKW -> Rep TokenKW x
Generic, TokenKW -> ()
(TokenKW -> ()) -> NFData TokenKW
forall a. (a -> ()) -> NFData a
rnf :: TokenKW -> ()
$crnf :: TokenKW -> ()
NFData)

-- | The named operators are a special case for parsing types, and 'Other' is
-- used for all other cases that lexed as an operator.
data TokenOp  = Plus | Minus | Mul | Div | Exp | Mod
              | Equal | LEQ | GEQ
              | Complement | Hash | At
              | Other [T.Text] T.Text
                deriving (TokenOp -> TokenOp -> Bool
(TokenOp -> TokenOp -> Bool)
-> (TokenOp -> TokenOp -> Bool) -> Eq TokenOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenOp -> TokenOp -> Bool
$c/= :: TokenOp -> TokenOp -> Bool
== :: TokenOp -> TokenOp -> Bool
$c== :: TokenOp -> TokenOp -> Bool
Eq, Int -> TokenOp -> ShowS
[TokenOp] -> ShowS
TokenOp -> FilePath
(Int -> TokenOp -> ShowS)
-> (TokenOp -> FilePath) -> ([TokenOp] -> ShowS) -> Show TokenOp
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TokenOp] -> ShowS
$cshowList :: [TokenOp] -> ShowS
show :: TokenOp -> FilePath
$cshow :: TokenOp -> FilePath
showsPrec :: Int -> TokenOp -> ShowS
$cshowsPrec :: Int -> TokenOp -> ShowS
Show, (forall x. TokenOp -> Rep TokenOp x)
-> (forall x. Rep TokenOp x -> TokenOp) -> Generic TokenOp
forall x. Rep TokenOp x -> TokenOp
forall x. TokenOp -> Rep TokenOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TokenOp x -> TokenOp
$cfrom :: forall x. TokenOp -> Rep TokenOp x
Generic, TokenOp -> ()
(TokenOp -> ()) -> NFData TokenOp
forall a. (a -> ()) -> NFData a
rnf :: TokenOp -> ()
$crnf :: TokenOp -> ()
NFData)

data TokenSym = Bar
              | ArrL | ArrR | FatArrR
              | Lambda
              | EqDef
              | Comma
              | Semi
              | Dot
              | DotDot
              | DotDotDot
              | Colon
              | BackTick
              | ParenL   | ParenR
              | BracketL | BracketR
              | CurlyL   | CurlyR
              | TriL     | TriR
              | Underscore
                deriving (TokenSym -> TokenSym -> Bool
(TokenSym -> TokenSym -> Bool)
-> (TokenSym -> TokenSym -> Bool) -> Eq TokenSym
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenSym -> TokenSym -> Bool
$c/= :: TokenSym -> TokenSym -> Bool
== :: TokenSym -> TokenSym -> Bool
$c== :: TokenSym -> TokenSym -> Bool
Eq, Int -> TokenSym -> ShowS
[TokenSym] -> ShowS
TokenSym -> FilePath
(Int -> TokenSym -> ShowS)
-> (TokenSym -> FilePath) -> ([TokenSym] -> ShowS) -> Show TokenSym
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TokenSym] -> ShowS
$cshowList :: [TokenSym] -> ShowS
show :: TokenSym -> FilePath
$cshow :: TokenSym -> FilePath
showsPrec :: Int -> TokenSym -> ShowS
$cshowsPrec :: Int -> TokenSym -> ShowS
Show, (forall x. TokenSym -> Rep TokenSym x)
-> (forall x. Rep TokenSym x -> TokenSym) -> Generic TokenSym
forall x. Rep TokenSym x -> TokenSym
forall x. TokenSym -> Rep TokenSym x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TokenSym x -> TokenSym
$cfrom :: forall x. TokenSym -> Rep TokenSym x
Generic, TokenSym -> ()
(TokenSym -> ()) -> NFData TokenSym
forall a. (a -> ()) -> NFData a
rnf :: TokenSym -> ()
$crnf :: TokenSym -> ()
NFData)

data TokenErr = UnterminatedComment
              | UnterminatedString
              | UnterminatedChar
              | InvalidString
              | InvalidChar
              | LexicalError
                deriving (TokenErr -> TokenErr -> Bool
(TokenErr -> TokenErr -> Bool)
-> (TokenErr -> TokenErr -> Bool) -> Eq TokenErr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenErr -> TokenErr -> Bool
$c/= :: TokenErr -> TokenErr -> Bool
== :: TokenErr -> TokenErr -> Bool
$c== :: TokenErr -> TokenErr -> Bool
Eq, Int -> TokenErr -> ShowS
[TokenErr] -> ShowS
TokenErr -> FilePath
(Int -> TokenErr -> ShowS)
-> (TokenErr -> FilePath) -> ([TokenErr] -> ShowS) -> Show TokenErr
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TokenErr] -> ShowS
$cshowList :: [TokenErr] -> ShowS
show :: TokenErr -> FilePath
$cshow :: TokenErr -> FilePath
showsPrec :: Int -> TokenErr -> ShowS
$cshowsPrec :: Int -> TokenErr -> ShowS
Show, (forall x. TokenErr -> Rep TokenErr x)
-> (forall x. Rep TokenErr x -> TokenErr) -> Generic TokenErr
forall x. Rep TokenErr x -> TokenErr
forall x. TokenErr -> Rep TokenErr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TokenErr x -> TokenErr
$cfrom :: forall x. TokenErr -> Rep TokenErr x
Generic, TokenErr -> ()
(TokenErr -> ()) -> NFData TokenErr
forall a. (a -> ()) -> NFData a
rnf :: TokenErr -> ()
$crnf :: TokenErr -> ()
NFData)

data TokenT   = Num !Integer !Int !Int   -- ^ value, base, number of digits
              | ChrLit  !Char         -- ^ character literal
              | Ident ![T.Text] !T.Text -- ^ (qualified) identifier
              | StrLit !String         -- ^ string literal
              | KW    !TokenKW         -- ^ keyword
              | Op    !TokenOp         -- ^ operator
              | Sym   !TokenSym        -- ^ symbol
              | Virt  !TokenV          -- ^ virtual token (for layout)
              | White !TokenW          -- ^ white space token
              | Err   !TokenErr        -- ^ error token
              | EOF
                deriving (TokenT -> TokenT -> Bool
(TokenT -> TokenT -> Bool)
-> (TokenT -> TokenT -> Bool) -> Eq TokenT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenT -> TokenT -> Bool
$c/= :: TokenT -> TokenT -> Bool
== :: TokenT -> TokenT -> Bool
$c== :: TokenT -> TokenT -> Bool
Eq, Int -> TokenT -> ShowS
[TokenT] -> ShowS
TokenT -> FilePath
(Int -> TokenT -> ShowS)
-> (TokenT -> FilePath) -> ([TokenT] -> ShowS) -> Show TokenT
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TokenT] -> ShowS
$cshowList :: [TokenT] -> ShowS
show :: TokenT -> FilePath
$cshow :: TokenT -> FilePath
showsPrec :: Int -> TokenT -> ShowS
$cshowsPrec :: Int -> TokenT -> ShowS
Show, (forall x. TokenT -> Rep TokenT x)
-> (forall x. Rep TokenT x -> TokenT) -> Generic TokenT
forall x. Rep TokenT x -> TokenT
forall x. TokenT -> Rep TokenT x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TokenT x -> TokenT
$cfrom :: forall x. TokenT -> Rep TokenT x
Generic, TokenT -> ()
(TokenT -> ()) -> NFData TokenT
forall a. (a -> ()) -> NFData a
rnf :: TokenT -> ()
$crnf :: TokenT -> ()
NFData)

instance PP Token where
  ppPrec :: Int -> Token -> Doc
ppPrec _ (Token _ s :: Text
s) = FilePath -> Doc
text (Text -> FilePath
T.unpack Text
s)

-- | Collapse characters into a single Word8, identifying ASCII, and classes of
-- unicode.  This came from:
--
-- https://github.com/glguy/config-value/blob/master/src/Config/LexerUtils.hs
--
-- Which adapted:
--
-- https://github.com/ghc/ghc/blob/master/compiler/parser/Lexer.x
byteForChar :: Char -> Word8
byteForChar :: Char -> Word8
byteForChar c :: Char
c
  | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\6' = Word8
non_graphic
  | Char -> Bool
isAscii Char
c = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c)
  | Bool
otherwise = case Char -> GeneralCategory
generalCategory Char
c of
                  Char.LowercaseLetter       -> Word8
lower
                  Char.OtherLetter           -> Word8
lower
                  Char.UppercaseLetter       -> Word8
upper
                  Char.TitlecaseLetter       -> Word8
upper
                  Char.DecimalNumber         -> Word8
digit
                  Char.OtherNumber           -> Word8
digit
                  Char.ConnectorPunctuation  -> Word8
symbol
                  Char.DashPunctuation       -> Word8
symbol
                  Char.OtherPunctuation      -> Word8
symbol
                  Char.MathSymbol            -> Word8
symbol
                  Char.CurrencySymbol        -> Word8
symbol
                  Char.ModifierSymbol        -> Word8
symbol
                  Char.OtherSymbol           -> Word8
symbol
                  Char.Space                 -> Word8
sp
                  Char.ModifierLetter        -> Word8
other
                  Char.NonSpacingMark        -> Word8
other
                  Char.SpacingCombiningMark  -> Word8
other
                  Char.EnclosingMark         -> Word8
other
                  Char.LetterNumber          -> Word8
other
                  Char.OpenPunctuation       -> Word8
other
                  Char.ClosePunctuation      -> Word8
other
                  Char.InitialQuote          -> Word8
other
                  Char.FinalQuote            -> Word8
tick
                  _                          -> Word8
non_graphic
  where
  non_graphic :: Word8
non_graphic     = 0
  upper :: Word8
upper           = 1
  lower :: Word8
lower           = 2
  digit :: Word8
digit           = 3
  symbol :: Word8
symbol          = 4
  sp :: Word8
sp              = 5
  other :: Word8
other           = 6
  tick :: Word8
tick            = 7