{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.Lexer.Alex
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Utilities to turn a lexer generated by Alex into a 'Scanner' that
-- can be used by Yi. Most lexers will use the types defined here.
-- Some things are exported for use by lexers themselves through the
-- use of @Yi/Lexers/common.hsinc@.

module Yi.Lexer.Alex ( module Yi.Lexer.Alex
                     , (+~), (~-), Size(..), Stroke ) where

import           Lens.Micro.Platform (_1, view, makeLenses)
import qualified Data.Bits
import           Data.Char (ord)
import           Data.Function (on)
import           Data.Ix
import           Data.List (foldl')
import           Data.Ord (comparing)
import           Data.Word (Word8)
import           Yi.Style (StyleName)
import           Yi.Syntax hiding (mkHighlighter)
import           Yi.Utils

-- | Encode a Haskell String to a list of Word8 values, in UTF8 format.
utf8Encode :: Char -> [Word8]
utf8Encode :: Char -> [Byte]
utf8Encode = (Int -> Byte) -> [Int] -> [Byte]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Byte
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> [Byte]) -> (Char -> [Int]) -> Char -> [Byte]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Int]
forall {a}. (Ord a, Num a, Bits a) => a -> [a]
go (Int -> [Int]) -> (Char -> Int) -> Char -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
 where
  go :: a -> [a]
go a
oc
   | a
oc a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0x7f       = [a
oc]

   | a
oc a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0x7ff      = [ a
0xc0 a -> a -> a
forall a. Num a => a -> a -> a
+ (a
oc a -> Int -> a
forall a. Bits a => a -> Int -> a
`Data.Bits.shiftR` Int
6)
                        , a
0x80 a -> a -> a
forall a. Num a => a -> a -> a
+ a
oc a -> a -> a
forall a. Bits a => a -> a -> a
Data.Bits..&. a
0x3f
                        ]

   | a
oc a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0xffff     = [ a
0xe0 a -> a -> a
forall a. Num a => a -> a -> a
+ (a
oc a -> Int -> a
forall a. Bits a => a -> Int -> a
`Data.Bits.shiftR` Int
12)
                        , a
0x80 a -> a -> a
forall a. Num a => a -> a -> a
+ ((a
oc a -> Int -> a
forall a. Bits a => a -> Int -> a
`Data.Bits.shiftR` Int
6) a -> a -> a
forall a. Bits a => a -> a -> a
Data.Bits..&. a
0x3f)
                        , a
0x80 a -> a -> a
forall a. Num a => a -> a -> a
+ a
oc a -> a -> a
forall a. Bits a => a -> a -> a
Data.Bits..&. a
0x3f
                        ]
   | Bool
otherwise        = [ a
0xf0 a -> a -> a
forall a. Num a => a -> a -> a
+ (a
oc a -> Int -> a
forall a. Bits a => a -> Int -> a
`Data.Bits.shiftR` Int
18)
                        , a
0x80 a -> a -> a
forall a. Num a => a -> a -> a
+ ((a
oc a -> Int -> a
forall a. Bits a => a -> Int -> a
`Data.Bits.shiftR` Int
12) a -> a -> a
forall a. Bits a => a -> a -> a
Data.Bits..&. a
0x3f)
                        , a
0x80 a -> a -> a
forall a. Num a => a -> a -> a
+ ((a
oc a -> Int -> a
forall a. Bits a => a -> Int -> a
`Data.Bits.shiftR` Int
6) a -> a -> a
forall a. Bits a => a -> a -> a
Data.Bits..&. a
0x3f)
                        , a
0x80 a -> a -> a
forall a. Num a => a -> a -> a
+ a
oc a -> a -> a
forall a. Bits a => a -> a -> a
Data.Bits..&. a
0x3f
                        ]
type Byte = Word8

type IndexedStr = [(Point, Char)]
type AlexInput = (Char, [Byte], IndexedStr)
type Action hlState token = IndexedStr -> hlState -> (hlState, token)

-- | Lexer state
data AlexState lexerState = AlexState {
      forall lexerState. AlexState lexerState -> lexerState
stLexer  :: lexerState,   -- (user defined) lexer state
      forall lexerState. AlexState lexerState -> Point
lookedOffset :: !Point, -- Last offset looked at
      forall lexerState. AlexState lexerState -> Posn
stPosn :: !Posn
    } deriving Int -> AlexState lexerState -> ShowS
[AlexState lexerState] -> ShowS
AlexState lexerState -> String
(Int -> AlexState lexerState -> ShowS)
-> (AlexState lexerState -> String)
-> ([AlexState lexerState] -> ShowS)
-> Show (AlexState lexerState)
forall lexerState.
Show lexerState =>
Int -> AlexState lexerState -> ShowS
forall lexerState.
Show lexerState =>
[AlexState lexerState] -> ShowS
forall lexerState.
Show lexerState =>
AlexState lexerState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall lexerState.
Show lexerState =>
Int -> AlexState lexerState -> ShowS
showsPrec :: Int -> AlexState lexerState -> ShowS
$cshow :: forall lexerState.
Show lexerState =>
AlexState lexerState -> String
show :: AlexState lexerState -> String
$cshowList :: forall lexerState.
Show lexerState =>
[AlexState lexerState] -> ShowS
showList :: [AlexState lexerState] -> ShowS
Show

data Tok t = Tok { forall t. Tok t -> t
tokT :: t
                 , forall t. Tok t -> Size
tokLen  :: Size
                 , forall t. Tok t -> Posn
tokPosn :: Posn
                 } deriving (forall a b. (a -> b) -> Tok a -> Tok b)
-> (forall a b. a -> Tok b -> Tok a) -> Functor Tok
forall a b. a -> Tok b -> Tok a
forall a b. (a -> b) -> Tok a -> Tok b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Tok a -> Tok b
fmap :: forall a b. (a -> b) -> Tok a -> Tok b
$c<$ :: forall a b. a -> Tok b -> Tok a
<$ :: forall a b. a -> Tok b -> Tok a
Functor

instance Eq (Tok a) where
  == :: Tok a -> Tok a -> Bool
(==) = Posn -> Posn -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Posn -> Posn -> Bool) -> (Tok a -> Posn) -> Tok a -> Tok a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Tok a -> Posn
forall t. Tok t -> Posn
tokPosn

tokToSpan :: Tok t -> Span t
tokToSpan :: forall t. Tok t -> Span t
tokToSpan (Tok t
t Size
len Posn
posn) = Point -> t -> Point -> Span t
forall a. Point -> a -> Point -> Span a
Span (Posn -> Point
posnOfs Posn
posn) t
t (Posn -> Point
posnOfs Posn
posn Point -> Size -> Point
forall absolute relative.
SemiNum absolute relative =>
absolute -> relative -> absolute
+~ Size
len)

tokFromT :: t -> Tok t
tokFromT :: forall t. t -> Tok t
tokFromT t
t = t -> Size -> Posn -> Tok t
forall t. t -> Size -> Posn -> Tok t
Tok t
t Size
0 Posn
startPosn

tokBegin :: Tok t -> Point
tokBegin :: forall t. Tok t -> Point
tokBegin = Posn -> Point
posnOfs (Posn -> Point) -> (Tok t -> Posn) -> Tok t -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tok t -> Posn
forall t. Tok t -> Posn
tokPosn

tokEnd :: Tok t -> Point
tokEnd :: forall t. Tok t -> Point
tokEnd Tok t
t = Tok t -> Point
forall t. Tok t -> Point
tokBegin Tok t
t Point -> Size -> Point
forall absolute relative.
SemiNum absolute relative =>
absolute -> relative -> absolute
+~ Tok t -> Size
forall t. Tok t -> Size
tokLen Tok t
t

instance Show t => Show (Tok t) where
    show :: Tok t -> String
show Tok t
tok = Posn -> String
forall a. Show a => a -> String
show (Tok t -> Posn
forall t. Tok t -> Posn
tokPosn Tok t
tok) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ t -> String
forall a. Show a => a -> String
show (Tok t -> t
forall t. Tok t -> t
tokT Tok t
tok)

data Posn = Posn {
      Posn -> Point
posnOfs :: !Point
    , Posn -> Int
posnLine :: !Int
    , Posn -> Int
posnCol :: !Int
  } deriving (Posn -> Posn -> Bool
(Posn -> Posn -> Bool) -> (Posn -> Posn -> Bool) -> Eq Posn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Posn -> Posn -> Bool
== :: Posn -> Posn -> Bool
$c/= :: Posn -> Posn -> Bool
/= :: Posn -> Posn -> Bool
Eq, Ord Posn
Ord Posn =>
((Posn, Posn) -> [Posn])
-> ((Posn, Posn) -> Posn -> Int)
-> ((Posn, Posn) -> Posn -> Int)
-> ((Posn, Posn) -> Posn -> Bool)
-> ((Posn, Posn) -> Int)
-> ((Posn, Posn) -> Int)
-> Ix Posn
(Posn, Posn) -> Int
(Posn, Posn) -> [Posn]
(Posn, Posn) -> Posn -> Bool
(Posn, Posn) -> Posn -> Int
forall a.
Ord a =>
((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
$crange :: (Posn, Posn) -> [Posn]
range :: (Posn, Posn) -> [Posn]
$cindex :: (Posn, Posn) -> Posn -> Int
index :: (Posn, Posn) -> Posn -> Int
$cunsafeIndex :: (Posn, Posn) -> Posn -> Int
unsafeIndex :: (Posn, Posn) -> Posn -> Int
$cinRange :: (Posn, Posn) -> Posn -> Bool
inRange :: (Posn, Posn) -> Posn -> Bool
$crangeSize :: (Posn, Posn) -> Int
rangeSize :: (Posn, Posn) -> Int
$cunsafeRangeSize :: (Posn, Posn) -> Int
unsafeRangeSize :: (Posn, Posn) -> Int
Ix)

-- TODO: Verify that this is right.  /Deniz
instance Ord Posn where
    compare :: Posn -> Posn -> Ordering
compare = (Posn -> Point) -> Posn -> Posn -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Posn -> Point
posnOfs

instance Show Posn where
    show :: Posn -> String
show (Posn Point
o Int
l Int
c) = String
"L" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"C" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"@" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Point -> String
forall a. Show a => a -> String
show Point
o

startPosn :: Posn
startPosn :: Posn
startPosn = Point -> Int -> Int -> Posn
Posn Point
0 Int
1 Int
0

moveStr :: Posn -> IndexedStr -> Posn
moveStr :: Posn -> IndexedStr -> Posn
moveStr Posn
posn IndexedStr
str = (Posn -> Char -> Posn) -> Posn -> String -> Posn
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Posn -> Char -> Posn
moveCh Posn
posn (((Point, Char) -> Char) -> IndexedStr -> String
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Point, Char) -> Char
forall a b. (a, b) -> b
snd IndexedStr
str)

moveCh :: Posn -> Char -> Posn
moveCh :: Posn -> Char -> Posn
moveCh (Posn Point
o Int
l Int
c) Char
'\t' = Point -> Int -> Int -> Posn
Posn (Point
oPoint -> Point -> Point
forall a. Num a => a -> a -> a
+Point
1) Int
l       (((Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
8) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8)Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
8)
moveCh (Posn Point
o Int
l Int
_) Char
'\n' = Point -> Int -> Int -> Posn
Posn (Point
oPoint -> Point -> Point
forall a. Num a => a -> a -> a
+Point
1) (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)   Int
0
moveCh (Posn Point
o Int
l Int
c) Char
_    = Point -> Int -> Int -> Posn
Posn (Point
oPoint -> Point -> Point
forall a. Num a => a -> a -> a
+Point
1) Int
l       (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

alexGetChar :: AlexInput -> Maybe (Char, AlexInput)
alexGetChar :: (Char, [Byte], IndexedStr)
-> Maybe (Char, (Char, [Byte], IndexedStr))
alexGetChar (Char
_,[Byte]
_,[]) = Maybe (Char, (Char, [Byte], IndexedStr))
forall a. Maybe a
Nothing
alexGetChar (Char
_,[Byte]
b,(Point
_,Char
c):IndexedStr
rest) = (Char, (Char, [Byte], IndexedStr))
-> Maybe (Char, (Char, [Byte], IndexedStr))
forall a. a -> Maybe a
Just (Char
c, (Char
c,[Byte]
b,IndexedStr
rest))

alexGetByte :: AlexInput -> Maybe (Word8,AlexInput)
alexGetByte :: (Char, [Byte], IndexedStr)
-> Maybe (Byte, (Char, [Byte], IndexedStr))
alexGetByte (Char
c, Byte
b:[Byte]
bs, IndexedStr
s) = (Byte, (Char, [Byte], IndexedStr))
-> Maybe (Byte, (Char, [Byte], IndexedStr))
forall a. a -> Maybe a
Just (Byte
b,(Char
c,[Byte]
bs,IndexedStr
s))
alexGetByte (Char
_, [], [])    = Maybe (Byte, (Char, [Byte], IndexedStr))
forall a. Maybe a
Nothing
alexGetByte (Char
_, [], (Point, Char)
c:IndexedStr
s) = case Char -> [Byte]
utf8Encode ((Point, Char) -> Char
forall a b. (a, b) -> b
snd (Point, Char)
c) of
                             (Byte
b:[Byte]
bs) -> (Byte, (Char, [Byte], IndexedStr))
-> Maybe (Byte, (Char, [Byte], IndexedStr))
forall a. a -> Maybe a
Just (Byte
b, (((Point, Char) -> Char
forall a b. (a, b) -> b
snd (Point, Char)
c), [Byte]
bs, IndexedStr
s))
                             [] -> Maybe (Byte, (Char, [Byte], IndexedStr))
forall a. Maybe a
Nothing

{-# ANN alexCollectChar "HLint: ignore Use String" #-}
alexCollectChar :: AlexInput -> [Char]
alexCollectChar :: (Char, [Byte], IndexedStr) -> String
alexCollectChar (Char
_, [Byte]
_, []) = []
alexCollectChar (Char
_, [Byte]
b, (Point
_, Char
c):IndexedStr
rest) = Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: (Char, [Byte], IndexedStr) -> String
alexCollectChar (Char
c, [Byte]
b, IndexedStr
rest)

alexInputPrevChar :: AlexInput -> Char
alexInputPrevChar :: (Char, [Byte], IndexedStr) -> Char
alexInputPrevChar = Getting Char (Char, [Byte], IndexedStr) Char
-> (Char, [Byte], IndexedStr) -> Char
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Char (Char, [Byte], IndexedStr) Char
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Char, [Byte], IndexedStr) (Char, [Byte], IndexedStr) Char Char
_1

-- | Return a constant token
actionConst :: token -> Action lexState token
actionConst :: forall token lexState. token -> Action lexState token
actionConst token
token = \IndexedStr
_str lexState
state -> (lexState
state, token
token)

-- | Return a constant token, and modify the lexer state
actionAndModify :: (lexState -> lexState) -> token -> Action lexState token
actionAndModify :: forall lexState token.
(lexState -> lexState) -> token -> Action lexState token
actionAndModify lexState -> lexState
modifierFct token
token = \IndexedStr
_str lexState
state -> (lexState -> lexState
modifierFct lexState
state, token
token)

-- | Convert the parsed string into a token,
--   and also modify the lexer state
actionStringAndModify :: (s -> s) -> (String -> token) -> Action s token
actionStringAndModify :: forall s token. (s -> s) -> (String -> token) -> Action s token
actionStringAndModify s -> s
modF String -> token
f = \IndexedStr
istr s
s -> (s -> s
modF s
s, String -> token
f (String -> token) -> String -> token
forall a b. (a -> b) -> a -> b
$ ((Point, Char) -> Char) -> IndexedStr -> String
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Point, Char) -> Char
forall a b. (a, b) -> b
snd IndexedStr
istr)

-- | Convert the parsed string into a token
actionStringConst :: (String -> token) -> Action lexState token
actionStringConst :: forall token lexState. (String -> token) -> Action lexState token
actionStringConst String -> token
f = \IndexedStr
indexedStr lexState
state -> (lexState
state, String -> token
f (String -> token) -> String -> token
forall a b. (a -> b) -> a -> b
$ ((Point, Char) -> Char) -> IndexedStr -> String
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Point, Char) -> Char
forall a b. (a, b) -> b
snd IndexedStr
indexedStr)

type ASI s = (AlexState s, AlexInput)

-- | Function to (possibly) lex a single token and give us the
-- remaining input.
type TokenLexer l s t i = (l s, i) -> Maybe (t, (l s, i))

-- | Handy alias
type CharScanner = Scanner Point Char

-- | Generalises lexers. This allows us to easily use lexers which
-- don't want to be cornered into the types we have predefined here
-- and use in @common.hsinc@.
data Lexer l s t i = Lexer
  { forall (l :: * -> *) s t i. Lexer l s t i -> TokenLexer l s t i
_step :: TokenLexer l s t i
  , forall (l :: * -> *) s t i.
Lexer l s t i -> s -> Point -> Posn -> l s
_starting :: s -> Point -> Posn -> l s
  , forall (l :: * -> *) s t i.
Lexer l s t i -> Char -> IndexedStr -> i
_withChars :: Char -> [(Point, Char)] -> i
  , forall (l :: * -> *) s t i. Lexer l s t i -> l s -> Point
_looked :: l s -> Point
  , forall (l :: * -> *) s t i. Lexer l s t i -> l s -> Posn
_statePosn :: l s -> Posn
  , forall (l :: * -> *) s t i. Lexer l s t i -> t
_lexEmpty :: t
  , forall (l :: * -> *) s t i. Lexer l s t i -> s
_startingState :: s
  }

-- | Just like 'Lexer' but also knows how to turn its tokens into
-- 'StyleName's.
data StyleLexer l s t i = StyleLexer
  { forall (l :: * -> *) s t i. StyleLexer l s t i -> t -> StyleName
_tokenToStyle :: t -> StyleName
  , forall (l :: * -> *) s t i.
StyleLexer l s t i -> Lexer l s (Tok t) i
_styleLexer :: Lexer l s (Tok t) i
  }

-- | 'StyleLexer' over 'ASI'.
type StyleLexerASI s t = StyleLexer AlexState s t AlexInput

-- | Defines a 'Lexer' for 'ASI'. This exists to make using the new
-- 'lexScanner' easier if you're using 'ASI' as all our lexers do
-- today, 23-08-2014.
commonLexer :: (ASI s -> Maybe (Tok t, ASI s))
            -> s
            -> Lexer AlexState s (Tok t) AlexInput
commonLexer :: forall s t.
(ASI s -> Maybe (Tok t, ASI s))
-> s -> Lexer AlexState s (Tok t) (Char, [Byte], IndexedStr)
commonLexer ASI s -> Maybe (Tok t, ASI s)
l s
st0 = Lexer
  { _step :: ASI s -> Maybe (Tok t, ASI s)
_step = ASI s -> Maybe (Tok t, ASI s)
l
  , _starting :: s -> Point -> Posn -> AlexState s
_starting = s -> Point -> Posn -> AlexState s
forall lexerState.
lexerState -> Point -> Posn -> AlexState lexerState
AlexState
  , _withChars :: Char -> IndexedStr -> (Char, [Byte], IndexedStr)
_withChars = \Char
c IndexedStr
p -> (Char
c, [], IndexedStr
p)
  , _looked :: AlexState s -> Point
_looked = AlexState s -> Point
forall lexerState. AlexState lexerState -> Point
lookedOffset
  , _statePosn :: AlexState s -> Posn
_statePosn = AlexState s -> Posn
forall lexerState. AlexState lexerState -> Posn
stPosn
  , _lexEmpty :: Tok t
_lexEmpty = String -> Tok t
forall a. HasCallStack => String -> a
error String
"Yi.Lexer.Alex.commonLexer: lexEmpty"
  , _startingState :: s
_startingState = s
st0
  }

-- | Combine a character scanner with a lexer to produce a token
-- scanner. May be used together with 'mkHighlighter' to produce a
-- 'Highlighter', or with 'linearSyntaxMode' to produce a 'Mode'.
lexScanner :: Lexer l s t i -> CharScanner -> Scanner (l s) t
lexScanner :: forall (l :: * -> *) s t i.
Lexer l s t i -> CharScanner -> Scanner (l s) t
lexScanner Lexer {s
t
s -> Point -> Posn -> l s
l s -> Point
l s -> Posn
Char -> IndexedStr -> i
TokenLexer l s t i
_step :: forall (l :: * -> *) s t i. Lexer l s t i -> TokenLexer l s t i
_starting :: forall (l :: * -> *) s t i.
Lexer l s t i -> s -> Point -> Posn -> l s
_withChars :: forall (l :: * -> *) s t i.
Lexer l s t i -> Char -> IndexedStr -> i
_looked :: forall (l :: * -> *) s t i. Lexer l s t i -> l s -> Point
_statePosn :: forall (l :: * -> *) s t i. Lexer l s t i -> l s -> Posn
_lexEmpty :: forall (l :: * -> *) s t i. Lexer l s t i -> t
_startingState :: forall (l :: * -> *) s t i. Lexer l s t i -> s
_step :: TokenLexer l s t i
_starting :: s -> Point -> Posn -> l s
_withChars :: Char -> IndexedStr -> i
_looked :: l s -> Point
_statePosn :: l s -> Posn
_lexEmpty :: t
_startingState :: s
..} CharScanner
src = Scanner
  { scanLooked :: l s -> Point
scanLooked = l s -> Point
_looked
  , scanInit :: l s
scanInit = s -> Point -> Posn -> l s
_starting s
_startingState Point
0 Posn
startPosn
  , scanRun :: l s -> [(l s, t)]
scanRun = \l s
st -> case Posn -> Point
posnOfs (Posn -> Point) -> Posn -> Point
forall a b. (a -> b) -> a -> b
$ l s -> Posn
_statePosn l s
st of
      Point
0 -> TokenLexer l s t i -> (l s, i) -> [(l s, t)]
forall state input token.
((state, input) -> Maybe (token, (state, input)))
-> (state, input) -> [(state, token)]
unfoldLexer TokenLexer l s t i
_step (l s
st, Char -> IndexedStr -> i
_withChars Char
'\n' (IndexedStr -> i) -> IndexedStr -> i
forall a b. (a -> b) -> a -> b
$ CharScanner -> Point -> IndexedStr
forall st a. Scanner st a -> st -> [(st, a)]
scanRun CharScanner
src Point
0)
      Point
ofs -> case CharScanner -> Point -> IndexedStr
forall st a. Scanner st a -> st -> [(st, a)]
scanRun CharScanner
src (Point
ofs Point -> Point -> Point
forall a. Num a => a -> a -> a
-Point
1) of
        [] -> []
        (Point
_, Char
ch) : IndexedStr
rest -> TokenLexer l s t i -> (l s, i) -> [(l s, t)]
forall state input token.
((state, input) -> Maybe (token, (state, input)))
-> (state, input) -> [(state, token)]
unfoldLexer TokenLexer l s t i
_step (l s
st, Char -> IndexedStr -> i
_withChars Char
ch IndexedStr
rest)
  , scanEmpty :: t
scanEmpty = t
_lexEmpty
  }

-- | unfold lexer into a function that returns a stream of (state, token)
unfoldLexer :: ((state, input) -> Maybe (token, (state, input)))
            -> (state, input) -> [(state, token)]
unfoldLexer :: forall state input token.
((state, input) -> Maybe (token, (state, input)))
-> (state, input) -> [(state, token)]
unfoldLexer (state, input) -> Maybe (token, (state, input))
f (state, input)
b = (state, input) -> state
forall a b. (a, b) -> a
fst (state, input)
b state -> [(state, token)] -> [(state, token)]
forall a b. a -> b -> b
`seq` case (state, input) -> Maybe (token, (state, input))
f (state, input)
b of
             Maybe (token, (state, input))
Nothing -> []
             Just (token
t, (state, input)
b') -> ((state, input) -> state
forall a b. (a, b) -> a
fst (state, input)
b, token
t) (state, token) -> [(state, token)] -> [(state, token)]
forall a. a -> [a] -> [a]
: ((state, input) -> Maybe (token, (state, input)))
-> (state, input) -> [(state, token)]
forall state input token.
((state, input) -> Maybe (token, (state, input)))
-> (state, input) -> [(state, token)]
unfoldLexer (state, input) -> Maybe (token, (state, input))
f (state, input)
b'

-- * Lenses
makeLensesWithSuffix "A" ''Posn
makeLensesWithSuffix "A" ''Tok
makeLenses ''Lexer
makeLenses ''StyleLexer