Created
March 12, 2016 15:28
-
-
Save anonymous/3ef9a0d0bd039b23c669 to your computer and use it in GitHub Desktop.
Haskell processing server question...
This file contains 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
{-# LANGUAGE MultiParamTypeClasses #-} | |
{-# LANGUAGE FunctionalDependencies #-} | |
import Control.Monad (forever) | |
-- Some examples of datatypes that represent simple requests our system | |
-- can receive and responses it returns. | |
data GetSomeStatsRequest = GetSomeStatsRequest | |
data GetSomeStatsResponse = GetSomeStatsResponse | |
{ worktime :: Int, cpuavg :: Int } | |
data DeleteImportantFileRequest = DeleteImportantFileRequest | |
{ filename :: String } | |
data DeleteImportantFileResponse = FileDeleted | |
| CantDeleteTooImportant | |
data CalcSumOfNumbersRequest = CalcSumOfNumbersRequest Int Int | |
data CalcSumOfNumbersResponse = CalcSumOfNumbersResponse Int | |
-- Restricting request-to-response relation with typeclasses. | |
class Response b => Request a b | a -> b where | |
processRequest :: a -> IO b | |
class Response b where | |
serializeResponse :: b -> String | |
instance Request GetSomeStatsRequest GetSomeStatsResponse where | |
processRequest req = return $ GetSomeStatsResponse 33 42 | |
instance Response GetSomeStatsResponse where | |
serializeResponse (GetSomeStatsResponse wt ca) = | |
show wt ++ ", " ++ show ca | |
instance Request DeleteImportantFileRequest | |
DeleteImportantFileResponse where | |
processRequest _ = return FileDeleted -- just pretending! | |
instance Response DeleteImportantFileResponse where | |
serializeResponse FileDeleted = "done!" | |
serializeResponse CantDeleteTooImportant = "nope!" | |
instance Request CalcSumOfNumbersRequest CalcSumOfNumbersResponse where | |
processRequest (CalcSumOfNumbersRequest a b) = | |
return $ CalcSumOfNumbersResponse (a + b) | |
instance Response CalcSumOfNumbersResponse where | |
serializeResponse (CalcSumOfNumbersResponse r) = show r | |
-- Incorrect code below, just how I imagine this may work... | |
deserializeAnyRequest :: Request a b => String -> a | |
deserializeAnyRequest str | |
| head ws == "stats" = GetSomeStatsRequest | |
| head ws == "delete" = DeleteImportantFileRequest (ws!!1) | |
| head ws == "sum" = CalcSumOfNumbersRequest (read $ ws!!1) (read $ ws!!2) | |
where ws = words str | |
main :: IO () | |
main = forever $ do | |
putStrLn "Please enter your command!" | |
cmdstr <- getLine | |
let req = deserializeAnyRequest cmdstr | |
resp <- processRequest req | |
putStrLn $ "Result: " ++ (serializeResponse resp) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment