{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts, AllowAmbiguousTypes, FlexibleInstances, IncoherentInstances, UndecidableInstances, PolyKinds, BlockArguments, DataKinds #-}

{-|
Module: IHP.Controller.Param
Description: Accessing query parameters and the request body
Copyright: (c) digitally induced GmbH, 2020

This module provides IHP-style parameter parsing using implicit parameters.
It wraps the generic functionality from "Wai.Request.Params" with IHP's
implicit @?request@ convention and adds IHP-specific 'ParamReader' instances.
-}
module IHP.Controller.Param
( -- * Reading parameters (implicit param versions)
  param
, paramOrNothing
, paramOrDefault
, paramOrError
, paramList
, paramListOrNothing
, hasParam
, queryOrBodyParam
, allParams
  -- * Specialized param functions
, paramText
, paramInt
, paramBool
, paramUUID
  -- * ParamReader typeclass (re-exported from Wai.Request.Params)
, ParamReader (..)
  -- * Exceptions (re-exported from Wai.Request.Params)
, ParamException (..)
  -- * Helper functions for custom ParamReader instances
, enumParamReader
, enumParamReaderJSON
  -- * Form filling
, FillParams (..)
, ifValid
, ifNew
  -- * Utilities
, emptyValueToNothing
) where

import IHP.Prelude
import Network.Wai (Request)
import qualified IHP.ModelSupport as ModelSupport
import IHP.ValidationSupport
import qualified Data.Attoparsec.ByteString.Char8 as Attoparsec
import qualified Data.Aeson as Aeson
import IHP.RequestVault ()
import qualified Control.DeepSeq as DeepSeq
import Text.Read (readMaybe)

-- Import the generic implementation
import qualified Wai.Request.Params as Params
import Wai.Request.Params (ParamReader(..), ParamException(..), enumParamReaderJSON)

-- | Returns a query or body parameter from the current request. The raw string
-- value is parsed before returning it. So the return value type depends on what
-- you expect (e.g. can be Int, Text, UUID, Bool, some custom type).
--
-- When the parameter is missing or cannot be parsed, an exception is thrown and
-- the current action is aborted. Use 'paramOrDefault' when you want to get a
-- default value instead of an exception, or 'paramOrNothing' to get @Nothing@
-- when the parameter is missing.
--
-- You can define a custom parameter parser by defining a 'ParamReader' instance.
--
-- __Example:__ Accessing a query parameter.
--
-- Let's say the request is:
--
-- > GET /UsersAction?maxItems=50
--
-- We can read @maxItems@ like this:
--
-- > action UsersAction = do
-- >     let maxItems :: Int = param "maxItems"
--
--
-- __Example:__ Working with forms (Accessing a body parameter).
--
-- Let's say we have the following html form:
--
-- > <form method="POST" action="/HelloWorld"
-- >     <input type="text" name="firstname" placeholder="Your firstname" />
-- >     <button type="submit">Send</button>
-- > </form>
--
-- The form has firstname text field and a send button.
-- When the form is submitted, it's send to @/HelloWorld@.
--
-- The following action reads the value of the submitted firstname and prints out @Hello firstname@:
--
-- > action HelloWorldAction = do
-- >     let firstname = param "firstname"
-- >     renderPlain ("Hello " <> firstname)
--
--
-- __Example:__ Missing parameters
--
-- Let's say the request is:
--
-- > GET /HelloWorldAction
--
-- But the action requires us to provide a firstname, like:
--
-- > action HelloWorldAction = do
-- >     let firstname = param "firstname"
-- >     renderPlain ("Hello " <> firstname)
--
-- Running the request @GET /HelloWorldAction@ without the firstname parameter will cause an
-- 'ParamNotFoundException' to be thrown with:
--
-- > param: Parameter 'firstname' not found
param :: (?request :: Request) => (ParamReader valueType) => ByteString -> valueType
param :: forall valueType.
(?request::Request, ParamReader valueType) =>
ByteString -> valueType
param !ByteString
name = RequestBody -> Request -> ByteString -> valueType
forall valueType.
ParamReader valueType =>
RequestBody -> Request -> ByteString -> valueType
Params.param ?request::Request
Request
?request.parsedBody ?request::Request
Request
?request ByteString
name
{-# INLINABLE param #-}

-- | Similiar to 'param' but works with multiple params. Useful when working with checkboxes.
--
-- Given a query like:
--
-- > ingredients=milk&ingredients=egg
--
-- This will return:
--
-- >>> paramList @Text "ingredients"
-- ["milk", "egg"]
--
-- When no parameter with the name is given, an empty list is returned:
--
-- >>> paramList @Text "not_given_in_url"
-- []
--
-- When a value cannot be parsed, this function will fail similiar to 'param'.
--
-- Related: https://stackoverflow.com/questions/63875081/how-can-i-pass-list-params-in-ihp-forms/63879113
paramList :: forall valueType. (?request :: Request, DeepSeq.NFData valueType, ParamReader valueType) => ByteString -> [valueType]
paramList :: forall valueType.
(?request::Request, NFData valueType, ParamReader valueType) =>
ByteString -> [valueType]
paramList ByteString
name = RequestBody -> Request -> ByteString -> [valueType]
forall valueType.
(NFData valueType, ParamReader valueType) =>
RequestBody -> Request -> ByteString -> [valueType]
Params.paramList ?request::Request
Request
?request.parsedBody ?request::Request
Request
?request ByteString
name
{-# INLINABLE paramList #-}

-- | Similiar to 'paramOrNothing' but works with multiple params. This is useful when submitting multiple
-- input fields with the same name, and some may be empty.
--
-- Given a query like (note the `ingredients` in the middle that has no value):
--
-- > ingredients=milk&ingredients&ingredients=egg
--
-- This will return:
--
-- >>> paramListOrNothing @Text "ingredients"
-- [Just "milk", Nothing, Just "egg"]
--
-- When no parameter with the name is given, an empty list is returned:
--
-- >>> paramListOrNothing @Text "not_given_in_url"
-- []
--
--
paramListOrNothing :: forall valueType. (?request :: Request, DeepSeq.NFData valueType, ParamReader valueType) => ByteString -> [Maybe valueType]
paramListOrNothing :: forall valueType.
(?request::Request, NFData valueType, ParamReader valueType) =>
ByteString -> [Maybe valueType]
paramListOrNothing ByteString
name = RequestBody -> Request -> ByteString -> [Maybe valueType]
forall valueType.
(NFData valueType, ParamReader valueType) =>
RequestBody -> Request -> ByteString -> [Maybe valueType]
Params.paramListOrNothing ?request::Request
Request
?request.parsedBody ?request::Request
Request
?request ByteString
name
{-# INLINABLE paramListOrNothing #-}

-- | Specialized version of param for 'Text'.
--
-- This way you don't need to know about the type application syntax.
paramText :: (?request :: Request) => ByteString -> Text
paramText :: (?request::Request) => ByteString -> Text
paramText = forall valueType.
(?request::Request, ParamReader valueType) =>
ByteString -> valueType
param @Text

-- | Specialized version of param for 'Int'.
--
-- This way you don't need to know about the type application syntax.
paramInt :: (?request :: Request) => ByteString -> Int
paramInt :: (?request::Request) => ByteString -> Int
paramInt = forall valueType.
(?request::Request, ParamReader valueType) =>
ByteString -> valueType
param @Int

-- | Specialized version of param for 'Bool'.
--
-- This way you don't need to know about the type application syntax.
paramBool :: (?request :: Request) => ByteString -> Bool
paramBool :: (?request::Request) => ByteString -> Bool
paramBool = forall valueType.
(?request::Request, ParamReader valueType) =>
ByteString -> valueType
param @Bool

-- | Specialized version of param for 'UUID'.
--
-- This way you don't need to know about the type application syntax.
paramUUID :: (?request :: Request) => ByteString -> UUID
paramUUID :: (?request::Request) => ByteString -> UUID
paramUUID = forall valueType.
(?request::Request, ParamReader valueType) =>
ByteString -> valueType
param @UUID

-- | Returns @True@ when a parameter is given in the request via the query or request body.
--
-- Use 'paramOrDefault' when you want to use this for providing a default value.
--
-- __Example:__
--
-- Given the request @GET /HelloWorld@
--
-- > action HelloWorldAction = do
-- >     if hasParam "firstname"
-- >         then ...
-- >         else renderPlain "Please provide your firstname"
--
-- This will render @Please provide your firstname@ because @hasParam "firstname"@ returns @False@
hasParam :: (?request :: Request) => ByteString -> Bool
hasParam :: (?request::Request) => ByteString -> Bool
hasParam = RequestBody -> Request -> ByteString -> Bool
Params.hasParam ?request::Request
Request
?request.parsedBody ?request::Request
Request
?request
{-# INLINABLE hasParam #-}

-- | Like 'param', but returns a default value when the parameter is missing instead of throwing
-- an exception.
--
-- Use 'paramOrNothing' when you want to get @Maybe@.
--
-- __Example:__ Pagination
--
-- When calling @GET /Users@ the variable @page@ will be set to the default value @0@.
--
-- > action UsersAction = do
-- >     let page :: Int = paramOrDefault 0 "page"
--
-- When calling @GET /Users?page=1@ the variable @page@ will be set to @1@.
paramOrDefault :: (?request :: Request) => ParamReader a => a -> ByteString -> a
paramOrDefault :: forall a.
(?request::Request, ParamReader a) =>
a -> ByteString -> a
paramOrDefault !a
defaultValue ByteString
name = RequestBody -> Request -> a -> ByteString -> a
forall a.
ParamReader a =>
RequestBody -> Request -> a -> ByteString -> a
Params.paramOrDefault ?request::Request
Request
?request.parsedBody ?request::Request
Request
?request a
defaultValue ByteString
name
{-# INLINABLE paramOrDefault #-}

-- | Like 'param', but returns @Nothing@ the parameter is missing instead of throwing
-- an exception.
--
-- Use 'paramOrDefault' when you want to deal with a default value.
--
-- __Example:__
--
-- When calling @GET /Users@ the variable @page@ will be set to @Nothing@.
--
-- > action UsersAction = do
-- >     let page :: Maybe Int = paramOrNothing "page"
--
-- When calling @GET /Users?page=1@ the variable @page@ will be set to @Just 1@.
paramOrNothing :: forall paramType. (?request :: Request) => ParamReader (Maybe paramType) => ByteString -> Maybe paramType
paramOrNothing :: forall paramType.
(?request::Request, ParamReader (Maybe paramType)) =>
ByteString -> Maybe paramType
paramOrNothing !ByteString
name = RequestBody -> Request -> ByteString -> Maybe paramType
forall paramType.
ParamReader (Maybe paramType) =>
RequestBody -> Request -> ByteString -> Maybe paramType
Params.paramOrNothing ?request::Request
Request
?request.parsedBody ?request::Request
Request
?request ByteString
name
{-# INLINABLE paramOrNothing #-}

-- | Like 'param', but returns @Left "Some error message"@ if the parameter is missing or invalid
paramOrError :: forall paramType. (?request :: Request) => ParamReader paramType => ByteString -> Either ParamException paramType
paramOrError :: forall paramType.
(?request::Request, ParamReader paramType) =>
ByteString -> Either ParamException paramType
paramOrError !ByteString
name = RequestBody
-> Request -> ByteString -> Either ParamException paramType
forall paramType.
ParamReader paramType =>
RequestBody
-> Request -> ByteString -> Either ParamException paramType
Params.paramOrError ?request::Request
Request
?request.parsedBody ?request::Request
Request
?request ByteString
name
{-# INLINABLE paramOrError #-}

-- | Returns a parameter without any parsing. Returns @Nothing@ when the parameter is missing.
queryOrBodyParam :: (?request :: Request) => ByteString -> Maybe ByteString
queryOrBodyParam :: (?request::Request) => ByteString -> Maybe ByteString
queryOrBodyParam !ByteString
name = RequestBody -> Request -> ByteString -> Maybe ByteString
Params.queryOrBodyParam ?request::Request
Request
?request.parsedBody ?request::Request
Request
?request ByteString
name
{-# INLINABLE queryOrBodyParam #-}

-- | Returns all params available in the current request
allParams :: (?request :: Request) => [(ByteString, Maybe ByteString)]
allParams :: (?request::Request) => [(ByteString, Maybe ByteString)]
allParams = RequestBody -> Request -> [(ByteString, Maybe ByteString)]
Params.allParams ?request::Request
Request
?request.parsedBody ?request::Request
Request
?request

-- IHP-specific ParamReader instances

instance ParamReader ModelSupport.Point where
    {-# INLINABLE readParameter #-}
    readParameter :: ByteString -> Either ByteString Point
readParameter ByteString
byteString =
        case Parser Point -> ByteString -> Either String Point
forall a. Parser a -> ByteString -> Either String a
Attoparsec.parseOnly (do x <- Parser Double
Attoparsec.double; Attoparsec.char ','; y <- Attoparsec.double; Attoparsec.endOfInput; pure (ModelSupport.fromCoordinates x y)) ByteString
byteString of
            Right Point
value -> Point -> Either ByteString Point
forall a b. b -> Either a b
Right Point
value
            Left String
error -> ByteString -> Either ByteString Point
forall a b. a -> Either a b
Left ByteString
"has to be two numbers with a comma, e.g. '1,2'"

    readParameterJSON :: Value -> Either ByteString Point
readParameterJSON (Aeson.String Text
string) = let ByteString
byteString :: ByteString = Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs Text
string in  ByteString -> Either ByteString Point
forall a. ParamReader a => ByteString -> Either ByteString a
readParameter ByteString
byteString
    readParameterJSON Value
_ = ByteString -> Either ByteString Point
forall a b. a -> Either a b
Left ByteString
"Expected Point"

instance ParamReader ModelSupport.Interval where
    {-# INLINABLE readParameter #-}
    readParameter :: ByteString -> Either ByteString Interval
readParameter ByteString
byteString = case String -> Maybe Interval
forall a. Read a => String -> Maybe a
readMaybe (ByteString -> String
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
byteString) of
        Just Interval
interval -> Interval -> Either ByteString Interval
forall a b. b -> Either a b
Right Interval
interval
        Maybe Interval
Nothing -> ByteString -> Either ByteString Interval
forall a b. a -> Either a b
Left ByteString
"Invalid interval"

    readParameterJSON :: Value -> Either ByteString Interval
readParameterJSON (Aeson.String Text
string) = case String -> Maybe Interval
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs Text
string) of
        Just Interval
interval -> Interval -> Either ByteString Interval
forall a b. b -> Either a b
Right Interval
interval
        Maybe Interval
Nothing -> ByteString -> Either ByteString Interval
forall a b. a -> Either a b
Left ByteString
"Invalid interval"
    readParameterJSON Value
_ = ByteString -> Either ByteString Interval
forall a b. a -> Either a b
Left ByteString
"Expected String"

instance ParamReader ModelSupport.Inet where
    {-# INLINABLE readParameter #-}
    readParameter :: ByteString -> Either ByteString Inet
readParameter ByteString
byteString = case String -> Maybe Inet
forall a. Read a => String -> Maybe a
readMaybe (ByteString -> String
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
byteString) of
        Just Inet
inet -> Inet -> Either ByteString Inet
forall a b. b -> Either a b
Right Inet
inet
        Maybe Inet
Nothing -> ByteString -> Either ByteString Inet
forall a b. a -> Either a b
Left ByteString
"Invalid IP address"

    readParameterJSON :: Value -> Either ByteString Inet
readParameterJSON (Aeson.String Text
string) = case String -> Maybe Inet
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs Text
string) of
        Just Inet
inet -> Inet -> Either ByteString Inet
forall a b. b -> Either a b
Right Inet
inet
        Maybe Inet
Nothing -> ByteString -> Either ByteString Inet
forall a b. a -> Either a b
Left ByteString
"Invalid IP address"
    readParameterJSON Value
_ = ByteString -> Either ByteString Inet
forall a b. a -> Either a b
Left ByteString
"Expected String"



instance ParamReader ModelSupport.Polygon where
    {-# INLINABLE readParameter #-}
    readParameter :: ByteString -> Either ByteString Polygon
readParameter ByteString
byteString =
        let
            pointParser :: Parser ByteString (Double, Double)
pointParser = do
                Char -> Parser Char
Attoparsec.char Char
'('
                x <- Parser Double
Attoparsec.double
                Attoparsec.char ','
                y <- Attoparsec.double
                Attoparsec.char ')'
                pure (x, y)
            parser :: Parser ByteString Polygon
parser = do
                points <- Parser ByteString (Double, Double)
pointParser Parser ByteString (Double, Double)
-> Parser Char -> Parser ByteString [(Double, Double)]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`Attoparsec.sepBy` (Char -> Parser Char
Attoparsec.char Char
',')
                Attoparsec.endOfInput
                case ModelSupport.refineFromPointList points of
                    Just Polygon
polygon -> Polygon -> Parser ByteString Polygon
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Polygon
polygon
                    Maybe Polygon
Nothing -> String -> Parser ByteString Polygon
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Polygon must have at least 3 points"
        in
        case Parser ByteString Polygon -> ByteString -> Either String Polygon
forall a. Parser a -> ByteString -> Either String a
Attoparsec.parseOnly Parser ByteString Polygon
parser ByteString
byteString of
            Right Polygon
value -> Polygon -> Either ByteString Polygon
forall a b. b -> Either a b
Right Polygon
value
            Left String
error -> ByteString -> Either ByteString Polygon
forall a b. a -> Either a b
Left (String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs String
error)

    readParameterJSON :: Value -> Either ByteString Polygon
readParameterJSON (Aeson.String Text
string) = let ByteString
byteString :: ByteString = Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs Text
string in ByteString -> Either ByteString Polygon
forall a. ParamReader a => ByteString -> Either ByteString a
readParameter ByteString
byteString
    readParameterJSON Value
_ = ByteString -> Either ByteString Polygon
forall a b. a -> Either a b
Left ByteString
"Expected Polygon"

instance {-# OVERLAPS #-} (ParamReader (ModelSupport.PrimaryKey model')) => ParamReader (ModelSupport.Id' model') where
    {-# INLINABLE readParameter #-}
    readParameter :: ByteString -> Either ByteString (Id' model')
readParameter ByteString
uuid = PrimaryKey model' -> Id' model'
forall (table :: Symbol). PrimaryKey table -> Id' table
ModelSupport.Id (PrimaryKey model' -> Id' model')
-> Either ByteString (PrimaryKey model')
-> Either ByteString (Id' model')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either ByteString (PrimaryKey model')
forall a. ParamReader a => ByteString -> Either ByteString a
readParameter ByteString
uuid
    readParameterJSON :: Value -> Either ByteString (Id' model')
readParameterJSON Value
value = PrimaryKey model' -> Id' model'
forall (table :: Symbol). PrimaryKey table -> Id' table
ModelSupport.Id (PrimaryKey model' -> Id' model')
-> Either ByteString (PrimaryKey model')
-> Either ByteString (Id' model')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either ByteString (PrimaryKey model')
forall a. ParamReader a => Value -> Either ByteString a
readParameterJSON Value
value

-- | Can be used as a default implementation for 'readParameter' for enum structures
--
-- __Example:__
--
-- > data Color = Yellow | Red | Blue deriving (Enum)
-- >
-- > instance ParamReader Color where
-- >     readParameter = enumParamReader
-- >     readParameterJSON = enumParamReaderJSON
enumParamReader :: forall parameter. (Enum parameter, ModelSupport.InputValue parameter) => ByteString -> Either ByteString parameter
enumParamReader :: forall parameter.
(Enum parameter, InputValue parameter) =>
ByteString -> Either ByteString parameter
enumParamReader ByteString
string =
        case (parameter -> Bool) -> [parameter] -> Maybe parameter
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\parameter
value -> parameter -> Text
forall a. InputValue a => a -> Text
ModelSupport.inputValue parameter
value Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
string') [parameter]
forall enumType. Enum enumType => [enumType]
allEnumValues of
            Just parameter
value -> parameter -> Either ByteString parameter
forall a b. b -> Either a b
Right parameter
value
            Maybe parameter
Nothing -> ByteString -> Either ByteString parameter
forall a b. a -> Either a b
Left ByteString
"Invalid value"
    where
        string' :: Text
string' = ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
string

-- | Provides the 'fill' function for mass-assignment of multiple parameters to a record
--
-- Accepts a type-level list of parameter names (type-list syntax is like @\@'["a", "b", "c"]@) and a record. Then each parameter is
-- read from the request using the 'param' API. The parameter value is written to the record
-- field.  Because the parameter is assigned to the record, the parameter name list can only
-- contain attribute names of the record.
--
-- When there is a parser error, the error will be attached as a validation error to the record. The
-- remaining parameters will continue to be read.
--
-- If a parameter is missing from the request, this will be ignored and the function proceeds as usual.
--
--
-- __Example:__
--
-- > action UpdateUserAction { userId } = do
-- >     user :: User <- fetch userId
-- >     user
-- >         |> fill @["firstname", "lastname", "email"]
--
-- This code will read the firstname, lastname and email from the request and assign them to the user.
class FillParams (params :: [Symbol]) record where
    fill :: (
        ?request :: Request
        , HasField "meta" record ModelSupport.MetaBag
        , SetField "meta" record ModelSupport.MetaBag
        ) => record -> record

instance FillParams ('[]) record where
    fill :: (?request::Request, HasField "meta" record MetaBag,
 SetField "meta" record MetaBag) =>
record -> record
fill !record
record = record
record
    {-# INLINE fill #-}

instance (FillParams rest record
    , KnownSymbol fieldName
    , SetField fieldName record fieldType
    , ParamReader fieldType
    , HasField "meta" record ModelSupport.MetaBag
    , SetField "meta" record ModelSupport.MetaBag
    ) => FillParams (fieldName:rest) record where
    fill :: (?request::Request, HasField "meta" record MetaBag,
 SetField "meta" record MetaBag) =>
record -> record
fill !record
record =
        let
            ByteString
name :: ByteString = String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$! (Proxy fieldName -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @fieldName))
            record' :: record
record' = case ByteString -> Either ParamException fieldType
forall paramType.
(?request::Request, ParamReader paramType) =>
ByteString -> Either ParamException paramType
paramOrError ByteString
name of
                Right !(fieldType
value :: fieldType) -> forall (field :: Symbol) model value.
SetField field model value =>
value -> model -> model
setField @fieldName fieldType
value record
record
                Left ParamCouldNotBeParsedException { ByteString
parserError :: ByteString
parserError :: ParamException -> ByteString
parserError } -> Proxy fieldName -> Text -> record -> record
forall (field :: Symbol) model.
(KnownSymbol field, HasField "meta" model MetaBag,
 SetField "meta" model MetaBag) =>
Proxy field -> Text -> model -> model
attachFailure (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @fieldName) (ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
parserError) record
record
                Left ParamNotFoundException {} -> record
record
        in
            forall (params :: [Symbol]) record.
(FillParams params record, ?request::Request,
 HasField "meta" record MetaBag, SetField "meta" record MetaBag) =>
record -> record
fill @rest record
record'
    {-# INLINE fill #-}

ifValid :: (HasField "meta" model ModelSupport.MetaBag) => (Either model model -> IO r) -> model -> IO r
ifValid :: forall model r.
HasField "meta" model MetaBag =>
(Either model model -> IO r) -> model -> IO r
ifValid Either model model -> IO r
branch model
model = Either model model -> IO r
branch (Either model model -> IO r) -> Either model model -> IO r
forall a b. (a -> b) -> a -> b
$! if model -> Bool
forall record. HasField "meta" record MetaBag => record -> Bool
ModelSupport.isValid model
model
    then model -> Either model model
forall a b. b -> Either a b
Right model
model
    else model -> Either model model
forall a b. a -> Either a b
Left model
model
{-# INLINE ifValid #-}

ifNew :: forall record. (?modelContext :: ModelSupport.ModelContext, HasField "meta" record MetaBag) => (record -> record) -> record -> record
ifNew :: forall record.
(?modelContext::ModelContext, HasField "meta" record MetaBag) =>
(record -> record) -> record -> record
ifNew record -> record
thenBlock record
record = if record -> Bool
forall record. HasField "meta" record MetaBag => record -> Bool
ModelSupport.isNew record
record then record -> record
thenBlock record
record else record
record


-- | Transforms @Just ""@ to @Nothing@
--
-- __Example:__ We have record called @Company@ with a optional field @comment :: Maybe Text@
--
-- When we have a form that submits the @comment@ field and the field is empty, it will not be @NULL@ inside the database,
-- instead it will be set to the empty string. To avoid this we can apply @emptyValueToNothing #comment@. This function
-- turns the empty string into a 'Nothing' value.
--
-- > action UpdateCompanyAction { companyId } = do
-- >     company <- fetch companyId
-- >     company
-- >         |> fill '["name", "comment"]
-- >         |> emptyValueToNothing #comment
-- >         |> updateRecord
emptyValueToNothing :: Proxy name -> model -> model
emptyValueToNothing Proxy name
field = Proxy name -> (Maybe mono -> Maybe mono) -> model -> model
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value,
 SetField name model value) =>
Proxy name -> (value -> value) -> model -> model
modify Proxy name
field (Maybe mono -> (mono -> Maybe mono) -> Maybe mono -> Maybe mono
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe mono
forall a. Maybe a
Nothing (\mono
value -> if mono -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null mono
value then Maybe mono
forall a. Maybe a
Nothing else mono -> Maybe mono
forall a. a -> Maybe a
Just mono
value))