Port of submit.m Octave functionality to Haskell

gistfile1.hs

import System.IO
import Control.Exception
import Numeric.LinearAlgebra
import Data.Digest.Pure.SHA
import Data.ByteString.Lazy.Char8 as BS8 (pack)
import Data.List (sort)
import System.Random (randomRIO)
import Network.Curl
import Text.Printf (printf)
import Data.List.Split (splitOn)
import Data.Char (isSpace)
import Control.Monad (when)
import Ex1 -- The excercises are implemented in this module

-- This let's you submit your mlclass excersises in Haskell
-- Requires at least: cabal install hmatrix curl crypto split 
-- Then implement missing functions in module Ex1

submit = do
  putStrLn $ "==\n== [ml-class] Submitting Solutions | Programming Exercise " ++ homeworkId
  partId <- promptPart
  (login, pass) <- loginPrompt
  putStrLn "\n== Connecting to ml-class ... "
  (login, ch, signature) <- getChallenge login
  let hasError = any ((==) 0 . length) [login, ch, signature] 
  when hasError $ putStrLn $ "\n!! Error: " ++ login ++ "\n\n"
  when (not hasError) $ submitAnswer partId login pass ch signature
  where 
    submitAnswer partId login pass ch signature = do
      chResp <- challengeResponse login pass ch
      putStrLn $ "SHA1: " ++ (show chResp)
      result <- submitSolution login chResp partId (output partId) (source partId) signature
      putStrLn $ "\n== [ml-class] Submitted Homework " ++ homeworkId ++ " - Part " ++ (show partId) ++ " - " ++ (validParts !! (partId - 1))
      putStrLn $ "== " ++ result

getChallenge login = withCurlDo $ do
  curl <- initialize
  resp <- do_curl_ curl challengeUrl (CurlPostFields [ "email_address=" ++ login ] : method_POST) :: IO CurlResponse
  let s = (respBody resp)
  let elems = splitOn "|" (trim s)
  putStrLn $ "== Get challenge " ++ (show elems)
  return (elems !! 0, elems !! 1, elems !! 2)

submitSolution login chResp partId output source signature = withCurlDo $ do
  curl <- initialize
  resp <- do_curl_ curl submitUrl (CurlPostFields fields : method_POST) :: IO CurlResponse
  return (respBody resp)
  where fields = [ "homework=" ++ homeworkId 
                 , "part="  ++ (show partId)
                 , "email=" ++ login
                 , "output=" ++ output
                 , "source=" ++ source
                 , "challenge_response=" ++ chResp
                 , "signature=" ++ signature ]

challengeResponse login passwd challenge = do
  rperm <- randperm [0..((length str) - 1)]
  return $ select (sort $ take 16 rperm) str
  where salt = ")~/|]QMB3[!W`?OVt7qC\"@+}"
        s = salt ++ login ++ passwd
        hash = sha1 . BS8.pack
        str = showDigest $ hash $ challenge ++ (showDigest (hash s))

promptPart = do
  putStrLn $ "== Select which part(s) to submit: " ++ homeworkId
  mapM_ putStrLn $ zipWith (\i p -> "==  " ++ (show i) ++ " [" ++ p ++ "]") [1..] validParts
  putStrLn "Enter your choice: "
  partId <- getLine
  let part = read partId :: Int
  return part

loginPrompt = do
  putStrLn "Login (Email address): "
  login <- getLine
  putStrLn "Password: "
  pass <- withEcho False getLine
  return (login, pass)

challengeUrl = "http://www.ml-class.org/course/homework/challenge"
submitUrl    = "http://www.ml-class.org/course/homework/submit"

-- How to get sources?
source partId = ""

outputMatrix :: Matrix Double -> String
outputMatrix = outputVector . flatten

outputVector :: Vector Double -> String
outputVector v = unwords $ map (printf "%0.5f") (toList v)

outputDouble = printf "%0.5f"
         
-- General stuff

withEcho :: Bool -> IO a -> IO a
withEcho echo action = do
  old <- hGetEcho stdin
  bracket_ (hSetEcho stdin echo) (hSetEcho stdin old) action
  
select :: [Int] -> String -> String
select idxs s = map ((!!) s) idxs
  
randperm :: [a] -> IO [a]
randperm xs = selektion (length xs) xs
  where selektion :: Int -> [a] -> IO [a]
        selektion 0 xs = return  []
        selektion k xs = do
          i <- randomRIO (0, length xs - 1)
          let (here, y : there) = splitAt i xs
          ys <- selektion (pred k) $ here ++ there
          return $ y : ys

trim :: String -> String
trim = f . f
   where f = reverse . dropWhile isSpace

-- Homework specific stuff

homeworkId = "1"

validParts = [ "Warm up exercise "
             , "Computing Cost (for one variable)"
             , "Gradient Descent (for one variable)"
             , "Feature Normalization"
             , "Computing Cost (for multiple variables)"
             , "Gradient Descent (for multiple variables)"
             , "Normal Equations" ]

output :: Int -> String
output partId = case partId of 1 -> outputMatrix $ warmUpExercise
                               2 -> outputDouble $ computeCost x1 y1 (fromList [0.5, -0.5])
                               3 -> outputVector $ gradientDescent x1 y1 (fromList [0.5, -0.5]) 0.01 10
                               4 -> outputMatrix $ featureNormalize (dropColumns 1 x2)
                               5 -> outputDouble $ computeCostMulti x2 y2 (fromList [0.1, 0.2, 0.3, 0.4])
                               6 -> outputVector $ gradientDescentMulti x2 y2 (fromList [-0.1, -0.2, -0.3, -0.4]) 0.01 10
                               7 -> outputVector $ normalEqn x2 y2
  where x1 = fromColumns (constant 1 20 : [(fromList $ map (\x -> (exp 1) + (exp 2) * (x / 10)) [1 .. 20])])
        col1 :: Vector Double
        col1 = (toColumns x1) !! 1
        y1 = col1 + (mapVector sin ((toColumns x1) !! 0)) + (mapVector cos ((toColumns x1) !! 1))
        x2 = fromColumns $ (toColumns x1) ++ [(mapVector (\x -> x ** 0.5) col1), (mapVector (\x -> x ** 0.25) col1)]
        y2 = (mapVector (\x -> x ** 0.5) y1) + y1