haskell Scotty:没有MonadIO ScottyT的示例(由使用'liftIO'引起)

mbskvtky  于 12个月前  发布在  其他
关注(0)|答案(2)|浏览(206)

我试图自己学习HASKELL,我发现了这个页面https://www.parsonsmatt.org/2015/05/02/scotty_and_persistent.html,我试图使用代码,但我得到了一个错误:

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
Products
  name Text
  description Text
  price Int
  deriving Show
|]

main :: IO ()
main = scotty 3000 $ do
  Web.Scotty.middleware logStdoutDev
  inAppDb $ do
    doDbStuff
  Web.Scotty.get "/api/products" $ json [(0::Int)..10]

inAppDb = liftIO . dbFunction

dbFunction query = runStderrLoggingT $
        withPostgresqlPool connStr 10 $
        \pool -> liftIO $ runSqlPersistMPool query pool

doDbStuff = do
  res  :: [Entity Products] <- selectList [] [LimitTo 1]
  liftIO $ print res

字符串
误差

➜  my-project stack run
my-project> build (lib + exe)
Preprocessing library for my-project-0.1.0.0..
Building library for my-project-0.1.0.0..
ld: warning: -single_module is obsolete
Preprocessing executable 'my-project-exe' for my-project-0.1.0.0..
Building executable 'my-project-exe' for my-project-0.1.0.0..
[1 of 3] Compiling Main [Source file changed]

/Users/home/my-project/app/Main.hs:176:11: error:
    • No instance for (Control.Monad.IO.Class.MonadIO
                         (Web.Scotty.Internal.Types.ScottyT
                            Data.Text.Internal.Lazy.Text IO))
        arising from a use of ‘liftIO’
    • In the first argument of ‘(.)’, namely ‘liftIO’
      In the expression: liftIO . dbFunction
      In an equation for ‘inAppDb’: inAppDb = liftIO . dbFunction
    |
176 | inAppDb = liftIO . dbFunction
    |           ^^^^^^

Error: [S-7282]
       Stack failed to execute the build plan.

       While executing the build plan, Stack encountered the error:

       [S-7011]
       While building package my-project-0.1.0.0 (scroll up to its section to see the error) using:
       /Users/home/.stack/setup-exe-cache/aarch64-osx/Cabal-simple_6HauvNHV_3.8.1.0_ghc-9.4.7 --verbose=1 --builddir=.stack-work/dist/aarch64-osx/ghc-9.4.7 build lib:my-project exe:my-project-exe --ghc-options " -fdiagnostics-color=always"
       Process exited with code: ExitFailure 1


我不知道为什么会出现错误:liftIO .
你对此有什么想法吗?
Thanks in advance
Aron

jdzmm42g

jdzmm42g1#

根据评论,Scotty从0.10版本开始重新设计,使ScottyM(和ScottyT)成为一个“仅配置”的monad,它声明了Web服务器的中间件和路由,但本身不能执行I/O。
因此,博客作者试图使用inAppDb将任何数据库设置或其他I/O移动到Scotty应用程序中都不会工作。相反,在调用scotty之前删除inAppDb定义并将该设置移动到main中。对于您的特定代码示例,它看起来像这样:

main :: IO ()
main = do
  dbFunction $ do
    doDbStuff
  scotty 3000 $ do
    Web.Scotty.middleware logStdoutDev
    Web.Scotty.get "/api/products" $ json [(0::Int)..10]

字符串
就博客文章的其余部分而言,看起来作者在第2部分放弃了整个inAppDbinHandlerDb调用应该都能正常工作。它们在ActionM monad中运行,该monad支持通过liftIO进行I/O操作,因此下面的示例应该进行类型检查:

import qualified Web.Scotty as S
import qualified Data.Text.Lazy as T

inHandlerDb = liftIO . dbFunction

main :: IO ()
main = do
  dbFunction $ do
    doMigrations
    doDbStuff
  S.scotty 3000 $ do
        S.middleware logStdoutDev
        S.get "/" $ S.html "Hello World"
        S.get "/products" $ do
            products <- inHandlerDb $ selectList [] []
            S.html (T.pack $ show $ length (products :: [Entity Products]))

l5tcr1uw

l5tcr1uw2#

我终于完成了我的代码。我现在有一个Haskell的例子,使用Scotty,Persistent(Postgresql)和一个返回JSON数据的GET方法。
下面是完整的代码:

{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE QuasiQuotes                #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE UndecidableInstances       #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE RecordWildCards            #-}

module Main (main) where

import Control.Monad.Trans.Reader (ReaderT)
import Control.Monad.Trans.Resource (ResourceT)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (runStdoutLoggingT, NoLoggingT)
import Database.Persist
import Database.Persist.TH (share, mkPersist, sqlSettings, mkMigrate, persistLowerCase)
import Database.Persist.Postgresql (ConnectionString, SqlBackend, runMigration, runSqlPersistMPool, withPostgresqlPool)
import GHC.Generics
import Web.Scotty (html, delete, get, post, put, scotty, ActionM, json, text, middleware)
import Data.Aeson (FromJSON(..), ToJSON(..), (.:), (.=), pairs, object, withObject)
import Data.Text
import Network.Wai.Middleware.RequestLogger (logStdoutDev)

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
Products sql=products
  name Text
  description Text
  price Int
  deriving Show Eq Generic
|]

connStr :: Database.Persist.Postgresql.ConnectionString
connStr = "host=localhost dbname=example user=postgres password=postgres port=5432"

inBackend :: ReaderT SqlBackend (NoLoggingT (ResourceT IO)) a-> IO a
inBackend action = runStdoutLoggingT $ withPostgresqlPool connStr 10 $ \pool -> liftIO $ do
  flip runSqlPersistMPool pool $ do
    -- runMigration migrateAll
    action

instance ToJSON (Entity Products) where
  toJSON (Entity productId (c@Products{..})) =
    object
    [ "id" .= productId
    , "name" .= productsName
    , "price" .= productsPrice
    , "description" .= productsDescription
    ]

main :: IO ()
main = do
  scotty 3000 $ do
    Web.Scotty.middleware logStdoutDev
    Web.Scotty.get "/api/products" $ do
      (products :: [Entity Products]) <-
        liftIO $ inBackend $ selectList [] []
      json products

字符串
我还分享了我使用过的依赖项列表及其各自的版本:

dependencies:
- base >= 4.7 && < 5
- text
- containers
- monad-logger
- postgresql-simple
- persistent
- persistent-postgresql
- persistent-template
- esqueleto
- uuid
- mtl
- time
- exceptions
- unliftio-core
- transformers
- resourcet
- scotty
- blaze-html
- aeson
- wai-extra

➜  my-project stack ls dependencies
Cabal 3.8.1.0
Cabal-syntax 3.8.1.0
HUnit 1.6.2.0
OneTuple 0.4.1.1
Only 0.1
QuickCheck 2.14.3
StateVar 1.2.2
aeson 2.1.2.1
ansi-terminal 0.11.5
ansi-terminal-types 0.11.5
appar 0.1.8
array 0.5.4.0
asn1-encoding 0.9.6
asn1-parse 0.9.5
asn1-types 0.3.4
assoc 1.1
async 2.2.4
attoparsec 0.14.4
attoparsec-aeson 2.1.0.0
attoparsec-iso8601 1.1.0.0
auto-update 0.1.6
base 4.17.2.0
base-compat 0.12.3
base-compat-batteries 0.12.3
base-orphans 0.9.1
base64-bytestring 1.2.1.0
basement 0.0.16
bifunctors 5.5.15
binary 0.8.9.1
bitvec 1.1.5.0
blaze-builder 0.4.2.3
blaze-html 0.9.1.2
blaze-markup 0.8.3.0
bsb-http-chunked 0.0.0.4
byteorder 1.0.4
bytestring 0.11.5.2
bytestring-builder 0.10.8.2.0
cabal-doctest 1.0.9
call-stack 0.4.0
case-insensitive 1.2.1.0
colour 2.3.6
comonad 5.0.8
conduit 1.3.5
conduit-extra 1.3.6
containers 0.6.7
contravariant 1.5.5
cookie 0.4.6
cryptohash-md5 0.11.101.0
cryptohash-sha1 0.11.101.0
cryptonite 0.30
data-default-class 0.1.2.0
data-fix 0.3.2
deepseq 1.4.8.0
directory 1.3.7.1
distributive 0.6.2.1
dlist 1.0
easy-file 0.2.5
entropy 0.4.1.10
esqueleto 3.5.11.0
exceptions 0.10.5
fast-logger 3.2.2
filepath 1.4.2.2
foldable1-classes-compat 0.1
generically 0.1.1
ghc-bignum 1.3
ghc-boot-th 9.4.7
ghc-prim 0.9.1
hashable 1.4.3.0
hourglass 0.2.12
http-api-data 0.5
http-date 0.0.11
http-types 0.12.3
http2 4.1.4
indexed-traversable 0.1.3
indexed-traversable-instances 0.1.1.2
integer-gmp 1.1
integer-logarithms 1.0.3.1
iproute 1.7.12
lift-type 0.1.1.1
lifted-base 0.2.3.12
memory 0.18.0
microlens 0.4.13.1
microlens-th 0.4.3.14
monad-control 1.0.3.1
monad-logger 0.3.40
monad-loops 0.4.3
mono-traversable 1.0.15.3
mtl 2.2.2
my-project 0.1.0.0
network 3.1.4.0
network-byte-order 0.1.7
network-info 0.2.1
old-locale 1.0.0.7
old-time 1.1.0.3
parsec 3.1.16.1
path-pieces 0.2.1
pem 0.2.4
persistent 2.14.6.0
persistent-postgresql 2.13.6.1
persistent-template 2.12.0.0
postgresql-libpq 0.9.5.0
pretty 1.1.3.6
primitive 0.8.0.0
process 1.6.17.0
psqueues 0.2.8.0
random 1.2.1.1
recv 0.1.0
regex-base 0.94.0.2
regex-compat 0.95.2.1
regex-posix 0.96.0.1
resource-pool 0.4.0.0
resourcet 1.2.6
rts 1.0.2
safe-exceptions 0.1.7.4
scientific 0.3.7.0
scotty 0.12.1
semialign 1.3
semigroupoids 5.3.7
silently 1.2.5.3
simple-sendfile 0.2.32
split 0.2.3.5
splitmix 0.1.0.5
stm 2.5.1.0
stm-chans 3.0.0.9
streaming-commons 0.2.2.6
strict 0.5
string-conversions 0.4.0.1
tagged 0.8.7
template-haskell 2.19.0.0
text 2.0.2
text-short 0.1.5
th-abstraction 0.4.5.0
th-lift 0.8.4
th-lift-instances 0.1.20
these 1.2
time 1.12.2
time-compat 1.9.6.1
time-manager 0.0.1
transformers 0.5.6.2
transformers-base 0.4.6
transformers-compat 0.7.2
typed-process 0.2.11.1
unix 2.7.3
unix-compat 0.7
unix-time 0.4.11
unliftio 0.2.25.0
unliftio-core 0.2.1.0
unordered-containers 0.2.19.1
utf8-string 1.0.2
uuid 1.3.15
uuid-types 1.0.5.1
vault 0.3.1.5
vector 0.13.1.0
vector-algorithms 0.9.0.1
vector-stream 0.1.0.0
wai 3.2.3
wai-extra 3.1.13.0
wai-logger 2.4.0
warp 3.3.25
witherable 0.4.2
word8 0.1.3
x509 1.7.7
zlib 0.6.3.0


这是我的第一个代码,所以我会继续改进它,以便更多地了解Haskell(欢迎所有提示和技巧!)。
最后,我想感谢大家抽出时间回答我最初的问题。

相关问题