HQ9FSI+ interpreter

HQ9FSIplus.hs

{- HQ9FSI+ interpreter -}
import Data.Char (toUpper)
import Control.Monad ((>=>))
import Data.List (intersperse)
import System.Environment (getArgs)

type Program = String -> (String, String)

step :: Char -- operation
    -> String -- entire program
    -> String -- standard input
    -> (String, String) -- output and remaining input

step 'H' self = helloworld -- Hello world
step 'Q' self = (,) self -- quine
step '9' self = lyrics99Bottles -- 99 Bottles of Beer
step 'F' self = fizzbuzz -- fizzbuzz
step 'S' self = selfInterpreter -- run self interpreter
step 'I' self = showImplementation -- show an implementation of HQ9FSI+
step '+' self = (,) "" -- + has no effects.
step _ self = (,) ""

main = getArgs >>= (readFile >=> execute) . head

execute :: String -> IO ()
execute xs = getContents >>= putStrLn . fst . run xs xs

run :: [Char] -> String -> String -> (String, String)
run [] _ input = ("", [])
run (x:xs) self input = let (output, rest) = step x self input
                            (result, code) = run xs self rest
                        in (output ++ result, code)

helloworld :: Program
helloworld = (,) "Hello, world!"

lyrics99Bottles :: Program
lyrics99Bottles = (,) $ concat $ intersperse "\n" $ map lyric [99,98..0]
    where
        lyric n = lyricA n ++ lyricB n
        cap (x:xs) = toUpper x : xs
        plural 1 = ""
        plural n = "s"
        bottleExpr = ("bottle"++) . plural
        bottle 0 = "no more " ++ bottleExpr 0
        bottle n = show n ++ " " ++ bottleExpr n
        lyricA n = cap (bottle n) ++ "of beer on the wall, " ++ bottle n ++ "of beer.\n"
        lyricB 0 = "Go to the store and buy some more, 99 bottles of beer on the wall.\n"
        lyricB n = "Take one down and pass it around, " ++ bottle (n - 1) ++ "of beer on the wall.\n"

fizzbuzz :: Program
fizzbuzz = (,) $ concat $ intersperse "\n" $ map f [1..100]
    where
        f n = case (mod n 3, mod n 5) of
                   (0, 0) -> "FizzBuzz"
                   (0, _) -> "Fizz"
                   (_, 0) -> "Buzz"
                   (_, _) -> show n

selfInterpreter :: Program
selfInterpreter input = run input input ""

showImplementation :: Program
showImplementation = (,) $ implementation ++ show implementation

implementation :: String
implementation = "{- HQ9FSI+ interpreter -}\nimport Data.Char (toUpper)\nimport Control.Monad ((>=>))\nimport Data.List (intersperse)\nimport System.Environment (getArgs)\n\ntype Program = String -> (String, String)\n\nstep :: Char -- operation\n    -> String -- entire program\n    -> String -- standard input\n    -> (String, String) -- output and remaining input\n\nstep 'H' self = helloworld -- Hello world\nstep 'Q' self = (,) self -- quine\nstep '9' self = lyrics99Bottles -- 99 Bottles of Beer\nstep 'F' self = fizzbuzz -- fizzbuzz\nstep 'S' self = selfInterpreter -- run self interpreter\nstep 'I' self = showImplementation -- show an implementation of HQ9FSI+\nstep '+' self = (,) \"\" -- + has no effects.\nstep _ self = (,) \"\"\n\nmain = getArgs >>= (readFile >=> execute) . head\n\nexecute :: String -> IO ()\nexecute xs = getContents >>= putStrLn . fst . run xs xs\n\nrun :: [Char] -> String -> String -> (String, String)\nrun [] _ input = (\"\", [])\nrun (x:xs) self input = let (output, rest) = step x self input\n                            (result, code) = run xs self rest\n                        in (output ++ result, code)\n\nhelloworld :: Program\nhelloworld = (,) \"Hello, world!\"\n\nlyrics99Bottles :: Program\nlyrics99Bottles = (,) $ concat $ intersperse \"\\n\" $ map lyric [99,98..0]\n    where\n        lyric n = lyricA n ++ lyricB n\n        cap (x:xs) = toUpper x : xs\n        plural 1 = \"\"\n        plural n = \"s\"\n        bottleExpr = (\"bottle\"++) . plural\n        bottle 0 = \"no more \" ++ bottleExpr 0\n        bottle n = show n ++ \" \" ++ bottleExpr n\n        lyricA n = cap (bottle n) ++ \"of beer on the wall, \" ++ bottle n ++ \"of beer.\\n\"\n        lyricB 0 = \"Go to the store and buy some more, 99 bottles of beer on the wall.\\n\"\n        lyricB n = \"Take one down and pass it around, \" ++ bottle (n - 1) ++ \"of beer on the wall.\\n\"\n\nfizzbuzz :: Program\nfizzbuzz = (,) $ concat $ intersperse \"\\n\" $ map f [1..100]\n    where\n        f n = case (mod n 3, mod n 5) of\n                   (0, 0) -> \"FizzBuzz\"\n                   (0, _) -> \"Fizz\"\n                   (_, 0) -> \"Buzz\"\n                   (_, _) -> show n\n\nselfInterpreter :: Program\nselfInterpreter input = run input input \"\"\n\nshowImplementation :: Program\nshowImplementation = (,) $ implementation ++ show implementation\n\nimplementation :: String\nimplementation = "