Scotty: No instance for MonadIO ScottyT (arising from a use of ‘liftIO’)

Question

I am trying to learn HASKELL by myself, I have found this page https://www.parsonsmatt.org/2015/05/02/scotty_and_persistent.html and I have tried to use the code but I got an error:

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

Error

➜  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

I do not know why the error is here: liftIO .

Do you have any ideas on it?

Thanks in advance

Aron

Answer 1

As per the comments, Scotty was redesigned starting with version 0.10 to make ScottyM (and ScottyT) into a "configuration only" monad that declares the middleware and routing of the web server but isn't capable of performing I/O itself.

So, any database setup or other I/O that the blog author has tried to move into the Scotty app using inAppDb isn't going to work. Instead, delete the inAppDb definition and move that setup into main before invoking scotty. For your specific code example, it'll look like this:

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

As far as the rest of the blog post is concerned, it looks like the author abandons the whole inAppDb by part 2 anyway, and the inHandlerDb calls should all work fine. They are operating in the ActionM monad, which supports I/O operations via liftIO, so examples like the following should typecheck:

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]))

Answer 2

I have finally completed my code. I have now a Haskell example that uses Scotty, Persistent (Postgresql) and a GET method that returns a JSON data.

Here the complete code:

{-# 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

I share also the list of dependencies that I have used and its respective versions:

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

It is my first code, so I will continue to improve it and so to learn more about Haskell (all tips and tricks are welcome!).

I want to end by saying thank so much to all of you to have taken time to respond my initial question.