Alex monadUserState example

{
module Main (main) where
}

%wrapper "monadUserState"

$digit     = 0-9      -- digits
$alpha     = [a-zA-Z] -- alphabetic characters

-- Each token has a function on the RHS that is a function (String ->
-- Token). We wrap this function in the Alex monad with `pushToken`, which has
-- a result AlexAction ().

tokens :-
  $white+                              ;
  ","                                  { skip }
  ">"                                  { skip }
  $digit+                              { pushToken  $ ErlInt . read         }

{

alexEOF :: Alex ()
alexEOF = return ()

data Token =
  Comma        |
  BinaryOpen   |
  BinaryClose  |
  ErlInt    Integer |
  ErlStr    String
  deriving (Eq, Show)


-- The actual type of the state of the monad.
type AlexUserState = [Token]

-- Initial state of the monad.
alexInitUserState :: AlexUserState
alexInitUserState = []


-- Interactions with the State monad.

-- s :: AlexUserState -> AlexUserState
-- alex_ust :: AlexState -> AlexUserState
-- -> Returns the current state from AlexState.
modifyUserState :: (AlexUserState -> AlexUserState) -> Alex ()
modifyUserState f = Alex $ \s -> let current = alex_ust s
                                     new     = f current
                                 in
                                   Right (s { alex_ust = new },())

-- Returns the current state.
-- I.e., a list of tokens.
getUserState ::  Alex AlexUserState
getUserState = Alex $ \s -> Right (s,alex_ust s)

-- Each action per token should be a value of result `AlexAction`.
-- type AlexAction a = AlexInput -> Int -> Alex a
-- type AlexInput = (AlexPosn, Char, [Byte], String)
pushToken :: (String -> Token) -> AlexAction ()
pushToken tokenizer =
  \(posn,prevChar,pending,s) len -> modifyUserState (push $ take len s) >> alexMonadScan
    where
       push :: String -> AlexUserState -> AlexUserState
       push s ts = ts ++ [(tokenizer s)]



runAlexScan :: String -> Either String AlexUserState
runAlexScan s = runAlex s $ alexMonadScan >> getUserState


main :: IO ()
main = getContents >>= print . runAlexScan

}