{
module Presyntax.Lexer where

import qualified Data.ByteString.Lazy as Lbs
import qualified Data.Text.Encoding as T

import Presyntax.Tokens
}

%wrapper "monadUserState-bytestring"

$alpha = [a-zA-Z]
$digit = [0-9]
$white_nol = $white # \n

tokens :-
  $white_nol+                   ;
  
-- zero state: normal lexing
<0> $alpha [$alpha $digit \_ \']* { yield TokVar }

<0> \=                            { always TokEqual }
<0> \:                            { always TokColon }
<0> \,                            { always TokComma }
<0> \*                            { always TokStar }

<0> ".1"                          { always TokPi1 }
<0> ".2"                          { always TokPi2 }

<0> \\                            { always TokLambda }
<0> "->"                          { always TokArrow }

<0> \(                            { always TokOParen }
<0> \{                            { always TokOBrace }

<0> \)                            { always TokCParen }
<0> \}                            { always TokCBrace }
<0> \;                            { always TokSemi }

<0>       \n                      { begin newline }

-- newline: emit a semicolon when de-denting
<newline> {
  \n ;
  () { offsideRule }
}


{
alexEOF :: Alex Token
alexEOF = do
  (AlexPn _ l c, _, _, _) <- alexGetInput
  pure $ Token TokEof l c

yield k (AlexPn _ l c, _, s, _) i = pure (Token (k $! (T.decodeUtf8 (Lbs.toStrict (Lbs.take i s)))) l c)
always k x i = yield (const k) x i

data AlexUserState = AlexUserState { layoutColumns :: [Int], startCodes :: [Int] }
alexInitUserState = AlexUserState [1] []

just :: Alex a -> AlexAction Token
just k _ _ = k *> alexMonadScan

getUserState :: Alex AlexUserState
getUserState = Alex $ \s -> Right (s, alex_ust s)

mapUserState :: (AlexUserState -> AlexUserState) -> Alex ()
mapUserState k = Alex $ \s -> Right (s { alex_ust = k $! alex_ust s }, ())

pushStartCode :: Int -> Alex ()
pushStartCode c = do
  sc <- alexGetStartCode
  mapUserState $ \s -> s { startCodes = sc:startCodes s }
  alexSetStartCode c
  
popStartCode :: Alex ()
popStartCode = do
  sc <- startCodes <$> getUserState
  case sc of
    [] -> alexSetStartCode 0
    (x:xs) -> do
      mapUserState $ \s -> s { startCodes = xs }
      alexSetStartCode x

offsideRule :: AlexInput -> Int64 -> Alex Token
offsideRule i@(AlexPn p line col, _, s, _) l = do
  ~(col':_) <- layoutColumns <$> getUserState
  case col `compare` col' of
    EQ -> do
      popStartCode
      pure (Token TokSemi line col)
    GT -> do
      popStartCode
      alexMonadScan
    LT -> alexError "wrong ass indentation"
}