Difference between revisions of "Haskell Quiz/Morse Code/Solution Dolio"
< Haskell Quiz | Morse Code
Jump to navigation
Jump to search
(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 |
+ | 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) ' '