# 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 a -> Parser a [a] |
+ | many :: Parser a b -> Parser a [b] |

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

− | many1 :: Parser a a -> Parser a [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) ' '