{-# LANGUAGE
    MultiParamTypeClasses
  , TypeFamilies
  , OverloadedStrings
  , FunctionalDependencies
#-}

{- |
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 Ditto.Backend where

import Data.Text (Text)
import Ditto.Types (FormId, encodeFormId)
import qualified Data.Text as T

-- | 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 ditto-*
-- 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
encodeInput CommonFormError input
cfe = case CommonFormError input
cfe of
  InputMissing FormId
formId -> String
"Input field missing for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Text -> String
T.unpack (Text -> String) -> (FormId -> Text) -> FormId -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormId -> Text
encodeFormId) FormId
formId
  NoStringFound input
input -> String
"Could not extract a string value from: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ input -> String
encodeInput input
input
  NoFileFound input
input -> String
"Could not find a file associated with: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ input -> String
encodeInput input
input
  MultiFilesFound input
input -> String
"Found multiple files associated with: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ input -> String
encodeInput input
input
  MultiStringsFound input
input -> String
"Found multiple strings associated with: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ input -> String
encodeInput input
input
  CommonFormError input
MissingDefaultValue -> String
"Missing default value."

-- | some default error messages for 'CommonFormError'
commonFormErrorText
  :: (input -> Text) -- ^ show 'input' in a format suitable for error messages
  -> CommonFormError input -- ^ a 'CommonFormError'
  -> Text
commonFormErrorText :: (input -> Text) -> CommonFormError input -> Text
commonFormErrorText input -> Text
encodeInput CommonFormError input
cfe = case CommonFormError input
cfe of
  InputMissing FormId
formId -> Text
"Input field missing for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FormId -> Text
encodeFormId FormId
formId
  NoStringFound input
input -> Text
"Could not extract a string value from: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> input -> Text
encodeInput input
input
  NoFileFound input
input -> Text
"Could not find a file associated with: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> input -> Text
encodeInput input
input
  MultiFilesFound input
input -> Text
"Found multiple files associated with: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> input -> Text
encodeInput input
input
  MultiStringsFound input
input -> Text
"Found multiple strings associated with: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> input -> Text
encodeInput input
input
  CommonFormError input
MissingDefaultValue -> Text
"Missing default value."

-- | A Class to lift a 'CommonFormError' into an application-specific error type
class FormError input err where
  commonFormError :: CommonFormError input -> err

instance FormError Text Text where
  commonFormError :: CommonFormError Text -> Text
commonFormError = (Text -> Text) -> CommonFormError Text -> Text
forall input. (input -> Text) -> CommonFormError input -> Text
commonFormErrorText Text -> Text
forall a. a -> a
id

-- | 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 input err) => input -> Either err String
  getInputString input
input =
    case input -> [String]
forall input. FormInput input => input -> [String]
getInputStrings input
input of
      [] -> err -> Either err String
forall a b. a -> Either a b
Left (CommonFormError input -> err
forall input err.
FormError input err =>
CommonFormError input -> err
commonFormError (CommonFormError input -> err) -> CommonFormError input -> err
forall a b. (a -> b) -> a -> b
$ input -> CommonFormError input
forall input. input -> CommonFormError input
NoStringFound input
input)
      [String
s] -> String -> Either err String
forall a b. b -> Either a b
Right String
s
      [String]
_ -> err -> Either err String
forall a b. a -> Either a b
Left (CommonFormError input -> err
forall input err.
FormError input err =>
CommonFormError input -> err
commonFormError (CommonFormError input -> err) -> CommonFormError input -> err
forall a b. (a -> b) -> a -> b
$ input -> CommonFormError input
forall input. input -> CommonFormError input
MultiStringsFound input
input)

  getInputStrings :: input -> [String]
  getInputStrings = (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack ([Text] -> [String]) -> (input -> [Text]) -> input -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. input -> [Text]
forall input. FormInput input => input -> [Text]
getInputTexts

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

  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 input err) => input -> Either err (FileType input)