https://codeiq.jp/ace/kansai_takako/q390

neapolitan.hs

--
-- Neapolitan
--
-- Build:
-- $ ghc -o neapolitan neapolitan.hs
--
-- Usage:
-- $ ./neapolitan < input.txt
--
-- System requirements
-- Glasgow Haskell Compiler, Version 7.6.3, stage 2 booted by GHC version 7.4.2
--
import Control.Applicative ((<$>))
import Text.Parsec (anyChar, char, many, noneOf, parse)
import Text.Parsec.String (Parser)

data Pasta = Spagetti String | Neapolitan Char

instance Show Pasta where
    show (Spagetti str)   = str
    show (Neapolitan chr) = "[" ++ [chr] ++ "]"

main :: IO ()
main  = putStr =<< neapolitan <$> getContents

neapolitan :: String -> String
neapolitan str = case parse (parsePasta "neapolitan") "neapolitan" str of
                    Left err -> show err
                    Right ps -> concatMap show ps

parsePasta :: String -> Parser [Pasta]
parsePasta [] = do
    str <- many $ anyChar
    return [Spagetti str]
parsePasta (x:xs) = do
    y  <- scan x
    ys <- parsePasta xs
    return $ y ++ ys

scan :: Char -> Parser [Pasta]
scan c = do
    str <- many $ noneOf [c]
    chr <- char c
    return [Spagetti str, Neapolitan chr]