1st commit on 035_haskell

2 files changed, 155 insertions, 0 deletions

diff --git a/challenge-035/stuart-little/haskell/ch-1.hs b/challenge-035/stuart-little/haskell/ch-1.hs
new file mode 100755
index 0000000000..83ad6e53f3
--- /dev/null
+++ b/challenge-035/stuart-little/haskell/ch-1.hs
@@ -0,0 +1,71 @@
+#!/usr/bin/env runghc
+
+-- run <script> <quoted block of text>
+
+import Data.Char (toUpper)
+import Data.List (intercalate,intersperse)
+import Data.List.Extra (replace)
+import System.Environment (getArgs)
+
+dict :: [(Char,String)]
+dict = map (\(c,s) ->
+              (c, replace "." "1" .
+                replace "-" "111" .
+                intersperse '0' $ s))
+       [('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', "--..")
+       ,('0', "-----")
+       ,('1', ".----")
+       ,('2', "..---")
+       ,('3', "...--")
+       ,('4', "....-")
+       ,('5', ".....")
+       ,('6', "-....")
+       ,('7', "--...")
+       ,('8', "---..")
+       ,('9', "----.")
+       ,('@', ".--.-.")       
+       ,('=', "-...-")
+       ,('?', "..--..")
+       ,('/', "-..-.")
+       ,(',', "--..--")
+       ,('.', ".-.-.-")
+       ,(':', "---...")
+       ,('\'', ".----.")
+       ,('-', "-....-")
+       ,('(', "-.--.")
+       ,(')', "-.--.-")]
+
+wToMorse :: String -> String
+wToMorse = intercalate (replicate 3 '0') . map (maybe "" id) . map (flip lookup dict) . map toUpper
+
+sToMorse :: String -> String
+sToMorse = intercalate (replicate 7 '0') . map wToMorse . words
+
+main = do
+  txt <- getArgs >>= return.head
+  putStrLn $ sToMorse txt
diff --git a/challenge-035/stuart-little/haskell/ch-2.hs b/challenge-035/stuart-little/haskell/ch-2.hs
new file mode 100755
index 0000000000..c3090b1a7c
--- /dev/null
+++ b/challenge-035/stuart-little/haskell/ch-2.hs
@@ -0,0 +1,84 @@
+#!/usr/bin/env runghc
+
+-- run <script> <binary string>
+
+import Data.Char (toLower)
+import Data.List (intercalate,intersperse)
+import Data.List.Extra (replace)
+import Data.List.Split (split,startsWith)
+import Data.List.Utils (join)
+import Data.Maybe (catMaybes)
+import Data.Tuple (swap)
+import System.Environment (getArgs)
+
+dict :: [(String,Char)]
+dict = map swap $
+       map (\(c,s) ->
+              (c, replace "." "1" .
+                replace "-" "111" .
+                intersperse '0' $ s))
+       [('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', "--..")
+       ,('0', "-----")
+       ,('1', ".----")
+       ,('2', "..---")
+       ,('3', "...--")
+       ,('4', "....-")
+       ,('5', ".....")
+       ,('6', "-....")
+       ,('7', "--...")
+       ,('8', "---..")
+       ,('9', "----.")
+       ,('@', ".--.-.")       
+       ,('=', "-...-")
+       ,('?', "..--..")
+       ,('/', "-..-.")
+       ,(',', "--..--")
+       ,('.', ".-.-.-")
+       ,(':', "---...")
+       ,('\'', ".----.")
+       ,('-', "-....-")
+       ,('(', "-.--.")
+       ,(')', "-.--.-")]
+
+splitOn0 :: Int -> String -> [String]
+splitOn0 n = map (dropWhile ('0'==)) .
+             split (startsWith (replicate n '0')) 
+
+wFromMorse :: String -> String
+wFromMorse = catMaybes .
+             map (flip lookup dict) .
+             splitOn0 3
+
+sFromMorse :: String -> String
+sFromMorse = join " " .
+             map wFromMorse .
+             splitOn0 7
+
+main = do
+  bin <- getArgs >>= return.head
+  putStrLn $ sFromMorse bin