# Haskell Quiz/Morse Code/Solution Dolio

### From HaskellWiki

< Haskell Quiz | Morse Code(Difference between revisions)

(creation) |
(display morse split) |
||

Line 21: | Line 21: | ||

satisfy p = token >>= guard . p | satisfy p = token >>= guard . p | ||

− | many :: Parser a | + | many :: Parser a b -> Parser a [b] |

many p = many1 p `mplus` return [] | many p = many1 p `mplus` return [] | ||

− | many1 :: Parser a | + | many1 :: Parser a b -> Parser a [b] |

many1 p = liftM2 (:) p (many p) | many1 p = liftM2 (:) p (many p) | ||

Line 34: | Line 34: | ||

string (x:xs) = satisfy (==x) >> string xs | string (x:xs) = satisfy (==x) >> string xs | ||

− | morseLetter :: Parser Char Char | + | morseLetter :: Parser Char (String, Char) |

− | morseLetter = msum $ zipWith (\c l -> string c >> return l) morse ['a'..'z'] | + | morseLetter = msum $ zipWith (\c l -> string c >> return (c,l)) morse ['a'..'z'] |

− | main = interact $ unlines . concatMap (evalStateT (total $ many morseLetter)) . words | + | main = interact $ unlines |

+ | . concatMap (map showMorse | ||

+ | . evalStateT (total $ many morseLetter)) | ||

+ | . words | ||

+ | |||

+ | intercalate :: [a] -> [[a]] -> [a] | ||

+ | intercalate l = concat . intersperse l | ||

+ | |||

+ | showMorse :: [(String, Char)] -> String | ||

+ | showMorse = (\(m,l) -> pad l ++ intercalate "|" m) . unzip | ||

+ | where pad l = l ++ replicate (30 - length l) ' ' | ||

</haskell> | </haskell> |

## Latest revision as of 17:36, 22 April 2007

This solution uses a naive implementation of monadic parser combinators, simply using the state transform of the list monad. For more information on how all this works, a google search for 'monadic parser combinators' should be more than sufficient.

import Data.List import Control.Monad import Control.Monad.State -- The classic parser monad, with input token type a, and output type b type Parser a b = StateT [a] [] b morse = [ ".-", "-...", "-.-.", "-..", ".", "..-.", "--.", "....", "..", ".---" , "-.-", ".-..", "--", "-.", "---", ".--.", "--.-", ".-.", "...", "-" , "..-", "...-", ".--", "-..-", "-.--", "--.." ] token :: Parser a a token = do (a:as) <- get ; put as ; return a satisfy :: (a -> Bool) -> Parser a () satisfy p = token >>= guard . p many :: Parser a b -> Parser a [b] many p = many1 p `mplus` return [] many1 :: Parser a b -> Parser a [b] many1 p = liftM2 (:) p (many p) total :: Parser a b -> Parser a b total p = p >>= \b -> get >>= guard . null >> return b string :: String -> Parser Char () string [] = return () string (x:xs) = satisfy (==x) >> string xs morseLetter :: Parser Char (String, Char) morseLetter = msum $ zipWith (\c l -> string c >> return (c,l)) morse ['a'..'z'] main = interact $ unlines . concatMap (map showMorse . evalStateT (total $ many morseLetter)) . words intercalate :: [a] -> [[a]] -> [a] intercalate l = concat . intersperse l showMorse :: [(String, Char)] -> String showMorse = (\(m,l) -> pad l ++ intercalate "|" m) . unzip where pad l = l ++ replicate (30 - length l) ' '