I am trying to make a form for the following Configuration record :
data Configuration = Configuration
{ cMail :: Mail
, cIdentity :: Identity
, cAttachments :: [(Text, FilePath)]
} deriving Eq
data Mail = Mail
{ mFullMail :: Text
, mServer :: Text
, mPort :: Text
, mUser :: Text
, mPassword :: Text
} deriving (Eq, Show)
data Identity = Identity
{ iName :: Text
, iLastName :: Text
, iHonorific :: Maybe Text
, iBirthday :: Maybe Text
, iOrigin :: Maybe Text
, iNationality :: Maybe Text
, iAddress :: Maybe Text
, iTown :: Maybe Text
, iCp :: Maybe Text
, iCountry :: Maybe Text
, iPhone :: Maybe Text
, iMobile :: Maybe Text
} deriving (Eq, Show)
I have figured the following which I have yet to test :
configureForm :: Form Configuration
configureForm = renderDivs $ Configuration
-- I don't know if the following is right
<$> $ Mail <$> areq textField "fullmail :" Nothing
<*> areq textField "server : " Nothing
-- etc..
<*> $ Identity <$> areq textField "name : " Nothing
<*> areq textField "lastname : " Nothing
<*> aopt textField "honorific : " Nothing
-- etc..
<*> -- the part I can't figure out
But am stuck with the last part so can't test.
Any tips as how to complete the form?
Related
I am trying to write a JSON parser with Aeson.
The JSON I'm working with
The way I am calling the JSON in my code:
testReq :: Request
testReq = parseRequest_ "https://api.openweathermap.org/data/2.5/onecall?lat=41.63526&lon=-70.92701&exclude=minutely&appid=93120a85abf28f8fb1cdae14ffd7435d&units=metric"
First I define my custom type
type Celsius = Double
type HPA = Int --Hectopascal Pressure Unit
type Percent = Int
type Meter = Int
type MeterPerSec = Double
type CompassDegree = Int
data WeatherObj =
WeatherObj
{ time :: UTCTime
, temp :: Celsius
, feels_like :: Celsius
, pressure :: HPA
, humidity :: Percent
, visibility :: Meter
, wind_speed :: MeterPerSec
, wind_deg :: CompassDegree
}
deriving (Eq, Show, Generic)
Next I write my FromJSON instance, which I know works because If I run parseCurrentWeather testReq I get back WeatherObj {time = 2020-07-19 16:54:43 UTC, temp = 25.51, feels_like = 29.49, pressure = 1012, humidity = 83, visibility = 10000, wind_speed = 1.34, wind_deg = 247} Which is perfect!
instance FromJSON WeatherObj where
parseJSON = withObject "weatherObj" $ \obj -> do
timeOffset <- obj .: "timezone_offset"
currentO <- obj .: "current"
dt <- currentO .: "dt"
temp <- currentO .: "temp"
feels_like <- currentO .: "feels_like"
pressure <- currentO .: "pressure"
humidity <- currentO .: "humidity"
visibility <- currentO .: "visibility"
wind_speed <- currentO .: "wind_speed"
wind_deg <- currentO .: "wind_deg"
pure $ WeatherObj (makeLocalTime dt timeOffset)
temp feels_like
pressure humidity
visibility wind_speed
wind_deg
parseCurrentWeather :: Request -> IO WeatherObj
parseCurrentWeather req = do
current <- fetchCurrentWeather req
pure $ getResponseBody current
Now I need to figure out how to parse the hourly weather which should give me back 48 objects. This code works as when I run parseHourly testReq I get back a long string of JSON with no exceptions. This JSON definitely matches the JSON from the link. I am looking great up to this point.
fetchHourly :: Request -> IO (Response HourlyWeathers) --Could also be IO (Response Object)
fetchHourly = httpJSON
data HourlyWeathers =
HourlyWeathers
{ getHours :: [Object] }
deriving (Eq, Show, Generic)
instance FromJSON HourlyWeathers where
parseJSON = withObject "hourlyWeather" $ \obj -> do
allHours <- obj .: "hourly"
pure $ HourlyWeathers allHours
parseHourly :: Request -> IO HourlyWeathers
parseHourly req = do
hours <- fetchHourly req
pure $ getResponseBody hours
Now we are at the problematic code. I would like to map objToWeatherObj onto the list of objects that I generate with parseHourly. The problem that I cannot seem to overcome is that when I run parseHourlyObjects I get back a list of all Nothings.
parseHourlyObjects :: Request -> IO [Maybe WeatherObj]
parseHourlyObjects req = do
hourly <- fetchHourly req
let x = getHours $ getResponseBody hourly
y = fmap objToWeatherObj x
pure y
objToWeatherObj :: Object -> Maybe WeatherObj
objToWeatherObj = (decode . encode)
I have been able to write a ToJSON instance for WeatherObj but that turned out to be irrelevant because I need to parse a generic Object into a WeatherObj. I believe that the function I need here is decode, though I could be wrong.
Given:
data WeatherObj =
WeatherObj
{ time :: UTCTime
, temp :: Celsius
, feels_like :: Celsius
, pressure :: HPA
, humidity :: Percent
, visibility :: Meter
, wind_speed :: MeterPerSec
, wind_deg :: CompassDegree
}
deriving (Eq, Show, Generic, FromJSON)
Note that it is now deriving FromJSON as well.
You can:
decode "{\"time\":\"...\",...}" :: Maybe WeatherObj
And get a Maybe WeatherObj. By writing your own instance of FromJSON, I think you may have made your life a bit more challenging than needed.
I want to create a new form field to enter an entity key, in this case an ArticleId instead of an Integer field, can I do that?
There is my Article model
Article
title Text
content Text
userId Int
score Int Maybe
deriving Show
deriving Eq
And there is my AForm Article handler
<$> areq intField (bfs ("Article Id" :: Text)) Nothing
<*> areq intField (bfs ("Tag Id" :: Text)) Nothing
I want to do this to avoid use toSqlKey in my selectList
Thanks!
The code below is from the Home.hs file created by the yesod-simple scaffold.
I like to do simple string manipulation on text input but don't know how to parse it into a Text value.
How, for example, can I use toUpper on fileDescription?
I've tried using lookupPostParam
but I'm struggling with it's type signature:
lookupPostParam :: MonadHandler m => Text -> m (Maybe Text)
Home.hs
module Handler.Home where
import Import
import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3)
import Text.Julius (RawJS (..))
data FileForm = FileForm
{ fileInfo :: FileInfo
, fileDescription :: Text
}
getHomeR :: Handler Html
getHomeR = do
(formWidget, formEnctype) <- generateFormPost sampleForm
let submission = Nothing :: Maybe FileForm
handlerName = "getHomeR" :: Text
defaultLayout $ do
let (commentFormId, commentTextareaId, commentListId) = commentIds
aDomId <- newIdent
setTitle "Welcome To Yesod!"
$(widgetFile "homepage")
postHomeR :: Handler Html
postHomeR = do
((result, formWidget), formEnctype) <- runFormPost sampleForm
let handlerName = "postHomeR" :: Text
submission = case result of
FormSuccess res -> Just res
_ -> Nothing
defaultLayout $ do
let (commentFormId, commentTextareaId, commentListId) = commentIds
aDomId <- newIdent
setTitle "Welcome To Yesod!"
$(widgetFile "homepage")
sampleForm :: Form FileForm
sampleForm = renderBootstrap3 BootstrapBasicForm $ FileForm
<$> fileAFormReq "Choose a file"
<*> areq textField textSettings Nothing
where textSettings = FieldSettings
{ fsLabel = "What's on the file?"
, fsTooltip = Nothing
, fsId = Nothing
, fsName = Nothing
, fsAttrs =
[ ("class", "form-control")
, ("placeholder", "File description")
]
}
commentIds :: (Text, Text, Text)
commentIds = ("js-commentForm", "js-createCommentTextarea", "js-
commentList")
This is unfortunately a fault in documentation and communication.
Given
lookupPostParam :: (MonadResource m, MonadHandler m) => Text -> m (Maybe Text)
the reader is meant to infer that m is not only a MonadResouce and a MonadHandler but also Monad. This tiny little line of code packs up a lot of intent into a very small sentence; it's a wart that so much of Haskell library usage is left implicit and subtextual. For example, to call toUpper on the Text inside this type you are meant to do this:
{-# language OverloadedStrings #-}
foo :: (MonadResource m, MonadHandler m) => m (Maybe Text)
foo = do
valueMaybe <- lookupPostParam "key"
case valueMaybe of
Just value ->
pure (toUpper value)
Nothing ->
Nothing
Note that the monad stack (MonadHandler, MonadResource) has "infected" your code. This is meant to be intentional, so as to constrain you via the type checker to only run this function in the intended Yesod environment/state machine/context/whatever.
However
You are using yesod-forms and it would be nice to do the same thing within that framework. As with lookupPostParam, we can take advantage of the monad-applicative-functor typeclasses.
We can adapt this to the Form FileForm value that you have.
sampleForm :: AForm Handler FileForm
sampleForm =
FileForm <$> fileAFormReq "Choose a file"
<*> (toUpper <$> areq textField textSettings Nothing)
I think the types of yesod-forms changed between releases. I'm copying my types off the latest version as of writing, 1.4.11.
Here we take advantage of the Monad m => Functor (AForm m) instance. Knowing that we are indeed in a monad (the Handler monad) means we can use fmap and its infixed sibling <$> on the value returned by areq textField textSettings Nothing. This allows us to lift arbitrary functions acting on Text into the AForm m stack. For example, here we went from Text -> Text to AForm Handler Text -> AForm Handler Text.
Hope that helps.
decode / encode:
yDecode :: FromJSON iFromJSONable ⇒ FilePath → IO iFromJSONable
yDecode fnm = do
ymlData ← BS.readFile fnm
return $ fromMaybe (error "Can't parse from YAML") (decode ymlData)
yEncode :: ToJSON iToJSONable ⇒ FilePath → iToJSONable → IO()
yEncode fnm dat = BS.writeFile fnm $ encode dat
I create config with this encode and it creates just fine but when I'm reading it - I'm getting this error: Can't parse from YAML - on windows same code works fine and there I just can't understand what is possibly wrong?
In cases of Nothing, it's best to grab more information by using decodeEither/decodeEither'. The left side of the either value will contain an error message telling you where the failure occurs. If you switch over, you'll see that the parsing is failing due to the error "Can't parse Repository from YAML" line (see attempt1 below). It's encountering something besides an Object!
It's best then to see what the heck the YAML package is decoding to then, by decoding to the type we know that has to succeed — Value. Decoding, we get this (see attempt2 below):
Right (Array (fromList [Object (fromList [("group",Null),("branches",Array (fromList [String "master"])),("hash",Null),("clean",Null),("location",String "/home/gentoo-haskell"),("enabled",Null),("root",Null),("postRebuild",Null),("upstream",String "upstream master"),("task",String "rebase"),("positive",Null)])]))
It appears the root data structure is an Array and not an Object. There are lots of ways to fix this, and I chose a hacky one.
parseJSON (Array array) = parseJSON (array ! 0)
This makes the program work! I pasted my code below. (Apologies for the use of lens; I use it to convert between strings and bytestrings for quick scripts like these. Your program will of course work perfectly fine without it.)
{-# LANGUAGE OverloadedStrings #-}
module Lib where
import Control.Lens
import Data.ByteString
import Data.ByteString.Lens
import Data.Vector
import Data.Yaml
data Repository = Repository
{ location :: String
, task :: String
, branches :: [String]
, upstream :: String
, enabled :: Maybe Bool
, root :: Maybe Bool
, positive :: Maybe Bool
, clean :: Maybe Bool
, postRebuild :: Maybe [String]
, syncGroup :: Maybe String
, hash :: Maybe String
} deriving (Show, Eq)
instance FromJSON Repository where
parseJSON (Object v) = Repository <$>
v .: "location" <*>
v .: "task" <*>
v .: "branches" <*>
v .: "upstream" <*>
v .:? "enabled" <*>
v .:? "root" <*>
v .:? "positive" <*>
v .:? "clean" <*>
v .:? "postRebuild" <*>
v .:? "group" <*>
v .:? "hash"
parseJSON (Array array) = parseJSON (array ! 0)
raw :: String
raw = unlines [
"- group: null",
" branches:",
" - master",
" hash: null",
" clean: null",
" location: /home/gentoo-haskell",
" enabled: null",
" root: null",
" postRebuild: null",
" upstream: upstream master",
" task: rebase",
" positive: null"]
attempt1 :: Either ParseException Repository
attempt1 = decodeEither' (raw ^. packedChars)
attempt2 :: Either ParseException Value
attempt2 = decodeEither' (raw ^. packedChars)
To make long stroy short, my code is about parse a json file using aeson
Here is my two pieces of code:
a.hs
{-# LANGUAGE OverloadedStrings #-}
import Data.Aeson
import qualified Data.ByteString.Lazy.Char8 as C
import Control.Monad
import Control.Applicative
data AuctionInfo = AuctionInfo {
realm :: Realm ,
alliance :: Auctions ,
horde :: Auctions ,
neutral :: Auctions
} deriving (Show )
instance FromJSON AuctionInfo where
parseJSON (Object o) = do
r <- o .: "realm" >>= parseJSON
a <- o .: "alliance" >>= parseJSON
h <- o .: "horde" >>= parseJSON
n <- o .: "neutral" >>= parseJSON
return $ AuctionInfo r a h n
parseJSON _ = mzero
data Realm = Realm { name2 :: String , slug:: String} deriving (Show )
instance FromJSON Realm where
parseJSON (Object o) = Realm <$>
o .: "name" <*>
o .: "slug"
parseJSON _ = mzero
data Auctions = Auctions {auctions :: [Auc]} deriving (Show)
instance FromJSON Auctions where
parseJSON (Object o ) = Auctions <$> o.: "auctions"
parseJSON _ = mzero
data Auc = Auc {
auc :: Integer,
itme :: Int,
owner :: String,
bid :: Integer,
buyout ::Integer,
quantity :: Int,
timeLeft :: String,
rand :: Integer,
seed :: Integer
} deriving (Show )
instance FromJSON Auc where
parseJSON (Object o ) = Auc <$>
o .: "auc" <*>
o .: "item" <*>
o .: "owner" <*>
o .: "bid" <*>
o .: "buyout" <*>
o .: "quantity" <*>
o .: "timeLeft" <*>
o .: "rand" <*>
o .: "seed"
parseJSON _ = mzero
main = do
au<- C.readFile "a.json"
let x = decode au :: Maybe AuctionInfo
case x of
Just a -> do
{-putStrLn.show $ a-}
putStrLn .show.length.auctions.alliance $ a
putStrLn "ok"
Nothing -> putStrLn "fail"
my json test file
And test steps:
save the code , and name it a.hs (or what you want)
save the test data ,name it a.json (do not change its name)
if you have not install aeson, $ cabal install aseon
$ ghc a.hs -o a
$ ./a
What I get from the output is "fail".
And when I run the command $ runghc a.hs for a few times ,
I even got some ok and some fail mixed together.
I have also tried this code on my linux and 64bit mac ghc, they all output ok as I expected.
One of my friends has also tried this code on his 32bit mac ghc, fail too. And he told me that he played some black magic to my code and changed one line into
let x = decode $(C.pack. C.unpack) au :: Maybe AuctionInfo
then the output is ok. But when I did the same black magic, the output is still fail.
I just want to make sure is this my bug or a bug of ghc, or how can I determine that.
I'm not sure if the behaviour is related to this, but you absolutely shouldn't use Data.ByteString.Lazy.Char8 since that's only for 8-bit ASCII data and your input is UTF-8.
Try replacing that import with
import qualified Data.ByteString.Lazy as BL
and use BL.readFile to read in the data (of course the actual name doesn't matter, but BL is the idiomatic shorthand for the lazy bytestring package).
Note that usually you would use Data.Text for handling unicode text, but in this case the aeson API expects the binary (i.e. ByteString) representation and handles decoding the unicode internally.
EDIT: Actually now that I've thought about this some more, I don't think the problem is with using Char8 after all (although the point stands about not using it for unicode text in general) as you are not doing any conversions from String or Char (expect for the C.pack . C.unpack experiment, which would break all multi-byte characters).