Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- data Param = Param {
- paramName :: Name
- paramValue :: Text
- newtype Name = Name [NamePart]
- data NamePart
- showName :: Name -> Text
- readName :: Text -> Name
- data Form = Form {
- formParams :: [Param]
- formContext :: Name -> Name
- newtype Log err = Log (Set (Name, err))
- class Err_Missing a where
- err_missing :: a
- class Err_Duplicate a where
- err_duplicate :: a
- class Err_Unexpected a where
- err_unexpected :: a
- class Err_OnlyAllowed a where
- err_onlyAllowed :: Text -> a
- newtype EnglishSentence = EnglishSentence Text
- englishSentenceLogText :: Log EnglishSentence -> Text
- type Grab err a = Simple Form (Log err) a
- type Dump err a = Dump Form (Log err) a
- at :: Ord err => NamePart -> Dump err a -> Grab err a
- text :: forall err. (Ord err, Err_Missing err, Err_Duplicate err) => Grab err Text
- optionalText :: forall err. (Ord err, Err_Duplicate err) => Grab err (Maybe Text)
- checkbox :: forall err. (Ord err, Err_OnlyAllowed err) => Text -> Grab err Bool
- natList :: Ord err => Dump err a -> Grab err [a]
- natListWithIndex :: forall err a. Ord err => Dump err a -> Grab err [(Natural, a)]
- only :: forall err a. (Ord err, Err_Unexpected err) => Grab err a -> Dump err a
- etAlia :: Grab err a -> Dump err a
- remainder :: Ord err => Grab err [Param]
- readTextParams :: Ord err => Dump err a -> [(Text, Text)] -> (Log err, Maybe a)
Tutorial
We are concerned here with data submitted by web browsers in a normal form submission. Ignoring the encoding details, we can think of a form as looking something like this:
name: Alonzo state: Montana security_question: What is your favorite hobby? security_answer: watching cars
This example has four parameters. Each parameter has a name and a value. We might represent this in Haskell as:
[ ("name", "Alonzo") , ("state", "Montana") , ("security_question", "What is your favorite hobby?") , ("security_answer", "watching cars") ]
Suppose we're only interested in two parts of this form: The name and the state.
nameAndState :: Grab EnglishSentence (Text, Text) nameAndState = (,) <$> at "name" (only text) <*> at "state" (only text)
If we apply nameAndState
to the form parameters above, we get the following
result: ("Alonzo", "Montana")
λ> :{ > readTextParams (etAlia nameAndState) > [ ("name", "Alonzo") > , ("state", "Montana") > , ("security_question", "What is your favorite hobby?") > , ("security_answer", "watching cars") > ] > :} ( Log [] , Just ("Alonzo", "Montana") )
When receiving information submitted from an external source, there is usually
some possibility that the input is invalid. Consider the following form that is
missing the "state" field. In this case, the result we get is Nothing
,
accompanied by an error message indicating that something is missing.
λ> :{ > readTextParams (etAlia nameAndState) > [ ("name", "Alonzo") > , ("security_question", "What is your favorite hobby?") > , ("security_answer", "watching cars") > ] > :} ( Log [("state", "Required parameter is missing.")] , Nothing )
The etAlia
function we've been using signifies that the input is allowed to
contain parameters other than the ones that nameAndState
grabs. If we use
only
instead, we can specify that there should be no additional parameters.
λ> :{ > readTextParams (only nameAndState) > [ ("name", "Alonzo") > , ("state", "Montana") > , ("security_question", "What is your favorite hobby?") > , ("security_answer", "watching cars") > ] > :} ( Log [ ("security_question", "Unexpected parameter.") , ("security_answer", "Unexpected parameter.") ] , Just ("Alonzo", "Montana") )
However, we still get the result: ("Alonzo", "Montana")
. Unexpected parameters
do not prevent us from being able to read the form. Whether you choose only
or
etAlia
only determines whether these warnings end up in the log; it does not
affect whether reading the form succeeds or fails.
Duplicate parameters are not permitted, since we cannot know which of the values to accept as the real one. Alonzo cannot live in both Georgia and Montana:
λ> :{ > readTextParams (only nameAndState) > [ ("name", "Alonzo") > , ("state", "Georgia") > , ("state", "Montana") > ] > :} ( Log [("state", "Parameter may not appear more than once.")] , Nothing )
Duplicated parameters are only allowed if they have the same value, because in that case the problem of deciding which value to accept does not arise.
λ> :{ > readTextParams (only nameAndState) > [ ("name", "Alonzo") > , ("state", "Montana") > , ("state", "Montana") > ] > :} ( Log [] , Just ("Alonzo", "Montana") )
Sometimes a form has a tree structure. Suppose there are multiple security questions. If we were using a data format like YAML, it might look like this:
name: Alonzo state: Montana security: - Q: What is your favorite hobby? A: watching cars - Q: What is your oldest sibling's name? A: melman - Q: What was the make and model of your first car? A: bmw x5
To cajole this data into our concept of a form as a list of parameters, we need to flatten it somehow. We adopt the following convention:
name: Alonzo state: Montana security[1].Q: What is your favorite hobby? security[1].A: watching cars security[2].Q: What is your oldest sibling's name? security[2].A: melman security[3].Q: What was the make and model of your first car? security[3].A: bmw x5
Let's define a data type to represent a question and answer:
data QA = QA { qa_question :: Text, qa_answer :: Text } deriving (Eq, Show)
nameStateAndQAs :: Grab EnglishSentence (Text, Text, [QA]) nameStateAndQAs = (,,) <$> at "name" (only text) <*> at "state" (only text) <*> at "security" (only (natList (only qa)))
qa :: Grab EnglishSentence QA qa = QA <$> at "Q" (only text) <*> at "A" (only text)
λ> :{ > readTextParams (only nameStateAndQAs) > [ ("name", "Alonzo") > , ("state", "Montana") > , ("security[0].Q", "What is your favorite hobby?") > , ("security[0].A", "watching cars") > , ("security[1].Q", "What is your oldest sibling's name?") > , ("security[1].A", "melman") > , ("security[2].Q", "What was the make and model of your first car?") > , ("security[2].A", "bmw x5") > ] > :} ( Log [] , Just ( "Alonzo" , "Montana" , [ QA { qa_question = "What is your favorite hobby?" , qa_answer = "watching cars" } , QA { qa_question = "What is your oldest sibling's name?" , qa_answer = "melman" } , QA { qa_question = "What was the make and model of your first car?" , qa_answer = "bmw x5" } ] ) )
The parameters of the list may appear in any order. The order of the result is determined by the numbers in the parameter names.
λ> :{ > readTextParams (only (at "security" (only (natList (only qa))))) > [ ("security[2].Q", "What was the make and model of your first car?") > , ("security[1].A", "melman") > , ("security[0].Q", "What is your favorite hobby?") > , ("security[1].Q", "What is your oldest sibling's name?") > , ("security[0].A", "watching cars") > , ("security[2].A", "bmw x5") > ] > :} ( Log [] , Just [ QA { qa_question = "What is your favorite hobby?" , qa_answer = "watching cars" } , QA { qa_question = "What is your oldest sibling's name?" , qa_answer = "melman" } , QA { qa_question = "What was the make and model of your first car?" , qa_answer = "bmw x5" } ] )
Error messages work the same within nested grabs. The result is a complete list of every error encountered.
λ> :{ > readTextParams (only nameStateAndQAs) > [ ("state", "Montana") > , ("itchy face", "yes") > , ("security[0].Q", "What is your favorite hobby?") > , ("security[0].A", "watching cars") > , ("security[1].Q", "What is your oldest sibling's name?") > , ("security[1].A", "melman") > , ("security[1].A", "iowa") > , ("security[2].Q", "What was the make and model of your first car?") > , ("security[2].A", "bmw x5") > , ("security[2].A2", "xyz") > ] > :} ( Log [ ("name", "Required parameter is missing.") , ("itchy face", "Unexpected parameter.") , ("security[1].A", "Parameter may not appear more than once.") , ("security[2].A2", "Unexpected parameter.") ] , Nothing )
What is a form
The Parameter type
Param | |
|
The Name type
The Form type
Form | |
|
Error messages
The Log type
Error classes
class Err_Missing a where Source #
err_missing :: a Source #
A parameter was expected, but none was given.
Instances
Err_Missing () Source # | |
Defined in Data.GrabForm err_missing :: () Source # | |
Err_Missing EnglishSentence Source # | |
Defined in Data.GrabForm |
class Err_Duplicate a where Source #
err_duplicate :: a Source #
A parameter was given repeatedly in a situation where it was expected to be present at most once.
Instances
Err_Duplicate () Source # | |
Defined in Data.GrabForm err_duplicate :: () Source # | |
Err_Duplicate EnglishSentence Source # | |
Defined in Data.GrabForm |
class Err_Unexpected a where Source #
err_unexpected :: a Source #
An unexpected parameter was given.
Instances
Err_Unexpected () Source # | |
Defined in Data.GrabForm err_unexpected :: () Source # | |
Err_Unexpected EnglishSentence Source # | |
Defined in Data.GrabForm |
class Err_OnlyAllowed a where Source #
:: Text | The allowed value |
-> a |
There is only one allowed value for a parameter, and something different was given.
Instances
Err_OnlyAllowed () Source # | |
Defined in Data.GrabForm err_onlyAllowed :: Text -> () Source # | |
Err_OnlyAllowed EnglishSentence Source # | |
Defined in Data.GrabForm |
English sentences as error messages
newtype EnglishSentence Source #
Instances
Grabbing data from forms
Types: Grab and Dump
Parameter name selection
Simple form fields
text :: forall err. (Ord err, Err_Missing err, Err_Duplicate err) => Grab err Text Source #
optionalText :: forall err. (Ord err, Err_Duplicate err) => Grab err (Maybe Text) Source #