Created
January 13, 2016 09:21
-
-
Save mitsuji/dced485228c41cdd6236 to your computer and use it in GitHub Desktop.
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 OverloadedStrings #-} | |
import Data.String (fromString) | |
import System.Environment (getArgs) | |
import qualified Network.Wai.Handler.Warp as Warp | |
import qualified Network.Wai as Wai | |
import qualified Network.HTTP.Types as H | |
import qualified Data.ByteString as BS -- use for input | |
import qualified Data.ByteString.Lazy as LBS -- use for out | |
import qualified Data.Text as T | |
import Data.Text.Encoding (decodeLatin1,encodeUtf8) | |
main :: IO () | |
main = do | |
mainHost:mainPort:_ <- getArgs | |
Warp.runSettings ( | |
Warp.setHost (fromString mainHost) $ | |
Warp.setPort (read mainPort) $ | |
Warp.defaultSettings | |
) httpApp | |
httpApp :: Wai.Application | |
httpApp req respond = do | |
let reqQuery = Wai.queryString req | |
let eitherParams = do | |
p1 <- case lookupQuery "param1" reqQuery of | |
Nothing -> Left "param1 not specified" | |
Just p -> Right p | |
p2 <- case lookupQuery "param2" reqQuery of | |
Nothing -> Left "param2 not specified" | |
Just p -> Right p | |
return (p1,p2) | |
case eitherParams of | |
Left err -> | |
respond $ Wai.responseLBS H.status404 [("Content-Type","text/plain")] $ | |
LBS.fromStrict $ encodeUtf8 $ T.pack err | |
Right (param1,param2) -> | |
respond $ Wai.responseLBS H.status200 [("Content-Type","text/plain")] $ | |
LBS.fromStrict $ encodeUtf8 $ T.pack $ mconcat [param1,",",param2] | |
lookupQuery :: BS.ByteString -> [(BS.ByteString, Maybe BS.ByteString)] -> Maybe String | |
lookupQuery key query = do | |
val <- lookup key query | |
val' <- val -- strip Maybe | |
return $ T.unpack $ decodeLatin1 val' | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment