如何转换为happs - > happstack?

时间:2016-03-04 16:22:21

标签: haskell happstack

任何人都可以帮助我"翻译"从幸福到幸福的下面:

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

Contracts.hs包含:

DECLARE @spResult int;
DECLARE @paramA int;
DECLARE @paramB int;
DECLARE @paramC int;

set @paramA = 2013
set @paramB = 1;
set @paramC = 10;

exec @spResult = rstoredProc1    @paramA ,@paramB  ,@paramC
exec @spResult = rstoredProc2    @paramA ,@paramB  ,@paramC
exec @spResult = rstoredProc3    @paramA ,@paramB  ,@paramC
exec @spResult = rstoredProc4    @paramA ,@paramB  ,@paramC
exec @spResult = rstoredProc5    @paramA ,@paramB  ,@paramC
...

或者我想了解如何安装与上述代码兼容的旧版HappS。不用说,我对Haskell很新。

1 个答案:

答案 0 :(得分:1)

这应该有效,假设你的代码中没有提供的ExContr类型和renderEx函数与我在这里的类似。我实际上无法运行您的代码以确保它的行为相同。

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 $ ok $ toResponse renderExDefault
              ]
       , serveDirectory DisableBrowsing ["Contracts.html"] "public"
       ] 

已编辑:忘记了renderExDefault行。