Converted sample code to doctest for RecordType, UnionInputType, RecordInputType
This commit is contained in:
klntsky
GitHub
parent
6d510ee2b1
commit
962a172b53
|
|
@ -146,6 +146,7 @@ import qualified Dhall.Util
|
|||
|
||||
-- $setup
|
||||
-- >>> :set -XOverloadedStrings
|
||||
-- >>> :set -XRecordWildCards
|
||||
|
||||
{-| Every `Type` must obey the contract that if an expression's type matches the
|
||||
the `expected` type then the `extract` function must succeed. If not, then
|
||||
|
|
@ -1401,11 +1402,13 @@ instance (Selector s, Inject a) => GenericInject (M1 S s (K1 i a)) where
|
|||
|
||||
For example, let's take the following Haskell data type:
|
||||
|
||||
> data Project = Project
|
||||
> { projectName :: Text
|
||||
> , projectDescription :: Text
|
||||
> , projectStars :: Natural
|
||||
> }
|
||||
>>> :{
|
||||
data Project = Project
|
||||
{ projectName :: Text
|
||||
, projectDescription :: Text
|
||||
, projectStars :: Natural
|
||||
}
|
||||
:}
|
||||
|
||||
And assume that we have the following Dhall record that we would like to
|
||||
parse as a @Project@:
|
||||
|
|
@ -1422,14 +1425,15 @@ instance (Selector s, Inject a) => GenericInject (M1 S s (K1 i a)) where
|
|||
smaller parsers, as 'Type's cannot be combined (they are only 'Functor's).
|
||||
However, we can use a 'RecordType' to build a 'Type' for @Project@:
|
||||
|
||||
> project :: Type Project
|
||||
> project =
|
||||
> record
|
||||
> ( Project <$> field "name" string
|
||||
> <*> field "description" string
|
||||
> <*> field "stars" natural
|
||||
> )
|
||||
|
||||
>>> :{
|
||||
project :: Type Project
|
||||
project =
|
||||
record
|
||||
( Project <$> field "name" strictText
|
||||
<*> field "description" strictText
|
||||
<*> field "stars" natural
|
||||
)
|
||||
:}
|
||||
-}
|
||||
|
||||
newtype RecordType a =
|
||||
|
|
@ -1489,9 +1493,11 @@ field key valueType =
|
|||
|
||||
For example, let's take the following Haskell data type:
|
||||
|
||||
> data Status = Queued Natural
|
||||
> | Result Text
|
||||
> | Errored Text
|
||||
>>> :{
|
||||
data Status = Queued Natural
|
||||
| Result Text
|
||||
| Errored Text
|
||||
:}
|
||||
|
||||
And assume that we have the following Dhall union that we would like to
|
||||
parse as a @Status@:
|
||||
|
|
@ -1505,13 +1511,14 @@ field key valueType =
|
|||
smaller parsers, as 'Type's cannot be combined (they are only 'Functor's).
|
||||
However, we can use a 'UnionType' to build a 'Type' for @Status@:
|
||||
|
||||
> status :: Type Status
|
||||
> status =
|
||||
> union
|
||||
> ( Queued <$> constructor "Queued" natural
|
||||
> <> Result <$> constructor "Result" string
|
||||
> <> Errored <$> constructor "Errored" string
|
||||
> )
|
||||
>>> :{
|
||||
status :: Type Status
|
||||
status = union
|
||||
( ( Queued <$> constructor "Queued" natural )
|
||||
<> ( Result <$> constructor "Result" strictText )
|
||||
<> ( Errored <$> constructor "Errored" strictText )
|
||||
)
|
||||
:}
|
||||
|
||||
-}
|
||||
newtype UnionType a =
|
||||
|
|
@ -1559,11 +1566,13 @@ constructor key valueType = UnionType
|
|||
|
||||
For example, let's take the following Haskell data type:
|
||||
|
||||
> data Project = Project
|
||||
> { projectName :: Text
|
||||
> , projectDescription :: Text
|
||||
> , projectStars :: Natural
|
||||
> }
|
||||
>>> :{
|
||||
data Project = Project
|
||||
{ projectName :: Text
|
||||
, projectDescription :: Text
|
||||
, projectStars :: Natural
|
||||
}
|
||||
:}
|
||||
|
||||
And assume that we have the following Dhall record that we would like to
|
||||
parse as a @Project@:
|
||||
|
|
@ -1580,27 +1589,31 @@ constructor key valueType = UnionType
|
|||
smaller injectors, as 'InputType's cannot be combined (they are only 'Contravariant's).
|
||||
However, we can use an 'InputRecordType' to build an 'InputType' for @Project@:
|
||||
|
||||
> injectProject :: InputType Project
|
||||
> injectProject =
|
||||
> inputRecord
|
||||
> ( adapt >$< inputFieldWith "name" inject
|
||||
> >*< inputFieldWith "description" inject
|
||||
> >*< inputFieldWith "stars" inject
|
||||
> )
|
||||
> where
|
||||
> adapt (Project{..}) = (projectName, (projectDescription, projectStars))
|
||||
>>> :{
|
||||
injectProject :: InputType Project
|
||||
injectProject =
|
||||
inputRecord
|
||||
( adapt >$< inputFieldWith "name" inject
|
||||
>*< inputFieldWith "description" inject
|
||||
>*< inputFieldWith "stars" inject
|
||||
)
|
||||
where
|
||||
adapt (Project{..}) = (projectName, (projectDescription, projectStars))
|
||||
:}
|
||||
|
||||
Or, since we are simply using the `Inject` instance to inject each field, we could write
|
||||
|
||||
> injectProject :: InputType Project
|
||||
> injectProject =
|
||||
> inputRecord
|
||||
> ( adapt >$< inputField "name"
|
||||
> >*< inputField "description"
|
||||
> >*< inputField "stars"
|
||||
> )
|
||||
> where
|
||||
> adapt (Project{..}) = (projectName, (projectDescription, projectStars))
|
||||
>>> :{
|
||||
injectProject :: InputType Project
|
||||
injectProject =
|
||||
inputRecord
|
||||
( adapt >$< inputField "name"
|
||||
>*< inputField "description"
|
||||
>*< inputField "stars"
|
||||
)
|
||||
where
|
||||
adapt (Project{..}) = (projectName, (projectDescription, projectStars))
|
||||
:}
|
||||
|
||||
-}
|
||||
|
||||
|
|
@ -1641,9 +1654,11 @@ inputRecord (RecordInputType inputTypeRecord) = InputType makeRecordLit recordTy
|
|||
|
||||
For example, let's take the following Haskell data type:
|
||||
|
||||
> data Status = Queued Natural
|
||||
> | Result Text
|
||||
> | Errored Text
|
||||
>>> :{
|
||||
data Status = Queued Natural
|
||||
| Result Text
|
||||
| Errored Text
|
||||
:}
|
||||
|
||||
And assume that we have the following Dhall union that we would like to
|
||||
parse as a @Status@:
|
||||
|
|
@ -1655,31 +1670,36 @@ inputRecord (RecordInputType inputTypeRecord) = InputType makeRecordLit recordTy
|
|||
|
||||
Our injector has type 'InputType' @Status@, but we can't build that out of any
|
||||
smaller injectors, as 'InputType's cannot be combined.
|
||||
However, we can use an 'InputUnionType' to build an 'InputType' for @Status@:
|
||||
However, we can use an 'UnionInputType' to build an 'InputType' for @Status@:
|
||||
|
||||
> injectStatus :: InputType Status
|
||||
> injectStatus =
|
||||
> adapt
|
||||
> >$< inputConstructorWith "Queued" inject
|
||||
> >|< inputConstructorWith "Result" inject
|
||||
> >|< inputConstructorWith "Errored" inject
|
||||
> where
|
||||
> adapt (Queued n) = Left (Left n)
|
||||
> adapt (Result t) = Left (Right t)
|
||||
> adapt (Errored e) = Right e
|
||||
>>> :{
|
||||
injectStatus :: InputType Status
|
||||
injectStatus = adapt >$< inputUnion
|
||||
( inputConstructorWith "Queued" inject
|
||||
>|< inputConstructorWith "Result" inject
|
||||
>|< inputConstructorWith "Errored" inject
|
||||
)
|
||||
where
|
||||
adapt (Queued n) = Left n
|
||||
adapt (Result t) = Right (Left t)
|
||||
adapt (Errored e) = Right (Right e)
|
||||
:}
|
||||
|
||||
Or, since we are simply using the `Inject` instance to inject each branch, we could write
|
||||
|
||||
> injectStatus :: InputType Status
|
||||
> injectStatus =
|
||||
> adapt
|
||||
> >$< inputConstructor "Queued"
|
||||
> >|< inputConstructor "Result"
|
||||
> >|< inputConstructor "Errored"
|
||||
> where
|
||||
> adapt (Queued n) = Left (Left n)
|
||||
> adapt (Result t) = Left (Right t)
|
||||
> adapt (Errored e) = Right e
|
||||
>>> :{
|
||||
injectStatus :: InputType Status
|
||||
injectStatus = adapt >$< inputUnion
|
||||
( inputConstructor "Queued"
|
||||
>|< inputConstructor "Result"
|
||||
>|< inputConstructor "Errored"
|
||||
)
|
||||
where
|
||||
adapt (Queued n) = Left n
|
||||
adapt (Result t) = Right (Left t)
|
||||
adapt (Errored e) = Right (Right e)
|
||||
:}
|
||||
|
||||
-}
|
||||
newtype UnionInputType a =
|
||||
UnionInputType
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user