Enumerate AppMessage constructors - haskell

Let message/en.msg file like:
Category1: some text 1
Category2: some text 2
...
CategoryN: some text N
And let next valid code:
getHomeR :: Handler RepHtml
getHomeR = do
(msg :: AppMessage -> Text) <- getMessageRender
let list = T.concat $ map msg [MsgCategory1, MsgCategory7]
defaultLayout $ do
$(widgetFile "homepage") -- <p>List: #{list}
then, list contains MsgCategory1 and MsgCategory7 translations.
I want to do some like:
let list = T.concat $ map msg [MsgCategory1 .. MsgCategory7]
but AppMessage is not Enum derived.
My another one alternative is not valid too (is not Read derived too)
let list = T.concat $ map (\n -> msg $ read "MsgCategory" ++ show n) [1 .. 7]
In general, how to cast "in real time" AppMessage elements?
Thank you very much!
(I love Yesod! :) )

One way I found is here
deriving instance Enum AppMessage
deriving instance Eq AppMessage
deriving instance Read AppMessage
deriving instance Show AppMessage
...
(require -XStandaloneDeriving)
Explained:
Change on Foundation.hs:
-- Set up i18n messages. See the message folder.
mkMessage "App" "messages" "en"
-- Require extension: StandaloneDeriving
deriving instance Enum AppMessage
On site.cabal:
extensions: TemplateHaskell
QuasiQuotes
OverloadedStrings
NoImplicitPrelude
CPP
MultiParamTypeClasses
TypeFamilies
GADTs
GeneralizedNewtypeDeriving
FlexibleContexts
EmptyDataDecls
NoMonomorphismRestriction
StandaloneDeriving

Related

Evaluation of template haskell in Yesod

While going through the examples of the Yesod Book, I'm running into an issue with the following snippet:
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
import Data.Text (Text)
import qualified Data.Text as T
import Yesod
data App = App
instance Yesod App
mkYesod "App" [parseRoutes|
/person/#Text PersonR GET
/year/#Integer/month/#Text/day/#Int DateR
/wiki/*Texts WikiR GET
|]
getPersonR :: Text -> Handler Html
getPersonR name = defaultLayout [whamlet|<h1>Hello #{name}!|]
handleDateR :: Integer -> Text -> Int -> Handler Text -- text/plain
handleDateR year month day =
return $
T.concat [month, " ", T.pack $ show day, ", ", T.pack $ show year]
getWikiR :: [Text] -> Handler Text
getWikiR = return . T.unwords
main :: IO ()
main = warp 3000 App
(It's on page 124 of 598; route arguments)
The instance declaration on line 11 raises the following error:
YesodRouteParams.hs:11:10: error:
• No instance for (RenderRoute App)
arising from the superclasses of an instance declaration
• In the instance declaration for ‘Yesod App’
|
11 | instance Yesod App
|
It can be fixed by moving that line below the mkYesod block, where routes are defined.
I'm trying to understand why that is. Does it mean that Template Haskell evaluation at compile time happens simultaneously with the written code evaluation?
I ask because in Crystal, for example, macros are expanded before anything else. So the order of things doesn't really matter in a file (or app). But by the looks of it, they do in Haskell. Or is there another explanation?
This was because of a change made in GHC 9.0.1. From the release notes:
Breaking change: Template Haskell splices now act as separation points between constraint solving passes. It is no longer possible to use an instance of a class before a splice and define that instance after a splice. For example, this code now reports a missing instance for C Bool:
class C a where foo :: a
bar :: Bool
bar = foo
$(return [])
instance C Bool where foo = True
If you were to downgrade to GHC 8.10.7, you'd see that your code would then work as you wrote it.
I opened https://github.com/yesodweb/yesodweb.com-content/pull/269 to fix the examples in the book.

Haskell servant: FormUrlEncoded request body with optional field

Given the following servant server definition:
#!/usr/bin/env stack
{- stack
--resolver lts-19.10
script
--package base
--package http-api-data
--package lucid
--package servant-lucid
--package servant-server
--package time
--package warp
-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
import Data.Proxy
import Data.Time
import GHC.Generics
import Lucid.Base
import Lucid.Html5
import Network.Wai.Handler.Warp
import Servant
import Servant.HTML.Lucid
import Web.FormUrlEncoded
data FormData = FormData {formTime :: Maybe TimeOfDay} deriving (Generic, Show)
instance FromForm FormData
type API = "form" :> ReqBody '[FormUrlEncoded] FormData :> Post '[HTML] (Html ()) :<|> Get '[HTML] (Html ())
main :: IO ()
main = do
putStrLn $ "starting on port " <> show port
run port $ serve (Proxy #API) ((pure . toHtml . show) :<|> pure page)
where
port = 8080
page = do
doctype_
html_ [lang_ "en"] $ do
form_ [action_ "form", method_ "post"] $ do
label_ [for_ "formTime"] "time"
input_ [type_ "time", id_ "formTime", name_ "formTime"]
input_ [type_ "submit", value_ "Submit"]
(This can be run as is using stack)
the time field in the parameter is supposed to be optional, so if the user doesn't provide a value for it, it should end up as Nothing in the FormData value that's passed to the Handler.
However, in the browser the field will be included in the request but with an empty value.
I'm not sure if this is a bug in servant or if it's intended behavior, but this does sound a bit counter-intuitive to me
The only possible solution I can think of is to wrap the Maybe TimeOfDay in a newtype that then implements the expected behavior in the FromHttpApiData instance, like so:
newtype MaybeTimeOfDay = MaybeTimeOfDay (Maybe TimeOfDay) deriving (Show)
instance FromHttpApiData MaybeTimeOfDay where
parseQueryParam "" = Right (MaybeTimeOfDay Nothing)
parseQueryParam t = MaybeTimeOfDay <$> parseQueryParam t
data FormData = FormData {formTime :: MaybeTimeOfDay} deriving (Generic, Show)
Or, more generically
newtype OptionalParameter a = OptionalParameter (Maybe a) deriving (Show)
instance FromHttpApiData a => FromHttpApiData (OptionalParameter a) where
parseQueryParam "" = Right (OptionalParameter Nothing)
parseQueryParam t = OptionalParameter <$> parseQueryParam t
This works but it feels a bit awkward to implement that manually.

QuasiQuotes with OverloadedLabels

I'm trying to use OverloadedLabels with QuasiQuotes from here package. Using plain lenses works but #foo fails with parsing error during compilation. So does field #"foo". Is there a deeper reason this will not work or could it be be a bug in here's interpolated parser?
{-# language DataKinds #-}
{-# language DeriveGeneric #-}
{-# language DerivingStrategies #-}
{-# language OverloadedLabels #-}
{-# language OverloadedStrings #-}
{-# language TypeApplications #-}
{-# language QuasiQuotes #-}
import Control.Lens
import Data.Text (Text)
import qualified Data.Text.IO as T
import Data.Generics.Product
import Data.Generics.Labels
import Data.String.Here
import GHC.Generics (Generic)
data Test = Test
{ name :: Text
} deriving stock (Eq, Show, Generic)
_name :: Lens' Test Text
_name f (Test a) = fmap (\a' -> Test a') (f a)
t :: Test
t = Test "test"
test :: IO ()
test = do
-- ok
T.putStrLn $ t ^. field #"name"
T.putStrLn $ t ^. #name
putStrLn [i|${t ^. _name}|]
-- parse error
putStrLn [i|The name is ${t ^. field #"name"}|]
putStrLn [i|The name is ${t ^. #name}|]
Error for #name:
test.hs:36:12: error:
• Exception when trying to run compile-time code:
Failed to parse interpolated expression in string: The name is ${t ^. #name}
(line 1, column 25):
0
SrcLoc "" 1 6
Parse error in expression: t ^.
CallStack (from HasCallStack):
error, called at src/Data/String/Here/Interpolated.hs:64:33 in here-1.2.13-HU0AD0x0dD36rY9YuL1gwE:Data.String.Here.Interpolated
Code: Language.Haskell.TH.Quote.quoteExp
i "The name is ${t ^. #name}"
• In the quasi-quotation: [i|The name is ${t ^. #name}|]
|
36 | putStrLn [i|The name is ${t ^. #name}|]
|
It looks like haskell-src-meta doesn’t support OverloadedLabels yet. The haskell-src-exts parser has an OverloadedLabels case, but haskell-src-meta doesn’t have a case for it in the ToExp instance for Exp. I guess the “unsupported” error message from haskell-src-meta is getting swallowed by the error handling in here.
Just in case anyone else stumbles upon this, I've made a PR to fix this in haskell-src-meta: https://github.com/DanBurton/haskell-src-meta/pull/19

Where is the documentation for autogeneration of Has typeclasses in lens?

I was looking at the penultimate example in this blog post (also here), and after verifying it ran, it seemed to confirm that lens can generate Has typeclasses, which I take was the implication from the author of the blog. However, I miss where this is described, either in the lens contents or the lens tutorial. Any explanations external to official docs for how this is done would also be welcome. But it seems like this may just be standard when using the most basic feature (makeLenses, or in this case, makeLensesWith).
Here is the reproduced code:
#!/usr/bin/env stack
-- stack --resolver lts-8.12 script
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
import Control.Concurrent.Async.Lifted.Safe
import Control.Monad.Reader
import Control.Concurrent.STM
import Say
import Control.Lens
import Prelude hiding (log)
data Env = Env
{ envLog :: !(String -> IO ())
, envBalance :: !(TVar Int)
}
makeLensesWith camelCaseFields ''Env
modify :: (MonadReader env m, HasBalance env (TVar Int), MonadIO m)
=> (Int -> Int)
-> m ()
modify f = do
env <- ask
liftIO $ atomically $ modifyTVar' (env^.balance) f
logSomething :: (MonadReader env m, HasLog env (String -> IO ()), MonadIO m)
=> String
-> m ()
logSomething msg = do
env <- ask
liftIO $ (env^.log) msg
main :: IO ()
main = do
ref <- newTVarIO 4
let env = Env
{ envLog = sayString
, envBalance = ref
}
runReaderT
(concurrently
(modify (+ 1))
(logSomething "Increasing account balance"))
env
balance <- readTVarIO ref
sayString $ "Final balance: " ++ show balance
Field is the word lens uses to describe the pattern of one class per named field, allowing multiple records with the same field name but (optionally) different types. So camelCaseFields, makeFieldOptics, defaultFieldRules all say in their name that they will generate these HasFoo classes, in the usual terse style of lens.
makeClassy also generates classes named Has*, but named after the data type, not the record field, and not following a different pattern.
Your code above generates the following code (shown with -ddump-splices):
makeLensesWith camelCaseFields ''Env
======>
class HasBalance s a | s -> a where
balance :: Lens' s a
instance HasBalance Env (TVar Int) where
{-# INLINE balance #-}
balance f_a4eTr (Env x1_a4eTs x2_a4eTt)
= (fmap (\ y1_a4eTu -> (Env x1_a4eTs) y1_a4eTu)) (f_a4eTr x2_a4eTt)
class HasLog s a | s -> a where
log :: Lens' s a
instance HasLog Env (String -> IO ()) where
{-# INLINE log #-}
log f_a4eTx (Env x1_a4eTy x2_a4eTz)
= (fmap (\ y1_a4eTA -> (Env y1_a4eTA) x2_a4eTz)) (f_a4eTx x1_a4eTy)

Is jsonToRepJson broken?

I'm just starting doing some Yesod + Haskell stuff.
Is jsonToRepJson broken or something?
I made this code below but I always get an error in jsonToRepJson part.
It seems it doesn't get the expected type?
Any help would be great! Thanks :3
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
import Yesod
import Data.Text
data APP = APP
instance Yesod APP
mkYesod "APP" [parseRoutes|
/ TestR GET
|]
getTestR :: Handler RepJson
getTestR = jsonToRepJson $ object ["test".= ("test"::Text)]
main::IO()
main = warpDebug 3001 APP
this is what I get when I use runhaskell
api.hs:18:12:
Couldn't match expected type `RepJson' with actual type `Value'
Expected type: Handler RepJson
Actual type: HandlerT APP IO Value
In the expression:
jsonToRepJson $ object ["test" .= ("test" :: Text)]
In an equation for `getTestR':
getTestR = jsonToRepJson $ object ["test" .= ("test" :: Text)]
You must convert your value toJSON.
Eg.:
jsonToRepJson $ object [("result", toJSON resultValue)]
:)
You can read about that change in Yesod 1.2
What I did is, I used the TypeContent handler.
If I understood correctly what I've read, repSelect allows us to easily handle what type of data representation the client asks for.
It reads the request header and checks if it asks for JSON, then it will spit out JSON data, if it needs HTML it will then give the HTML page. Providing that you yourself had added the specific data needed using providRep.
Here's my code.
mkYesod "APP" [parseRoutes|
/ TestR GET
|]
getTestR::Handler TypedContent
getTestR = do
selectRep $ do
provideRep $ jsonToRepJson $ object $ (["test" .= ("test"::Text)])
main::IO()
main = warpDebug 3001 APP

Resources