North Main

Here's the guts of my monadServ json based web app framework.

runRequest' :: String -> String -> st -> InternalServerState st bst -> Maybe String -> IO (String,st)
runRequest' rqBody u st iss@(InternalServerState {backendState = bst, config = config', backendService = bservice}) mfunction = do
    runSrv st (outputString bservice bst Nothing) (beforePrompt config')
    case lookup u (serverCommands config') of
          Just f -> executeCommand u st f
          Nothing -> serveContent u  st
    where executeCommand url' st' f = do
              runSrv st' (outputString bservice bst Nothing) (srvPutStrLn $ "--- url[" ++ url' ++ "]")
              let parseResult= JSON.parse rqBody
              (st'', x) <- runSrvSpecial st' parseResult (outputString bservice bst Nothing) (f config')
              case x of
                    Just res -> do
                         let  parseResult = renderStyle (style {mode=OneLineMode}) (JSON.toDoc res)
                              parseResult' = case mfunction of
                                                   Just function -> function ++"("++parseResult ++");"
                                                   Nothing -> parseResult
                         runSrv st' (outputString bservice bst Nothing) (srvPutStrLn parseResult')
                         return (parseResult', st'')
                    Nothing -> do
                         let result = " returns no JSON Object."
                         runSrv st' (outputString bservice bst Nothing) (srvPutStrLn $ "::" ++ result)
                         return (result, st'')
          serveContent url'  st' = do
              runSrv st' (outputString bservice  bst Nothing) (srvPutStrLn $ " [" ++ "OP" ++"] " ++ url' ++ " --" )
              let fileName= docRoot config' ++ url'
              exists <- doesFileExist (fileName)
              if exists
         then do
                      let (mimetype,binary)= case DataMap.lookup (getExtension url') mimeMapping of
                Nothing -> ("text/plain",False)
                                                   Just (s,b) -> (s,b)
               if binary
          then do
                              result <- ByteString.readFile (fileName)
                -- (encode (unpackList result))
                -- writeContent handle mimetype (octetsToString (unpackList result)) False
                              --writeContent handle mimetype (octetsToString (unpack result)) False
                              return  ( octetsToString (unpack result), st')
          else do
                result <- System.IO.readFile (fileName)
                              return (result,st')
         else do
               return ("404 Not FOUND",st')