Digestive Functors with a variable number of subforms (Snap/Heist) - haskell

I'm working on porting a site from PHP to Snap w/ Heist. I've ported some of the simpler forms to using Digestive Functors successfully, but now I have to do the tricky ones that require the use of subforms.
This application manages producing flyers for retail stores, so one of the tasks that need to be done is adding an ad size and defining its physical dimensions on the printed flyer. Sizes will vary depending on the type of page (configurable by the flyer owner) and its orientation (which can only be controlled by the administrators).
This form is guaranteed to have a minimum of 3 cells, most likely going to have 9 cells (as pictured above from the PHP version), but could theoretically have an unlimited number.
Here's what I've got so far for the dimensions subform:
data AdDimensions = AdDimensions
{ sizeId :: Int64
, layoutId :: Int64
, dimensions :: Maybe String
}
adDimensionsForm :: Monad m => AdDimensions -> Form Text m AdDimensions
adDimensionsForm d = AdDimensions
<$> "size_id" .: stringRead "Must be a number" (Just $ sizeId d)
<*> "layout_id" .: stringRead "Must be a number" (Just $ layoutId d)
<*> "dimensions" .: opionalString (dimensions d)
The form definition doesn't feel quite right (maybe I have completely the wrong idea here?). AdDimensions.dimensions should be a Maybe String, since it will be null when coming back from the database when running the query to get a list of all of the possible combinations of size_id/layout_id for a new ad size, but it will be not null from a similar query that will be run when creating the edit form. The field itself is required (ad_dimensions.dimensions is set to not null in the database).
From here, I have no idea where to go to tell the parent form that it has a list of subforms or how I might render them using Heist.

I wrote a special combinator for this quite some time ago for digestive-functors-0.2. It was a very full featured solution that included javascript code allowing fields to be dynamically added and removed. That code was based on a much earlier implementation Chris and I did for the formlets package which digestive-functors eventually superceded. This function was never ported to work with the new API that digestive-functors got in 0.3.
The problem is tricky and has some subtle corner cases, so I would recommend that you spend some time looking at the code. I think Jasper would probably accept a good port of the code into the current version of digestive-functors. It's just that nobody has done the work yet.
Edit: This has been done now for the latest digestive-functors. See the listOf function.

Using the listOf functionality (which wasn't around when the question was originally asked/answered), this is how one would go about about it. This requires 2 forms where the form representing your list's type is a formlet:
data Thing = Thing { name: Text, properties: [(Text, Text)] }
thingForm :: Monad m => Maybe Thing -> Form Text m Thing
thingForm p = Thing
<$> "name" .: text (name <$> p)
<*> "properties" .: listOf propertyForm (properties <$> p)
propertyForm :: Monad m => Maybe (Text, Text) -> Form Text m (Text, Text)
propertyForm p = ( , )
<$> "name" .: text (fst <$> p)
<*> "value" .: text (snd <$> p)
Simple forms
If you have a simple list of items, digestive-functors-heist defines some splices for this, but you might find that you'll end up with invalid markup, especially if your form is in a table.
<label>Name <dfInputText ref="formname" /></label>
<fieldset>
<legend>Properties</legend>
<dfInputList ref="codes"><ul>
<dfListItem><li itemAttrs><dfLabel ref="name">Name <dfInputText ref="name" /></dfLabel>
<dfLabel ref="code">Value <dfInputText ref="value" required /></dfLabel>
<input type="button" name="remove" value="Remove" /></li></dfListItem>
</ul>
<input type="button" name="add" value="Add another property" /></dfInputList>
</fieldset>
There is JavaScript provided by digestiveFunctors to control adding and removing elements from the form that has a jQuery dependency. I ended up writing my own to avoid the jQuery dependency, which is why I'm not using the provided addControl or removeControl splices (attributes for button type elements).
Complex Forms
The form in the OP can't make use of the splices provided by digestive-functors-heist because the labels are dynamic (eg. they come from the database) and because we want it in a complex table layout. This means we have to perform 2 additional tasks:
Generate the markup manually
If you haven't looked at the markup that are generated by the digestive-functors-heist splices, you might want to do that first so that you get an idea of exactly what you have to generate so that your Form can be processed correctly.
For dynamic forms (eg. forms where the users are allowed to add or remove new items on the fly), you will need a hidden indices field:
<input type='hidden' name='formname.fieldname.indices' value='0,1,2,3' />
formname = whatever you named your form when you ran it via runForm
fieldname = the name of the list field in your main form (adjust as necessary if you're using subforms), in this example it would be named "properties"
value = a comma delimited list of numbers representing the indices of the subforms that should be processed when the form is submitted
When one of the items from your list is removed or a new one is added, this list will need to be adjusted otherwise new items will be completely ignored and removed items will still exist in your list. This step is unnecessary for static forms like the one in the OP.
Generating the rest of the form should be pretty straight forward if you already know how to write splices. Chunk up the data as appropriate (groupBy, chunksOf, etc.) and send it through your splices.
In case you can't already tell by looking at markup generated by digestive-splices-heist, you'll need to insert the index value of your subform as part of the fields for each subform. Tthis is what the output HTML should look like for the first field of our list of subforms:
<input type='text' name='formname.properties.0.name' value='Foo' />
<input type='text' name='formname.properties.0.value' value='Bar' />
(Hint: zip your list together with an infinite list starting from 0)
Pull the data back out of your form when handling errors
(I apologize in advance if none of this code is actually able to compile as written, but hopefully it illustrates the process)
This part is less straight forward than the other part, you'll have to dig through the innards of digestive-functors for this. Basically, we're going to use the same functions digestive-functors-heist does to get the data back out and populate our Thing with it. The function we're needing is listSubViews:
-- where `v` is the view returned by `runForm`
-- the return type will be `[View v]`, in our example `v` will be `Text`
viewList = listSubViews "properties" v
For a static form, this can be as simple as zipping this list together with your list of data.
let x = zipWith (curry updatePropertyData) xs viewList
And then your updatePropertyData function will need to update your records by pulling the information out of the view using the fileInputRead function:
updatePropertyData :: (Text, Text) -> View Text -> (Text, Text)
updatePropertyData x v =
let
-- pull the field information we want out of the subview
-- this is a `Maybe Text
val = fieldInputRead "value" v
in
-- update the tuple
maybe x ((fst x, )) val

Related

Storing type fields in a list

Hello i am faced with the following problem. I have a data type with multiple fields.I need to enumerate them and store them in a collection for further mapping.
data Worker=Worker{
age::Int,
name::String,
title::Title,
income::Int
}
data Title=Manager | Dev | Tester deriving (Show)
instance Show Worker where
show w=let !names=["age","name", "title","income"]
!props= [age,name,title,income] in -- Do i need to define another new type to be able to flat them down to a list?
"{"++intercalate "," (zipWith (\x y-> x++":"++ y w) names props)++"}"
Where can i store all all properties (methods)to be able to further use them as a parameter in a higher order function on a given variable of type Worker in our case.
You can get sort of close to the thing you're looking for, but it's not going to be pretty.
We can use RecordWildCards to bring all of the accessor names into scope as though they were ordinary variables, but that still introduces a new problem.
-- Not runnable Haskell code
foo Worker {..} = let names = ["age", "name", "title", "income"]
props = [age, name, title, income]
in ...
We're pattern matching on Worker {..}, which introduces a bunch of accessor names into the local scope. However, props is trying to be a heterogeneous list, which Haskell does not allow. It contains two integers, a string, and a title, whereas Haskell lists are only supposed to contain one type.
Since you're trying to show each field, you're going to have to apply show to each element by hand. Like I said, this is going to be a bit ugly.
foo Worker {..} = let names = ["age", "name", "title", "income"]
props = [show age, show name, show title, show income]
in ...
It may look like we can do map show [age, name, title, income], but we can't. That list still wouldn't be valid, and we're applying three different show functions here (they just happen to share a name), so we can't meaningfully map the same show over each element.
However, as the comments say, your best bet is to familiarize yourself with a proper JSON library, and Aeson is easily the best choice in Haskell for that sort of thing.

Query influxdb in Haskell

I'm thinking of developing an app to query our influxdb servers, I've looked at the influxdb library doc (https://hackage.haskell.org/package/influxdb-1.2.2/docs/Database-InfluxDB.html) but as far as I understand it, you need to pre-define some data structure or you can't query anything.
I just need to be able to let the user query whatever without having to define some data in the sources first.
I imagine I could define something with a time field and a value field, then use something like "SELECT active as value FROM mem" to force it to fit that. I think that would work, but it wouldn't be very practical if I need to query two fields later on.
Any better solutions I'm not seeing ? I'm still very much a beginner in Haskell, I'd appreciate any tips.
EDIT:
Even that doesn't work, since apparently it's missing the "String" constructor in that bit :
:{
data Test = Test { time :: UTCTime, value :: T.Text }
instance QueryResults Test where
parseResults prec = parseResultsWith $ \_ _ columns fields -> do
time <- getField "time" columns fields >>= parseUTCTime prec
String value <- getField "value" columns fields
return Test {..}
:}
I copied that from the doc and just changed the fields, not sure where the "String" is supposed to be declared.
I don't know what an "InfluxDB" is, but I can read Haskell type signatures, so maybe we can start with something like this:
import Data.Aeson
import qualified Data.Aeson.Types as A
import qualified Data.Vector as V
newtype GenericRawQueryResults = GenericRawQueryResults Value
deriving Show
instance FromJSON GenericRawQueryResults where
parseJSON = pure . GenericRawQueryResults
instance ToJSON GenericRawQueryResults where
toJSON (GenericRawQueryResults v) = v
instance QueryResults GenericRawQueryResults where
parseResults _ val = pure (V.singleton (GenericRawQueryResults val))
Then try your queries.
From what I can guess by reading the library's code, results from an influx DB query arrive at parseResults inside a json object that has a key called "results" that points to an array of objects, each of which has a key called "series" or a key called "error", and the assumption is that you write a parser to turn each element that's pointed to by "series" into whatever type you want to read from the db.
Except that there's even more framework going on there that I'd probably understand if I knew more about what an InfluxDB is and what kind of data it returns.
In any case, this should get you as close to the raw results as the library will let you get. One additional thing you might do is install the aeson-pretty package, remove the deriving Show bit and do:
instance Show GenericRawQueryResults where
show g = "decode " ++ show (encodePretty g)
(Or you can keep the derived Show instance and just apply encodePretty to your query results to display them)

How to deal with incomplete JSON/Record types (IE missing required fields which I'll later fill in)?

EDIT: For those with similar ailments, I found this is related to the "Extensible Records Problem", something I will personally research more into.
EDIT2: I have started to solve this (weeks later now) by being pretty explicit about data types, and having multiple data types per semantic unit of data. For example, if the database holds an X, my code has an XAction for representing things I want to do with an X, and XResponse for relaying Xs to an http client. And then I need to build the supporting code for shuttling bits between instances. Not ideal, but, I like that it's explicit, and hopefully when my models crystallize, it shouldn't really need much up keep, and should be very reliable.
I'm not sure what the correct level of abstraction is for tackling this problem (ie records? or Yesod?) So I'll just lay out the simple case.
Simple Case / TL;DR
I want to decode a request body into a type
data Comment = Comment {userid :: ..., comment :: ...}
but actually I don't want the request body to contain userid, the server will supply that based on their Auth Headers, (or wherever I want to get data to default fill a field).
So they actually pass me something like:
data SimpleComment = SimpleComment {comment :: ...} deriving (Generic, FromJSON)
And I turn it into a Comment. But maintaining both nearly-identical types simultaneously is a hassle, and not DRY.
How do I solve this problem?
Details on Problem
I have a record type:
data Comment = Comment {userid :: ..., comment :: ...}
I have a POST route:
postCommentR :: Handler Value
postCommentR = do
c <- requireJsonBody :: (Handler Comment)
insertedComment <- runDB ...
returnJson insertedComment
Notice that the Route requires that the user supply their userid (in the Comment type, which is at least redundant since their id is associated with their auth headers. At worst, it means I need to check that users are adding their own id, or throwing away their supplied id, in which case why did they supply it in the first case.
So, I want a record type that's Comment minus userid, but I don't know how to do that intelligently.
My Current (awful but working) Solution
So I made a custom type with derived FromJSON (for the request body) which is almost completely redundant with the Comment type.
data SimpleComment = SimpleComment {comment :: ...} deriving (Generic, FromJSON)
Then my new route needs to decode the request body according to this, and then merge a SimpleComment with a userid field to make it a Comment:
postComment2R :: Handler Value
postComment2R = do
c <- requireJsonBody :: (Handler SimpleComment)
(uid, _) requireAuthPair
insertedComment <- runDB $ insertEntity (Comment { commentUserid = uid
, commentComment = comment c})
returnJson ...
Talk about boilerplate. And my use case is more complex than this simple Comment type.
If it factors in, you might be able to tell, I'm using the Yesod Scaffolding.
What I usually do to get a type minus a field is just to have a function which take that field and return the type. In your case you just need to declare an JSON instance for UserId -> Comment. Ok it doesn't seem natural and you have to go it manually but it actually works really well, especially as there is only one field of type UserId in Comment.
A solution I like is to use a wrapper for things that come from/go to the DB:
data Authenticated a = Authenticated
{ uid :: Uid
, thing :: a
} deriving (Show)
Then you can have Comment be just SimpleComment and turn it into an Authenticated Comment once you know the user id.
I'm also looking for a nice way to solve this. :-)
What I usually do in my code is to operate directly on the Aeson's type Value. This is some of the sample code taken from my current project:
import qualified Data.HashMap.Strict as HM
removeKey :: Text -> Value -> Value
removeKey key (Object xs) = Object $ HM.delete key xs
removeKey _ ys = ys
I directly operate on the value Object and remove the particular key present in the javascript object.
And in the Yesod handler code, I do this processing:
myHandler :: Handler RepJson
myHandler = do
userId <- insert $ User "sibi" 23
guser <- getJuser user
let guser' = removeKey "someId" $ toJSON guser
return $ repJson $ object [ "details" .= guser' ]
In some cases, I actually want to add some specific key to the outgoing JSON object. For those, I have specific helper functions defined which operate on the type Value. While this is not perfect, it has been helping me to avoid a lot of boilerplate code.

Creating a URL Alias or Making Deep-Urls Pretty

I have fairly deep urls with IDs and I want to see if I can convert them into something nicer looking. I tried looking into how Slugs are done for Yesod Blog (https://github.com/yesodweb/yesod/wiki/Slugs) but not sure if I know how to translate that to what I am looking for here.
Suppose let's say I want to display Top Fiction Books, I have a resource that looks like this:
/topbooks/bookcategory/#BookCategoryId
If I go to /topbooks/bookcategory/1 I may get Fiction books, If I got to /topbooks/bookcategory/2 I may get Non-fiction, etc.
All my handlers use the #BookCategoryId input parameter in the database queries to get the appropriate records.
Ideally I would like to create a url that looks like: /topbooks/fiction, /topbooks/non-fictionetc. If I create my route as /topbooks/#Text, I can pattern match the string and return a Key back. However, I will have to manually transform it in every handler using #BookCategoryId. Note that the IDs are used as Foreign keys so it makes a bit cumbersome to rely on getBy like how it is done in Slug example.
So I am wondering if there is a better way to do it: Is it possible to define a custom type similar to Slug but instead of just converting values to/from Text / String, actually output IDs? That way I can just use the parameter directly in my queries.
Update:
To clarify given Michael's comment:
I understand we cannot get the IDs without doing a database lookup. In fact for this example, I am ok hard coding the look-up mechanism. I was just trying to see if the PathPiece mechanism will somehow simplify the conversion process.
For example, if something like this worked then it will be fine but of course I will get a type error since I am trying to return a Key when the compiler is expecting BookCategories.
data BookCategories = FICTION | NONFICTION
instance PathPiece BookCategories where
toPathPiece (FICTION) = T.pack "fiction"
toPathPiece (NONFICTION) = T.pack "nonfiction"
fromPathPiece s =
let ups = map toUpper $ T.unpack s
in
case reads ups of
[(FICTION, "")] -> Just $ Key $ PersistInt64 1
[(NONFICTION, "")] -> Just $ Key $ PersistInt64
[] -> Nothing
otherwise -> Nothing
Of course I could just return Just FICTION and unwrap it in my handler. This is not conceptually very different from actually pattern matching on Text directly with a function with a signature Text -> BookCategoryId.
getBookCategoryR :: BookCategoryId -> Handler Html
getBookCategoryR bcId = do
-- Normal use case when IDs are used in the URL
books <- runDB $ selectList [ModelBookCategory ==. bcId] []
If I swtich to Text input
getBookCategoryR :: Text -> Handler Html
getBookCategoryR bc = do
bcId = convertToId (bc) -- This is the line I am trying to avoid everywhere
books <- runDB $ selectList [ModelBookCategory ==. bcId] []
The one line conversion code is what I am trying to avoid. PathPiece has been handling it nicely for id-based-urls and kept the code clean. If there was a way to get Ids returned through some Type magic then it will be great. With limited knowledge of Haskell, I have no idea if it is even feasible.
Hope my question is clearer now.
Thanks!
No, there's no such way to do that, and the reason is simple: without consulting the database, there's no way to know if foo exists as a slug at all and, if it does, which ID it relates to. You'll always have to perform some database action to convert a slug into an ID.
UPDATE I'm still not certain I understand what you're looking for, but the short answer regarding PathPiece is that it only works on pure conversions, nothing which has side effects. If you're looking to write a function like Text -> Handler BookCategoryId, you can certainly do so. And if you really wanted to, you could even abstract this with a typeclass, though I'm not sure if you'll gain anything.
This may be barking up the wrong tree, but here's a short idea that might inspire you a bit: you could creating different newtype wrappers for each textual slug field, and then create a typeclass to convert a textual slug field into the appropriate entity, e.g.:
newtype BookCatSlug = BookCatSlug Text
deriving PathPiece
BookCategory
slug BookCatSlug
title Text
...
UniqueBookCat slug
class Slug slug where
type SlugEntity slug
lookupSlug :: slug -> YesodDB App (Maybe (Entity (SlugEntity slug)))
instance Slug BookCatSlug where
type SlugEntity BookCatSlug = BookCategory
lookupSlug = getBy . UniqueBookCat
lookupSlug404 slug = runDB (lookupSlug slug) >>= maybe notFound return
myHandler slug = do
Entity bookCatId bookCat <- lookupSlug404 slug
Something along these lines should work, but I'm not sure if the "type magic" is worthwhile, since having a helper function and manually passing in the appropriate Unique constructor would be almost as easy for the call site and result in much simpler error messages.

How to populate a new entry in a GtkTreeview (using Haskell & Glade)

this is how I currently initialize the Tree view from the glade file (Removed the uninteresting parts)
tree_view <- xmlGetWidget xml castToTreeView "tree_view"
To make it easy, how could I add a new entry to the tree_view using the text from an already filled text field?
text <- get text_field entryText
May someone help me?
Thanks
From your description, I assume that you have a tree view, but haven't set it up properly.
A GTK tree view is worth nothing if you don't connect it to several other widgets.
A tree model, which holds the data to be displayed in the tree view. The tree model can either be a list store, which stores data as a list, or a tree store, which stores the data as a tree, with nodes containing children. In your case, you'd probably need to create a ListStore:
store <- listStoreNew String
Tree models can store data of any type, including complex custom data types.
A tree view column for each piece of data to be shown. In this case, we just need one column because we want to display one string per row:
column <- treeViewColumnNew
The tree view column must know what data to show and how to display it (as text, as a tick box, as a picture...) So we need a cell renderer. The cell renderer will get a piece of data from each row in the tree model and show it in the given column. For displaying text, a CellRendererText is needed. There are other types of cell renderers for showing data in other forms (for instance CellRendererToggle for True/False values).
-- Create a cell renderer for displaying text
cell <- cellRendererTextNew
-- Add the cell renderer to the column. A column may display one or more
-- pieces of data; just pack the cell renderers into the column
cellLayoutPackStart column cell True
-- Let the cell renderer know where it has to get the data from
-- (in this case, the only element of each row). Note that we
-- want to display some text
cellLayoutSetAttributes column cell store $ \row -> [ cellText := row ]
Next, insert the column into the tree view. If you don't do this, the column won't be shown!
-- Insert the column into the tree view
_ <- treeViewAppendColumn tree_view column
-- Optional: Give a header/title to the column
treeViewColumnSetTitle column "My data"
And last but not least: connect the tree view to the tree model:
treeViewSetModel tree_view store
Now you should see an empty column in your tree view.
See the documentation of the gtk package at http://hackage.haskell.org/package/gtk to learn how to insert, remove and get data to/from a tree model (listStoreAppend, listStoreRemove, listStoreGetValue etc.)
Note that every tree model has a type and can only work with data of that type (but you can use any data type, even your own, so you can indeed store and show rows of complex data provided you set up every tree view column correctly). Otherwise you will get a type error when compiling the program.
A TreeView is a
"Widget that displays any object that implements the TreeModel
interface."
So you need the treeViewGetModel, treeViewSetModel to get the TreeModel.
I expect that the TreeModel interface you need is the TreeStore:
Two generic models are provided that implement the TreeModel
interface: the TreeStore and the ListStore. To use these, the
developer simply inserts data into these models as necessary.
The TreeStore has treeStoreInsert.
If you initialize your tree store like that (just passing an empty list), Haskell won't know its exact type and will say that the type of the store is "TreeStore (GHC.Prim.Any *)", which isn't what you want.
TreeStores are more complicated than ListStores because they must not only contain the data, but also its hierarchy (parent and children nodes).
See the definition of treeStoreNew:
treeStoreNew :: Forest a -> IO (TreeStore a)
TreeStores hold a "Forest" of type "a" (Integers, Strings, etc.). The Forest type is defined in the module Data.Tree, so you'll have to import this module:
import Data.Tree
A Forest is just a list of "Tree a", that means a data type "Tree" holding values of type "a".
That said, in order to set up your tree store properly, you must do the following if you want to store strings:
let id :: [Tree String]
id = []
store <- treeStoreNew id
If you look at your store's type (at the GHCi prompt), you'll see it's correct:
:t store
store :: TreeStore String
To insert a row at "[]" (the top level, without a parent), appending it to the end if there are already some rows at the top level (that's the meaning of (-1)), for example the string "John":
treeStoreInsert store [] (-1) "John"
The row will be inserted at path [0]. Check it at GHCi with:
treeStoreGetTree store [0] >>= print
Which will give "Node {rootLabel = "John", subForest = []}".
To insert a child of "John", for example "Smith":
treeStoreInsert store [0] (-1) "Smith"
The tree will now contain a parent item and a child (check with GHCi):
treeStoreGetTree store [0] >>= print
Will output now "Node {rootLabel = "John", subForest = [Node {rootLabel = "Smith", subForest = []}]}".
Finally,
treeStoreGetTree store [0,0] >>= print
Will show the child only: Node {rootLabel = "Smith", subForest = []}
See the documentation to learn more about the topic.

Resources