Created
March 8, 2012 20:52
-
-
Save zearen/2003374 to your computer and use it in GitHub Desktop.
Parsing Morse code with haskell
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
data MorseNode = MorseNode | |
{ mnVal :: Char | |
, mnDit :: Maybe MorseNode | |
, mnDah :: Maybe MorseNode | |
} | |
deriving (Eq) | |
instance Show MorseNode where | |
showsPrec _ (MorseNode val dit dah) = ('\'':) . (val:) . ("<."++) | |
. (maybe (' ':) shows $ dit) . ('-':) . (maybe (' ':) shows $ dah) | |
. ('>':) | |
toJSON = flip toJSONs [] | |
toJSONs (MorseNode val dit dah) = ("[\""++) . (val:) . ("\","++) | |
. (maybe ('0':) toJSONs $ dit) . (',':) | |
. (maybe ('0':) toJSONs $ dah) . (']':) | |
mkMorseNode = MorseNode ' ' Nothing Nothing | |
insertCode :: (String, Char) -> MorseNode -> MorseNode | |
insertCode ("", ch) (MorseNode _ dit dah) = (MorseNode ch dit dah) | |
insertCode ('.':rest, ch) mn@MorseNode{mnDit=dit} = | |
mn{mnDit=Just $ insertCode (rest, ch) $ maybe mkMorseNode id dit} | |
insertCode ('-':rest, ch) mn@MorseNode{mnDah=dah} = | |
mn{mnDah=Just $ insertCode (rest, ch) $ maybe mkMorseNode id dah} | |
insertCode _ _ = error "morse: Invalid character" | |
morseCode = foldr insertCode mkMorseNode | |
[ (".-",'a') | |
, ("-...",'b') | |
, ("-.-.",'c') | |
, ("-..",'d') | |
, (".",'e') | |
, ("..-.",'f') | |
, ("--.",'g') | |
, ("....",'h') | |
, ("..",'i') | |
, (".---",'j') | |
, ("-.-",'k') | |
, (".-..",'l') | |
, ("--",'m') | |
, ("-.",'n') | |
, ("---",'o') | |
, (".--.",'p') | |
, ("--.-",'q') | |
, (".-.",'r') | |
, ("...",'s') | |
, ("-",'t') | |
, ("..-",'u') | |
, ("...-",'v') | |
, (".--",'w') | |
, ("-..-",'x') | |
, ("-.--",'y') | |
, ("--..",'z') | |
, (".-.-.-",'.') | |
, ("--..--",',') | |
, ("..--..",'?') | |
, ("-..-.",'/') | |
, (".--.-.",'@') | |
, (".----",'1') | |
, ("..---",'2') | |
, ("...--",'3') | |
, ("....-",'4') | |
, (".....",'5') | |
, ("-....",'6') | |
, ("--...",'7') | |
, ("---..",'8') | |
, ("----.",'9') | |
, ("-----",'0') | |
] | |
parseMorseSegment :: Maybe MorseNode -> String -> (String -> String, String) | |
-- Indicates invalid morse sequence | |
parseMorseSegment Nothing rest = (('~':), rest) | |
parseMorseSegment (Just MorseNode{mnDit=dit}) ('.':rest) = | |
parseMorseSegment dit rest | |
parseMorseSegment (Just MorseNode{mnDah=dah}) ('-':rest) = | |
parseMorseSegment dah rest | |
parseMorseSegment (Just MorseNode{mnVal=val}) ("") = ((val:), "") | |
parseMorseSegment (Just MorseNode{mnVal=val}) (_:rest) = ((val:), rest) | |
parseMorseCode :: String -> String | |
parseMorseCode message = case parseMorseSegment (Just morseCode) message of | |
(strS, "") -> strS [] | |
(strS, rest) -> strS $ parseMorseCode rest | |
main = do | |
line <- getLine | |
if null line | |
then return () | |
else do | |
putStrLn $ parseMorseCode line | |
main |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment