{-# LANGUAGE MultiParamTypeClasses, TypeFamilies #-}
{- |
This module contains two classes. 'FormInput' is a class which is parameterized over the @input@ type used to represent form data in different web frameworks. There should be one instance for each framework, such as Happstack, Snap, WAI, etc.

The 'FormError' class is used to map error messages into an application specific error type.

-}
module Text.Reform.Backend where

import Data.Maybe            (listToMaybe)
import           Data.Text   (Text)
import qualified Data.Text   as T
import Text.Reform.Result (FormId)

-- | an error type used to represent errors that are common to all backends
--
-- These errors should only occur if there is a bug in the reform-*
-- packages. Perhaps we should make them an 'Exception' so that we can
-- get rid of the 'FormError' class.
data CommonFormError input
    = InputMissing FormId
    | NoStringFound input
    | NoFileFound input
    | MultiFilesFound input
    | MultiStringsFound input
    | MissingDefaultValue
      deriving (CommonFormError input -> CommonFormError input -> Bool
(CommonFormError input -> CommonFormError input -> Bool)
-> (CommonFormError input -> CommonFormError input -> Bool)
-> Eq (CommonFormError input)
forall input.
Eq input =>
CommonFormError input -> CommonFormError input -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommonFormError input -> CommonFormError input -> Bool
$c/= :: forall input.
Eq input =>
CommonFormError input -> CommonFormError input -> Bool
== :: CommonFormError input -> CommonFormError input -> Bool
$c== :: forall input.
Eq input =>
CommonFormError input -> CommonFormError input -> Bool
Eq, Eq (CommonFormError input)
Eq (CommonFormError input)
-> (CommonFormError input -> CommonFormError input -> Ordering)
-> (CommonFormError input -> CommonFormError input -> Bool)
-> (CommonFormError input -> CommonFormError input -> Bool)
-> (CommonFormError input -> CommonFormError input -> Bool)
-> (CommonFormError input -> CommonFormError input -> Bool)
-> (CommonFormError input
    -> CommonFormError input -> CommonFormError input)
-> (CommonFormError input
    -> CommonFormError input -> CommonFormError input)
-> Ord (CommonFormError input)
CommonFormError input -> CommonFormError input -> Bool
CommonFormError input -> CommonFormError input -> Ordering
CommonFormError input
-> CommonFormError input -> CommonFormError input
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall input. Ord input => Eq (CommonFormError input)
forall input.
Ord input =>
CommonFormError input -> CommonFormError input -> Bool
forall input.
Ord input =>
CommonFormError input -> CommonFormError input -> Ordering
forall input.
Ord input =>
CommonFormError input
-> CommonFormError input -> CommonFormError input
min :: CommonFormError input
-> CommonFormError input -> CommonFormError input
$cmin :: forall input.
Ord input =>
CommonFormError input
-> CommonFormError input -> CommonFormError input
max :: CommonFormError input
-> CommonFormError input -> CommonFormError input
$cmax :: forall input.
Ord input =>
CommonFormError input
-> CommonFormError input -> CommonFormError input
>= :: CommonFormError input -> CommonFormError input -> Bool
$c>= :: forall input.
Ord input =>
CommonFormError input -> CommonFormError input -> Bool
> :: CommonFormError input -> CommonFormError input -> Bool
$c> :: forall input.
Ord input =>
CommonFormError input -> CommonFormError input -> Bool
<= :: CommonFormError input -> CommonFormError input -> Bool
$c<= :: forall input.
Ord input =>
CommonFormError input -> CommonFormError input -> Bool
< :: CommonFormError input -> CommonFormError input -> Bool
$c< :: forall input.
Ord input =>
CommonFormError input -> CommonFormError input -> Bool
compare :: CommonFormError input -> CommonFormError input -> Ordering
$ccompare :: forall input.
Ord input =>
CommonFormError input -> CommonFormError input -> Ordering
$cp1Ord :: forall input. Ord input => Eq (CommonFormError input)
Ord, Int -> CommonFormError input -> ShowS
[CommonFormError input] -> ShowS
CommonFormError input -> String
(Int -> CommonFormError input -> ShowS)
-> (CommonFormError input -> String)
-> ([CommonFormError input] -> ShowS)
-> Show (CommonFormError input)
forall input. Show input => Int -> CommonFormError input -> ShowS
forall input. Show input => [CommonFormError input] -> ShowS
forall input. Show input => CommonFormError input -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommonFormError input] -> ShowS
$cshowList :: forall input. Show input => [CommonFormError input] -> ShowS
show :: CommonFormError input -> String
$cshow :: forall input. Show input => CommonFormError input -> String
showsPrec :: Int -> CommonFormError input -> ShowS
$cshowsPrec :: forall input. Show input => Int -> CommonFormError input -> ShowS
Show)

-- | some default error messages for 'CommonFormError'
commonFormErrorStr :: (input -> String)     -- ^ show 'input' in a format suitable for error messages
                   -> CommonFormError input -- ^ a 'CommonFormError'
                   -> String
commonFormErrorStr :: (input -> String) -> CommonFormError input -> String
commonFormErrorStr input -> String
showInput CommonFormError input
cfe =
    case CommonFormError input
cfe of
      (InputMissing FormId
formId)     -> String
"Input field missing for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FormId -> String
forall a. Show a => a -> String
show FormId
formId
      (NoStringFound input
input)     -> String
"Could not extract a string value from: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ input -> String
showInput input
input
      (NoFileFound input
input)       -> String
"Could not find a file associated with: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ input -> String
showInput input
input
      (MultiFilesFound input
input)   -> String
"Found multiple files associated with: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ input -> String
showInput input
input
      (MultiStringsFound input
input) -> String
"Found multiple strings associated with: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ input -> String
showInput input
input
      CommonFormError input
MissingDefaultValue       -> String
"Missing default value."

-- | A Class to lift a 'CommonFormError' into an application-specific error type
class FormError e where
    type ErrorInputType e
    commonFormError :: (CommonFormError (ErrorInputType e)) -> e

-- | Class which all backends should implement.
--
class FormInput input where
    -- |@input@ is here the type that is used to represent a value
    -- uploaded by the client in the request.
    type FileType input
    -- | Parse the input into a string. This is used for simple text fields
    -- among other things
    --
    getInputString :: (FormError error, ErrorInputType error ~ input) => input -> Either error String
    getInputString input
input =
           case input -> [String]
forall input. FormInput input => input -> [String]
getInputStrings input
input of
             []  -> error -> Either error String
forall a b. a -> Either a b
Left (CommonFormError (ErrorInputType error) -> error
forall e. FormError e => CommonFormError (ErrorInputType e) -> e
commonFormError (CommonFormError (ErrorInputType error) -> error)
-> CommonFormError (ErrorInputType error) -> error
forall a b. (a -> b) -> a -> b
$ input -> CommonFormError input
forall input. input -> CommonFormError input
NoStringFound input
input)
             [String
s] -> String -> Either error String
forall a b. b -> Either a b
Right String
s
             [String]
_   -> error -> Either error String
forall a b. a -> Either a b
Left (CommonFormError (ErrorInputType error) -> error
forall e. FormError e => CommonFormError (ErrorInputType e) -> e
commonFormError (CommonFormError (ErrorInputType error) -> error)
-> CommonFormError (ErrorInputType error) -> error
forall a b. (a -> b) -> a -> b
$ input -> CommonFormError input
forall input. input -> CommonFormError input
MultiStringsFound input
input)

    -- | Should be implemented
    --
    getInputStrings :: input -> [String]

    -- | Parse the input value into 'Text'
    --
    getInputText :: (FormError error, ErrorInputType error ~ input) => input -> Either error Text
    getInputText input
input =
           case input -> [Text]
forall input. FormInput input => input -> [Text]
getInputTexts input
input of
             []  -> error -> Either error Text
forall a b. a -> Either a b
Left (CommonFormError (ErrorInputType error) -> error
forall e. FormError e => CommonFormError (ErrorInputType e) -> e
commonFormError (CommonFormError (ErrorInputType error) -> error)
-> CommonFormError (ErrorInputType error) -> error
forall a b. (a -> b) -> a -> b
$ input -> CommonFormError input
forall input. input -> CommonFormError input
NoStringFound input
input)
             [Text
s] -> Text -> Either error Text
forall a b. b -> Either a b
Right Text
s
             [Text]
_   -> error -> Either error Text
forall a b. a -> Either a b
Left (CommonFormError (ErrorInputType error) -> error
forall e. FormError e => CommonFormError (ErrorInputType e) -> e
commonFormError (CommonFormError (ErrorInputType error) -> error)
-> CommonFormError (ErrorInputType error) -> error
forall a b. (a -> b) -> a -> b
$ input -> CommonFormError input
forall input. input -> CommonFormError input
MultiStringsFound input
input)


    -- | Can be overriden for efficiency concerns
    --
    getInputTexts :: input -> [Text]
    getInputTexts = (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack ([String] -> [Text]) -> (input -> [String]) -> input -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. input -> [String]
forall input. FormInput input => input -> [String]
getInputStrings

    -- | Get a file descriptor for an uploaded file
    --
    getInputFile :: (FormError error, ErrorInputType error ~ input) => input -> Either error (FileType input)