Question

I’m trying to implement a lexer in Haskell. For easy console input and output, I’ve used an intermediate data type Transition Table.

type TransitionTable = [(Int, Transitions String Int)]
type Transitions a b = [(a, b)]

I want to take input from the user for all the states and transitions. I do not want to take the total number of states before hand. I want it to keep taking input for the transitions of each state until the user types “–“ . If the user types “—“, the current state is discarded and the input terminates.

After a lot of attempts I came up with this, which I think is horrible code.

-- |A function to emulate the while loop for easy IO functionality.
--  Defination:- while @comparator @func @start:
--      *comparator @arg: A function which returns True or False on the basis of @arg.
--          The loop stops when False is returned.
--      *func: The function which is executed repeadly.
--          It is responsible for returning the next @arg for the comparator on the basis of the current @arg.
--      *start: The starting value of @arg to pass to the comparator.
while :: (Monad m) => (a -> Bool) -> (a -> m a) -> a -> m a
while comparator func start =
    if comparator start then do
        nxt <- func start
        while comparator func nxt
    else
        return start

-- |A modification of putStr which flushes out stdout. Corrents buffer problems.
myPutStr :: String -> IO ()
myPutStr str = putStr str >> hFlush stdout >> return ()

---

-- Takes input from the console to generate a TransitionTable.
inputTransitionTable :: IO TransitionTable
inputTransitionTable = do
    putStrLn "Type -- for next state and --- for completing input entering."
    retVal <- while notFinished takeInfo (0, [])
    return (snd retVal)
        where
            -- Returns True when input entry is over.
            notFinished (i, _) = i > -1

            -- Takes the current state number and the incomplete corrosponding transition table which is populated 
            -- with user input. Input ends when user enters "---". State number is set to -1 when input is over.
            takeInfo (i, states) = do
                putStrLn ("Adding transitions to state " ++ show i ++ ": ")
                retVal <- while entryNotFinished takeStateInfo ("", [])
                let (inpStr, stateInfo) = retVal
                case inpStr == "---" of
                    True -> return (-1, states)
                    False -> return (i+1, states ++ [(i, stateInfo)])

            -- Checks if input entry is over. Returns False if finished.
            entryNotFinished (s, _)
                | s == "--" || s == "---"  =  False
                | otherwise  =  True

            -- Takes the input state number along with the corresponding transitions.
            -- Input ends when the user enters "--".
            takeStateInfo (str, state_info) = do
                myPutStr "\tEnter transitions symbol: "
                symbol <- getLine
                if symbol == "--" || symbol == "---" then
                    return (symbol, state_info)
                else do
                    myPutStr "\t\tEnter the transition state number: "
                    state' <- getLine
                    let state = read state' :: Int
                    return (str, (symbol, state):state_info)

Basically this is how it runs:

*Main> x <- inputTransitionTable
Type -- for next state and --- for completing input entering.
Adding transitions to state 0: 
    Enter transitions symbol: a
        Enter the transition state number: 1
    Enter transitions symbol: b
        Enter the transition state number: 2
    Enter transitions symbol: --
Adding transitions to state 1: 
    Enter transitions symbol: a
        Enter the transition state number: 2
    Enter transitions symbol: b
        Enter the transition state number: 3
    Enter transitions symbol: --
Adding transitions to state 2: 
    Enter transitions symbol: a
        Enter the transition state number: 3
    Enter transitions symbol: --
Adding transitions to state 3: 
    Enter transitions symbol: --
Adding transitions to state 4:
    Enter transitions symbol: ---
(0.03 secs, 344420 bytes)

-- Output
*Main> prettyPrintTransitionTable x
State   Transitions
0  ("b",2)  ("a",1)
1  ("b",3)  ("a",2)
2  ("a",3)
3

Is there a better way to do this?

Answer 1

It could be as simple as this, if you add the “deriving Read” declarations and don’t care about interaction.

main = do
    allInput <- getContents -- scarfs all stdin up to eof
    let inLines = lines allInput
    let (tableLines, _:otherlines) = break (== "endtable") inLines
    let table = ((read $ unlines tableLines) :: TransitionTable)
    -- process otherlines here