Can anyone help me "translate" the below from happs to happstack:
module Main where import HAppS.Server.AlternativeHTTP import HAppS.Server.HTTP.AltFileServe import Control.Monad.State import Numeric import Contracts instance FromData ExContr where fromData = do c <- look "contract" arg1 <- look "arg1" arg2 <- look "arg2" img <- look "image" return $ ExContr (c, map fst $ readFloat arg1 ++ readFloat arg2, read img) main :: IO () main = do simpleHTTP [dir "contractEx" [withData $ \(ExContr t) -> [anyRequest $ liftIO $ liftM toResponse =<< renderEx (ExContr t)] ,anyRequest $ ok $ toResponse renderExDefault] ,fileServe ["Contracts.html"] "public" -- fileserving ] Contracts.hs contains:
newtype ExContr = ExContr (String, [Double], Bool) deriving (Read,Show,Eq) renderEx :: ExContr -> IO Html renderEx exSpec@(ExContr (contractId, args, lattice)) = let pr = evalEx exSpec expValChart = if contractId == "probs" then noHtml -- expected value is meaningless for the probabilities it relies on else h3 << "Expected value" +++ image ! [src (chartUrl $ expectedValuePr pr)] imageType = "png" in if useLatticeImage exSpec then do baseName <- mkUniqueName baseDotFilename exitCode <- latticeImage pr (webPath ++ tmpImgPath ++ baseName) imageType let pageContents = case exitCode of ExitSuccess -> renderExampleForm exSpec (image ! [src latticeUrl, border 1]) expValChart where latticeUrl = "/" ++ tmpImgPath ++ baseName ++ "." ++ imageType _ -> p << "renderEx: error generating lattice image" return $ renderExamplePage pageContents else return $ renderExamplePage $ renderExampleForm exSpec (prToTable pr) expValChart renderExDefault = renderExamplePage $ renderExampleForm (ExContr ("zcb", [fromIntegral t1Horizon, 10], True)) noHtml noHtml Alternatively I would like to understand how to install an old version of HappS compatible with the above code. Needless to say I am very new to Haskell.
1 Answers
Answers 1
This should work, assuming your ExContr type and renderEx functions that you did not supply in your code are similar to what I have here. I cannot actually run your code to ensure that it behaves the same.
module Main where import Control.Monad import Control.Monad.Trans (liftIO) import Happstack.Server.Internal.Monads (anyRequest) import Happstack.Server.SimpleHTTP import Happstack.Server.FileServe import Numeric -- data ExContr = ExContr (String, [Double], String) -- renderEx :: ExContr -> IO String -- renderEx = undefined instance FromData ExContr where fromData = do c <- look "contract" arg1 <- look "arg1" arg2 <- look "arg2" img <- look "image" return $ ExContr (c, map fst $ readFloat arg1 ++ readFloat arg2, read img) main :: IO () main = do simpleHTTP (nullConf { port = 80 }) $ msum [ dir "contractEx" $ withData $ \(ExContr t) -> msum $ [ anyRequest $ fmap toResponse $ liftIO $ renderEx (ExContr t) , anyRequest $ toResponse renderExDefault ] , serveDirectory DisableBrowsing ["Contracts.html"] "public" ] Edited: forgot the renderExDefault line.
0 comments:
Post a Comment