Use of 'approot' - haskell

If I set the approot like the following
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
module Main where
import Yesod.Core
data Yello = Yello
mkYesod "Yello" [parseRoutes|
/home1 Home1R GET
/home2 Home2R GET
|]
instance Yesod Yello where
approot = ApprootStatic "http://localhost:3000/v1"
getHome1R :: Handler Html
getHome1R = defaultLayout [whamlet|Homepage 01|]
getHome2R :: Handler Html
getHome2R = defaultLayout [whamlet|<a href=#{Home1R}>Homepage 02|]
main :: IO ()
main = warp 3000 Yello
then #{Home1R} get's rendered to http://localhost:3000/v1/home1 but this little yesod-based web application is only reachable at http://localhost:3000 (w/o the /v1).
What's the purpose of approot?
Where to set/ add /v1?

Related

Scotty and persistence - type error when using insert function

I've got the following application:
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Main where
-- Scotty
import qualified Web.Scotty as S
import Network.Wai.Middleware.RequestLogger
import Network.Wai.Middleware.Static
import qualified Data.Text.Lazy as L
-- HTML rendering
import Text.Blaze.Html.Renderer.Text (renderHtml)
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import Control.Monad.IO.Class
-- Database
import Database.Persist
import Database.Persist.Sqlite
import Database.Persist.TH
import Control.Monad.Trans.Resource (runResourceT, ResourceT)
import Control.Monad.Logger
-- URL generation
import System.Random
import Control.Monad (replicateM)
-- JSON
import Data.Map (fromList)
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
Link
shortUrl L.Text
URLKey shortUrl
Primary shortUrl
longUrl L.Text
counter Int
deriving Show
|]
getURL :: L.Text -> IO (Maybe (Entity Link))
getURL shortId = runSqlite "links.db" $ do
maybeOriginal <- getBy $ URLKey shortId
pure maybeOriginal
-- I don't know what type to give this, that's probably the problem
addURL short long = runSqlite "links.db" $ do
insert $ Link short long
main :: IO ()
main = do
-- Connect to db and run migration
runSqlite "links.db" $ do runMigration migrateAll
S.scotty 3000 $ do
...
S.post "/shorten" $ do
-- Get URL
url <- S.param "url" :: S.ActionM L.Text
-- Generate a random short URL
randStr <- liftIO $ getRandStr 5
-- Add the urls to the database
liftIO $ addURL (L.pack randStr) url
-- Send JSON response with ID
S.json $ fromList [("id" :: String, randStr)]
I get the following error:
shortener> build (lib + exe)
Preprocessing library for shortener-0.1.0.0..
Building library for shortener-0.1.0.0..
Preprocessing executable 'shortener-exe' for shortener-0.1.0.0..
Building executable 'shortener-exe' for shortener-0.1.0.0..
[2 of 2] Compiling Main
/home/henry/haskell/shortener/app/Main.hs:86:5: error:
• Couldn't match type ‘PersistEntityBackend (Int -> Link)’
with ‘SqlBackend’
arising from a use of ‘insert’
• In the first argument of ‘($)’, namely ‘insert’
In a stmt of a 'do' block: insert $ Link short long
In the second argument of ‘($)’, namely
‘do insert $ Link short long’
|
86 | insert $ Link short long
| ^^^^^^
-- While building package shortener-0.1.0.0 (scroll up to its section to see the error) using:
/home/henry/.stack/setup-exe-cache/x86_64-linux-tinfo6/Cabal-simple_mPHDZzAJ_3.4.1.0_ghc-9.0.2 --builddir=.stack-work/dist/x86_64-linux-tinfo6/Cabal-3.4.1.0 build lib:shortener exe:shortener-exe --ghc-options " -fdiagnostics-color=always"
Process exited with code: ExitFailure 1
I'm not sure how to resolve this type error and I haven't been able to find anything of use online. There was this answer with a similar problem, but the given type signature and several variations of it did not work.
It turns out I forgot a field when inserting. I had
insert $ Link short long
I needed
insert $ Link short long 0
for the counter field of Link.
Unfortunately the error didn't make that at all clear.

Haskell RIO monad inside persistent with pool

Similar question: Haskell / Persistent-Sqlite: "No instance for (Control.Monad.Trans.Resource.MonadResource IO)"
I'm trying the use the selectSource from persistent to read the database in streaming mode and log the values in the console using logInfo.
The following snippets are executed in a RIO project template.
The following code contains the parts that work and don't work.
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Disambiguate.People where
import Data.Conduit
import qualified Data.Conduit.List as CL
import Database.Persist
import Database.Persist.Sqlite
import Database.Persist.TH
import Import hiding (on, (^.))
import Prelude (print)
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
Person
name String
age Int
deriving Show
|]
disambiguatePeople :: RIO App ()
disambiguatePeople = do
-- WORKS!
runSqlite ":memory:" insertAndRead
-- DOES NOT COMPILE!
withSqlitePool ":memory:" 1 $ \pool -> do
liftSqlPersistMPool insertAndRead pool
where
insertAndRead = do
runMigration migrateAll
insert_ $ Person "John Doe" 35
insert_ $ Person "Jane Doe" 50
runConduit $ selectSource [PersonAge >. 5] [] .| CL.mapM_
(lift . logInfo . displayShow)
I get the following error:
src/Run.hs:37:25: error:
• Couldn't match type ‘RIO App’ with ‘IO’
Expected type: ReaderT
SqlBackend
(monad-logger-0.3.35:Control.Monad.Logger.NoLoggingT
(Control.Monad.Trans.Resource.Internal.ResourceT IO))
()
Actual type: ReaderT
SqlBackend
(monad-logger-0.3.35:Control.Monad.Logger.NoLoggingT
(Control.Monad.Trans.Resource.Internal.ResourceT (RIO App)))
()
• In the first argument of ‘liftSqlPersistMPool’, namely
‘insertAndRead’
In a stmt of a 'do' block: liftSqlPersistMPool insertAndRead pool
In the expression: do liftSqlPersistMPool insertAndRead pool
|
37 | liftSqlPersistMPool insertAndRead pool
| ^^^^^^^^^^^^^
I understand the error since the function liftSqlPersistMPool hardcoded the IO type.
How can I solve this to use it with the RIO type ?

Haskell calling HTML using Shakespeare without Yesod widgets

Like Yesod, so diving in deep. Have a question: using Yesod I can call eg. data type App with Warp (warp 3000 App).
How can I serve up HTML created using Shakespeare templates (like below). Got this from Michael Snoyman's book.
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Main where
import Text.Blaze.Html.Renderer.String (renderHtml)
import Text.Hamlet (HtmlUrl, hamlet)
import Data.Text (Text)
import Yesod
data WebRoutes = Home | Time | Stylesheet
render :: WebRoutes -> [(Text, Text)] -> Text
render Home _ = "/home"
render Time _ = "/time"
render Stylesheet _ = "/stylesheet"
template :: Text -> HtmlUrl WebRoutes
template title = [hamlet|
<html>
<head>
<title>#{varTitle}
<link rel=stylesheet href=#{Stylesheet}>
<body>
<h1 #headerId>#{title}
|]
varTitle :: String
varTitle = "Test outputd"
main :: IO ()
main = putStrLn $ renderHtml $ template "Test output" render

Get id from Entity record

I have an Entity record, specifically Entity User and I need to extract the Id which the User has in the database as an Int.
From reading the docs it seems entityKey would be useful here but I'm not quite sure how I would go about getting an Int out.
You have to use a combination of fromSqlKey and entityKey. A sample program demonstrating it:
#!/usr/bin/env stack
{- stack
--resolver lts-9.0
--install-ghc
runghc
--package persistent
--package persistent-sqlite
--package persistent-template
--package mtl
-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
import Control.Monad.IO.Class (liftIO, MonadIO)
import Control.Monad.Reader
import Database.Persist
import Database.Persist.Sqlite
import Database.Persist.TH
import Data.Int
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
Person
name String
age Int Maybe
deriving Show
|]
insertPerson :: MonadIO m => ReaderT SqlBackend m (Key Person)
insertPerson = insert $ Person "Michael" $ Just 26
main :: IO ()
main = runSqlite ":memory:" $ do
runMigration migrateAll
michaelId <- insertPerson
(michael :: Entity Person) <- getJustEntity michaelId
liftIO $ print $ (fromSqlKey . entityKey $ michael :: Int64)
And it's output:
~/g/scripts $ stack persist.hs
Migrating: CREATE TABLE "person"("id" INTEGER PRIMARY KEY,"name" VARCHAR NOT NULL,"age" INTEGER NULL)
1

How to define a type in a TemplateHaskell function and use it in the same function?

Is there any way to have as single TH function, define a type, and use the type, as well? Relevant code below. PersonPoly2 is being defined by makeRecordSplice and then being passed to makeAdaptorAndInstance (from Opalaye), which is also a TH function.
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Lib where
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Language.Haskell.TH
makeRecordSplice :: Q [Dec]
makeRecordSplice = [d|
data PersonPoly2 a b = Person2
{ id :: a
, name :: b
}
|]
makeRecordAndAdapter :: Q [Dec]
makeRecordAndAdapter = do
record <- makeRecordSplice
adapter <- makeAdaptorAndInstance "pPerson2" (mkName "PersonPoly2")
return $ record ++ adapter
-------------
/home/Projects/scratch/app/Main.hs:26:1: error:
‘PersonPoly2’ is not in scope at a reify
Failed, modules loaded: Lib.
The problem you are having is that makeRecordSplice needs to be in a different module than the one it is instantiated in. This Template-Haskell limitation ensures non-circular dependencies at compile time. It is an annoying limitation but not too difficult to go around. Here is one way you could do it:
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Main where
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Language.Haskell.TH
import Lib (makeRecordSplice)
$(makeRecordSplice)
$(makeAdaptorAndInstance "pPerson2" (mkName "PersonPoly2"))
main :: IO ()
main = undefined
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Lib where
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Language.Haskell.TH
makeRecordSplice :: Q [Dec]
makeRecordSplice = [d|
data PersonPoly2 a b = Person2
{ id :: a
, name :: b
}
|]
You can obviously create an alias for makeAdaptorAndInstance "pPerson2" (mkName "PersonPoly2") and hide it in Lib, you just can't have a splice dependent on another one in the same module.
Hope this helps! :-)

Resources