{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
module Codec.Xlsx.Types.DataValidation where

import Control.DeepSeq (NFData)
#ifdef USE_MICROLENS
import Lens.Micro.TH (makeLenses)
#else
import Control.Lens.TH (makeLenses)
#endif
import Control.Monad ((>=>))
import Data.ByteString (ByteString)
import Data.Char (isSpace)
import Data.Default
import qualified Data.Map as M
import Data.Maybe (catMaybes, maybeToList)
import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Generics (Generic)
import Text.XML (Element(..), Node(..))
import Text.XML.Cursor (Cursor, ($/), element)

import Codec.Xlsx.Parser.Internal
import Codec.Xlsx.Types.Common
import Codec.Xlsx.Writer.Internal

-- See 18.18.20 "ST_DataValidationOperator (Data Validation Operator)" (p. 2439/2449)
data ValidationExpression
    = ValBetween Formula Formula    -- ^ "Between" operator
    | ValEqual Formula              -- ^ "Equal to" operator
    | ValGreaterThan Formula        -- ^ "Greater than" operator
    | ValGreaterThanOrEqual Formula -- ^ "Greater than or equal to" operator
    | ValLessThan Formula           -- ^ "Less than" operator
    | ValLessThanOrEqual Formula    -- ^ "Less than or equal to" operator
    | ValNotBetween Formula Formula -- ^ "Not between" operator
    | ValNotEqual Formula           -- ^ "Not equal to" operator
    deriving (ValidationExpression -> ValidationExpression -> Bool
(ValidationExpression -> ValidationExpression -> Bool)
-> (ValidationExpression -> ValidationExpression -> Bool)
-> Eq ValidationExpression
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValidationExpression -> ValidationExpression -> Bool
$c/= :: ValidationExpression -> ValidationExpression -> Bool
== :: ValidationExpression -> ValidationExpression -> Bool
$c== :: ValidationExpression -> ValidationExpression -> Bool
Eq, Int -> ValidationExpression -> ShowS
[ValidationExpression] -> ShowS
ValidationExpression -> String
(Int -> ValidationExpression -> ShowS)
-> (ValidationExpression -> String)
-> ([ValidationExpression] -> ShowS)
-> Show ValidationExpression
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValidationExpression] -> ShowS
$cshowList :: [ValidationExpression] -> ShowS
show :: ValidationExpression -> String
$cshow :: ValidationExpression -> String
showsPrec :: Int -> ValidationExpression -> ShowS
$cshowsPrec :: Int -> ValidationExpression -> ShowS
Show, (forall x. ValidationExpression -> Rep ValidationExpression x)
-> (forall x. Rep ValidationExpression x -> ValidationExpression)
-> Generic ValidationExpression
forall x. Rep ValidationExpression x -> ValidationExpression
forall x. ValidationExpression -> Rep ValidationExpression x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ValidationExpression x -> ValidationExpression
$cfrom :: forall x. ValidationExpression -> Rep ValidationExpression x
Generic)
instance NFData ValidationExpression

-- See 18.18.21 "ST_DataValidationType (Data Validation Type)" (p. 2440/2450)
data ValidationType
    = ValidationTypeNone
    | ValidationTypeCustom     Formula
    | ValidationTypeDate       ValidationExpression
    | ValidationTypeDecimal    ValidationExpression
    | ValidationTypeList       [Text]
    | ValidationTypeTextLength ValidationExpression
    | ValidationTypeTime       ValidationExpression
    | ValidationTypeWhole      ValidationExpression
    deriving (ValidationType -> ValidationType -> Bool
(ValidationType -> ValidationType -> Bool)
-> (ValidationType -> ValidationType -> Bool) -> Eq ValidationType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValidationType -> ValidationType -> Bool
$c/= :: ValidationType -> ValidationType -> Bool
== :: ValidationType -> ValidationType -> Bool
$c== :: ValidationType -> ValidationType -> Bool
Eq, Int -> ValidationType -> ShowS
[ValidationType] -> ShowS
ValidationType -> String
(Int -> ValidationType -> ShowS)
-> (ValidationType -> String)
-> ([ValidationType] -> ShowS)
-> Show ValidationType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValidationType] -> ShowS
$cshowList :: [ValidationType] -> ShowS
show :: ValidationType -> String
$cshow :: ValidationType -> String
showsPrec :: Int -> ValidationType -> ShowS
$cshowsPrec :: Int -> ValidationType -> ShowS
Show, (forall x. ValidationType -> Rep ValidationType x)
-> (forall x. Rep ValidationType x -> ValidationType)
-> Generic ValidationType
forall x. Rep ValidationType x -> ValidationType
forall x. ValidationType -> Rep ValidationType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ValidationType x -> ValidationType
$cfrom :: forall x. ValidationType -> Rep ValidationType x
Generic)
instance NFData ValidationType

-- See 18.18.18 "ST_DataValidationErrorStyle (Data Validation Error Styles)" (p. 2438/2448)
data ErrorStyle
    = ErrorStyleInformation
    | ErrorStyleStop
    | ErrorStyleWarning
    deriving (ErrorStyle -> ErrorStyle -> Bool
(ErrorStyle -> ErrorStyle -> Bool)
-> (ErrorStyle -> ErrorStyle -> Bool) -> Eq ErrorStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorStyle -> ErrorStyle -> Bool
$c/= :: ErrorStyle -> ErrorStyle -> Bool
== :: ErrorStyle -> ErrorStyle -> Bool
$c== :: ErrorStyle -> ErrorStyle -> Bool
Eq, Int -> ErrorStyle -> ShowS
[ErrorStyle] -> ShowS
ErrorStyle -> String
(Int -> ErrorStyle -> ShowS)
-> (ErrorStyle -> String)
-> ([ErrorStyle] -> ShowS)
-> Show ErrorStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorStyle] -> ShowS
$cshowList :: [ErrorStyle] -> ShowS
show :: ErrorStyle -> String
$cshow :: ErrorStyle -> String
showsPrec :: Int -> ErrorStyle -> ShowS
$cshowsPrec :: Int -> ErrorStyle -> ShowS
Show, (forall x. ErrorStyle -> Rep ErrorStyle x)
-> (forall x. Rep ErrorStyle x -> ErrorStyle) -> Generic ErrorStyle
forall x. Rep ErrorStyle x -> ErrorStyle
forall x. ErrorStyle -> Rep ErrorStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ErrorStyle x -> ErrorStyle
$cfrom :: forall x. ErrorStyle -> Rep ErrorStyle x
Generic)
instance NFData ErrorStyle

-- See 18.3.1.32 "dataValidation (Data Validation)" (p. 1614/1624)
data DataValidation = DataValidation
    { DataValidation -> Bool
_dvAllowBlank       :: Bool
    , DataValidation -> Maybe Text
_dvError            :: Maybe Text
    , DataValidation -> ErrorStyle
_dvErrorStyle       :: ErrorStyle
    , DataValidation -> Maybe Text
_dvErrorTitle       :: Maybe Text
    , DataValidation -> Maybe Text
_dvPrompt           :: Maybe Text
    , DataValidation -> Maybe Text
_dvPromptTitle      :: Maybe Text
    , DataValidation -> Bool
_dvShowDropDown     :: Bool
    , DataValidation -> Bool
_dvShowErrorMessage :: Bool
    , DataValidation -> Bool
_dvShowInputMessage :: Bool
    , DataValidation -> ValidationType
_dvValidationType   :: ValidationType
    } deriving (DataValidation -> DataValidation -> Bool
(DataValidation -> DataValidation -> Bool)
-> (DataValidation -> DataValidation -> Bool) -> Eq DataValidation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataValidation -> DataValidation -> Bool
$c/= :: DataValidation -> DataValidation -> Bool
== :: DataValidation -> DataValidation -> Bool
$c== :: DataValidation -> DataValidation -> Bool
Eq, Int -> DataValidation -> ShowS
[DataValidation] -> ShowS
DataValidation -> String
(Int -> DataValidation -> ShowS)
-> (DataValidation -> String)
-> ([DataValidation] -> ShowS)
-> Show DataValidation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataValidation] -> ShowS
$cshowList :: [DataValidation] -> ShowS
show :: DataValidation -> String
$cshow :: DataValidation -> String
showsPrec :: Int -> DataValidation -> ShowS
$cshowsPrec :: Int -> DataValidation -> ShowS
Show, (forall x. DataValidation -> Rep DataValidation x)
-> (forall x. Rep DataValidation x -> DataValidation)
-> Generic DataValidation
forall x. Rep DataValidation x -> DataValidation
forall x. DataValidation -> Rep DataValidation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DataValidation x -> DataValidation
$cfrom :: forall x. DataValidation -> Rep DataValidation x
Generic)
instance NFData DataValidation

makeLenses ''DataValidation

instance Default DataValidation where
    def :: DataValidation
def = Bool
-> Maybe Text
-> ErrorStyle
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Bool
-> Bool
-> Bool
-> ValidationType
-> DataValidation
DataValidation
      Bool
False Maybe Text
forall a. Maybe a
Nothing ErrorStyle
ErrorStyleStop Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Bool
False Bool
False Bool
False ValidationType
ValidationTypeNone

{-------------------------------------------------------------------------------
  Parsing
-------------------------------------------------------------------------------}

instance FromAttrVal ErrorStyle where
    fromAttrVal :: Reader ErrorStyle
fromAttrVal Text
"information" = ErrorStyle -> Either String (ErrorStyle, Text)
forall a. a -> Either String (a, Text)
readSuccess ErrorStyle
ErrorStyleInformation
    fromAttrVal Text
"stop"        = ErrorStyle -> Either String (ErrorStyle, Text)
forall a. a -> Either String (a, Text)
readSuccess ErrorStyle
ErrorStyleStop
    fromAttrVal Text
"warning"     = ErrorStyle -> Either String (ErrorStyle, Text)
forall a. a -> Either String (a, Text)
readSuccess ErrorStyle
ErrorStyleWarning
    fromAttrVal Text
t             = Text -> Reader ErrorStyle
forall a. Text -> Text -> Either String (a, Text)
invalidText Text
"ErrorStyle" Text
t

instance FromAttrBs ErrorStyle where
    fromAttrBs :: ByteString -> Either Text ErrorStyle
fromAttrBs ByteString
"information" = ErrorStyle -> Either Text ErrorStyle
forall (m :: * -> *) a. Monad m => a -> m a
return ErrorStyle
ErrorStyleInformation
    fromAttrBs ByteString
"stop"        = ErrorStyle -> Either Text ErrorStyle
forall (m :: * -> *) a. Monad m => a -> m a
return ErrorStyle
ErrorStyleStop
    fromAttrBs ByteString
"warning"     = ErrorStyle -> Either Text ErrorStyle
forall (m :: * -> *) a. Monad m => a -> m a
return ErrorStyle
ErrorStyleWarning
    fromAttrBs ByteString
x             = Text -> ByteString -> Either Text ErrorStyle
forall a. Text -> ByteString -> Either Text a
unexpectedAttrBs Text
"ErrorStyle" ByteString
x

instance FromCursor DataValidation where
    fromCursor :: Cursor -> [DataValidation]
fromCursor Cursor
cur = do
        Bool
_dvAllowBlank       <- Name -> Bool -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"allowBlank"       Bool
False          Cursor
cur
        Maybe Text
_dvError            <- Name -> Cursor -> [Maybe Text]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute   Name
"error"                           Cursor
cur
        ErrorStyle
_dvErrorStyle       <- Name -> ErrorStyle -> Cursor -> [ErrorStyle]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"errorStyle"       ErrorStyle
ErrorStyleStop Cursor
cur
        Maybe Text
_dvErrorTitle       <- Name -> Cursor -> [Maybe Text]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute   Name
"errorTitle"                      Cursor
cur
        Text
mop                 <- Name -> Text -> Cursor -> [Text]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"operator"         Text
"between"      Cursor
cur
        Maybe Text
_dvPrompt           <- Name -> Cursor -> [Maybe Text]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute   Name
"prompt"                          Cursor
cur
        Maybe Text
_dvPromptTitle      <- Name -> Cursor -> [Maybe Text]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute   Name
"promptTitle"                     Cursor
cur
        Bool
_dvShowDropDown     <- Name -> Bool -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"showDropDown"     Bool
False          Cursor
cur
        Bool
_dvShowErrorMessage <- Name -> Bool -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"showErrorMessage" Bool
False          Cursor
cur
        Bool
_dvShowInputMessage <- Name -> Bool -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"showInputMessage" Bool
False          Cursor
cur
        Text
mtype               <- Name -> Text -> Cursor -> [Text]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"type"             Text
"none"         Cursor
cur
        ValidationType
_dvValidationType   <- Text -> Text -> Cursor -> [ValidationType]
readValidationType Text
mop Text
mtype                       Cursor
cur
        DataValidation -> [DataValidation]
forall (m :: * -> *) a. Monad m => a -> m a
return DataValidation :: Bool
-> Maybe Text
-> ErrorStyle
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Bool
-> Bool
-> Bool
-> ValidationType
-> DataValidation
DataValidation{Bool
Maybe Text
ErrorStyle
ValidationType
_dvValidationType :: ValidationType
_dvShowInputMessage :: Bool
_dvShowErrorMessage :: Bool
_dvShowDropDown :: Bool
_dvPromptTitle :: Maybe Text
_dvPrompt :: Maybe Text
_dvErrorTitle :: Maybe Text
_dvErrorStyle :: ErrorStyle
_dvError :: Maybe Text
_dvAllowBlank :: Bool
_dvValidationType :: ValidationType
_dvShowInputMessage :: Bool
_dvShowErrorMessage :: Bool
_dvShowDropDown :: Bool
_dvPromptTitle :: Maybe Text
_dvPrompt :: Maybe Text
_dvErrorTitle :: Maybe Text
_dvErrorStyle :: ErrorStyle
_dvError :: Maybe Text
_dvAllowBlank :: Bool
..}

instance FromXenoNode DataValidation where
  fromXenoNode :: Node -> Either Text DataValidation
fromXenoNode Node
root = do
    (ByteString
op, ByteString
atype, ValidationType -> DataValidation
genDV) <- Node
-> AttrParser
     (ByteString, ByteString, ValidationType -> DataValidation)
-> Either
     Text (ByteString, ByteString, ValidationType -> DataValidation)
forall a. Node -> AttrParser a -> Either Text a
parseAttributes Node
root (AttrParser
   (ByteString, ByteString, ValidationType -> DataValidation)
 -> Either
      Text (ByteString, ByteString, ValidationType -> DataValidation))
-> AttrParser
     (ByteString, ByteString, ValidationType -> DataValidation)
-> Either
     Text (ByteString, ByteString, ValidationType -> DataValidation)
forall a b. (a -> b) -> a -> b
$ do
      Bool
_dvAllowBlank <- ByteString -> Bool -> AttrParser Bool
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"allowBlank" Bool
False
      Maybe Text
_dvError <- ByteString -> AttrParser (Maybe Text)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"error"
      ErrorStyle
_dvErrorStyle <- ByteString -> ErrorStyle -> AttrParser ErrorStyle
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"errorStyle" ErrorStyle
ErrorStyleStop
      Maybe Text
_dvErrorTitle <- ByteString -> AttrParser (Maybe Text)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"errorTitle"
      Maybe Text
_dvPrompt <- ByteString -> AttrParser (Maybe Text)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"prompt"
      Maybe Text
_dvPromptTitle <- ByteString -> AttrParser (Maybe Text)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"promptTitle"
      Bool
_dvShowDropDown <- ByteString -> Bool -> AttrParser Bool
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"showDropDown" Bool
False
      Bool
_dvShowErrorMessage <- ByteString -> Bool -> AttrParser Bool
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"showErrorMessage" Bool
False
      Bool
_dvShowInputMessage <- ByteString -> Bool -> AttrParser Bool
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"showInputMessage" Bool
False
      ByteString
op <- ByteString -> ByteString -> AttrParser ByteString
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"operator" ByteString
"between"
      ByteString
typ <- ByteString -> ByteString -> AttrParser ByteString
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"type" ByteString
"none"
      (ByteString, ByteString, ValidationType -> DataValidation)
-> AttrParser
     (ByteString, ByteString, ValidationType -> DataValidation)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
op, ByteString
typ, \ValidationType
_dvValidationType -> DataValidation :: Bool
-> Maybe Text
-> ErrorStyle
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Bool
-> Bool
-> Bool
-> ValidationType
-> DataValidation
DataValidation {Bool
Maybe Text
ErrorStyle
ValidationType
_dvValidationType :: ValidationType
_dvShowInputMessage :: Bool
_dvShowErrorMessage :: Bool
_dvShowDropDown :: Bool
_dvPromptTitle :: Maybe Text
_dvPrompt :: Maybe Text
_dvErrorTitle :: Maybe Text
_dvErrorStyle :: ErrorStyle
_dvError :: Maybe Text
_dvAllowBlank :: Bool
_dvValidationType :: ValidationType
_dvShowInputMessage :: Bool
_dvShowErrorMessage :: Bool
_dvShowDropDown :: Bool
_dvPromptTitle :: Maybe Text
_dvPrompt :: Maybe Text
_dvErrorTitle :: Maybe Text
_dvErrorStyle :: ErrorStyle
_dvError :: Maybe Text
_dvAllowBlank :: Bool
..})
    ValidationType
valType <- ByteString -> ByteString -> Either Text ValidationType
parseValidationType ByteString
op ByteString
atype
    DataValidation -> Either Text DataValidation
forall (m :: * -> *) a. Monad m => a -> m a
return (DataValidation -> Either Text DataValidation)
-> DataValidation -> Either Text DataValidation
forall a b. (a -> b) -> a -> b
$ ValidationType -> DataValidation
genDV ValidationType
valType
    where
      parseValidationType :: ByteString -> ByteString -> Either Text ValidationType
      parseValidationType :: ByteString -> ByteString -> Either Text ValidationType
parseValidationType ByteString
op ByteString
atype =
        case ByteString
atype of
          ByteString
"none" -> ValidationType -> Either Text ValidationType
forall (m :: * -> *) a. Monad m => a -> m a
return ValidationType
ValidationTypeNone
          ByteString
"custom" ->
            Formula -> ValidationType
ValidationTypeCustom (Formula -> ValidationType)
-> Either Text Formula -> Either Text ValidationType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Text Formula
formula1
          ByteString
"list" -> do
            Formula
f <- Either Text Formula
formula1
            case Formula -> Maybe [Text]
readListFormulas Formula
f of
              Maybe [Text]
Nothing -> Text -> Either Text ValidationType
forall a b. a -> Either a b
Left Text
"validation of type \"list\" with empty formula list"
              Just [Text]
fs -> ValidationType -> Either Text ValidationType
forall (m :: * -> *) a. Monad m => a -> m a
return (ValidationType -> Either Text ValidationType)
-> ValidationType -> Either Text ValidationType
forall a b. (a -> b) -> a -> b
$ [Text] -> ValidationType
ValidationTypeList [Text]
fs
          ByteString
"date" ->
            ValidationExpression -> ValidationType
ValidationTypeDate (ValidationExpression -> ValidationType)
-> Either Text ValidationExpression -> Either Text ValidationType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either Text ValidationExpression
forall a.
(Eq a, IsString a, Show a) =>
a -> Either Text ValidationExpression
readOpExpression ByteString
op
          ByteString
"decimal"    ->
            ValidationExpression -> ValidationType
ValidationTypeDecimal (ValidationExpression -> ValidationType)
-> Either Text ValidationExpression -> Either Text ValidationType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either Text ValidationExpression
forall a.
(Eq a, IsString a, Show a) =>
a -> Either Text ValidationExpression
readOpExpression ByteString
op
          ByteString
"textLength" ->
            ValidationExpression -> ValidationType
ValidationTypeTextLength (ValidationExpression -> ValidationType)
-> Either Text ValidationExpression -> Either Text ValidationType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either Text ValidationExpression
forall a.
(Eq a, IsString a, Show a) =>
a -> Either Text ValidationExpression
readOpExpression ByteString
op
          ByteString
"time"       ->
            ValidationExpression -> ValidationType
ValidationTypeTime (ValidationExpression -> ValidationType)
-> Either Text ValidationExpression -> Either Text ValidationType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either Text ValidationExpression
forall a.
(Eq a, IsString a, Show a) =>
a -> Either Text ValidationExpression
readOpExpression ByteString
op
          ByteString
"whole"      ->
            ValidationExpression -> ValidationType
ValidationTypeWhole (ValidationExpression -> ValidationType)
-> Either Text ValidationExpression -> Either Text ValidationType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either Text ValidationExpression
forall a.
(Eq a, IsString a, Show a) =>
a -> Either Text ValidationExpression
readOpExpression ByteString
op
          ByteString
unexpected ->
            Text -> Either Text ValidationType
forall a b. a -> Either a b
Left (Text -> Either Text ValidationType)
-> Text -> Either Text ValidationType
forall a b. (a -> b) -> a -> b
$ Text
"unexpected type of data validation " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (ByteString -> String
forall a. Show a => a -> String
show ByteString
unexpected)
      readOpExpression :: a -> Either Text ValidationExpression
readOpExpression a
"between" = (Formula -> Formula -> ValidationExpression)
-> (Formula, Formula) -> ValidationExpression
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Formula -> Formula -> ValidationExpression
ValBetween ((Formula, Formula) -> ValidationExpression)
-> Either Text (Formula, Formula)
-> Either Text ValidationExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Text (Formula, Formula)
formulaPair
      readOpExpression a
"notBetween" = (Formula -> Formula -> ValidationExpression)
-> (Formula, Formula) -> ValidationExpression
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Formula -> Formula -> ValidationExpression
ValNotBetween ((Formula, Formula) -> ValidationExpression)
-> Either Text (Formula, Formula)
-> Either Text ValidationExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Text (Formula, Formula)
formulaPair
      readOpExpression a
"equal" = Formula -> ValidationExpression
ValEqual (Formula -> ValidationExpression)
-> Either Text Formula -> Either Text ValidationExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Text Formula
formula1
      readOpExpression a
"greaterThan" = Formula -> ValidationExpression
ValGreaterThan (Formula -> ValidationExpression)
-> Either Text Formula -> Either Text ValidationExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Text Formula
formula1
      readOpExpression a
"greaterThanOrEqual" = Formula -> ValidationExpression
ValGreaterThanOrEqual (Formula -> ValidationExpression)
-> Either Text Formula -> Either Text ValidationExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Text Formula
formula1
      readOpExpression a
"lessThan" = Formula -> ValidationExpression
ValLessThan (Formula -> ValidationExpression)
-> Either Text Formula -> Either Text ValidationExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Text Formula
formula1
      readOpExpression a
"lessThanOrEqual" = Formula -> ValidationExpression
ValLessThanOrEqual (Formula -> ValidationExpression)
-> Either Text Formula -> Either Text ValidationExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Text Formula
formula1
      readOpExpression a
"notEqual" = Formula -> ValidationExpression
ValNotEqual (Formula -> ValidationExpression)
-> Either Text Formula -> Either Text ValidationExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Text Formula
formula1
      readOpExpression a
op = Text -> Either Text ValidationExpression
forall a b. a -> Either a b
Left (Text -> Either Text ValidationExpression)
-> Text -> Either Text ValidationExpression
forall a b. (a -> b) -> a -> b
$ Text
"data validation, unexpected operator " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (a -> String
forall a. Show a => a -> String
show a
op)
      formula1 :: Either Text Formula
formula1 = Node -> ChildCollector Formula -> Either Text Formula
forall a. Node -> ChildCollector a -> Either Text a
collectChildren Node
root (ChildCollector Formula -> Either Text Formula)
-> ChildCollector Formula -> Either Text Formula
forall a b. (a -> b) -> a -> b
$ ByteString -> ChildCollector Formula
forall a. FromXenoNode a => ByteString -> ChildCollector a
fromChild ByteString
"formula1"
      formulaPair :: Either Text (Formula, Formula)
formulaPair =
        Node
-> ChildCollector (Formula, Formula)
-> Either Text (Formula, Formula)
forall a. Node -> ChildCollector a -> Either Text a
collectChildren Node
root (ChildCollector (Formula, Formula)
 -> Either Text (Formula, Formula))
-> ChildCollector (Formula, Formula)
-> Either Text (Formula, Formula)
forall a b. (a -> b) -> a -> b
$ (,) (Formula -> Formula -> (Formula, Formula))
-> ChildCollector Formula
-> ChildCollector (Formula -> (Formula, Formula))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> ChildCollector Formula
forall a. FromXenoNode a => ByteString -> ChildCollector a
fromChild ByteString
"formula1" ChildCollector (Formula -> (Formula, Formula))
-> ChildCollector Formula -> ChildCollector (Formula, Formula)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> ChildCollector Formula
forall a. FromXenoNode a => ByteString -> ChildCollector a
fromChild ByteString
"formula2"

readValidationType :: Text -> Text -> Cursor -> [ValidationType]
readValidationType :: Text -> Text -> Cursor -> [ValidationType]
readValidationType Text
_ Text
"none"   Cursor
_   = ValidationType -> [ValidationType]
forall (m :: * -> *) a. Monad m => a -> m a
return ValidationType
ValidationTypeNone
readValidationType Text
_ Text
"custom" Cursor
cur = do
    Formula
f <- Cursor -> [Formula]
forall a. FromCursor a => Cursor -> [a]
fromCursor Cursor
cur
    ValidationType -> [ValidationType]
forall (m :: * -> *) a. Monad m => a -> m a
return (ValidationType -> [ValidationType])
-> ValidationType -> [ValidationType]
forall a b. (a -> b) -> a -> b
$ Formula -> ValidationType
ValidationTypeCustom Formula
f
readValidationType Text
_ Text
"list" Cursor
cur = do
    Formula
f  <- Cursor
cur Cursor -> (Cursor -> [Formula]) -> [Formula]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"formula1") Axis -> (Cursor -> [Formula]) -> Cursor -> [Formula]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [Formula]
forall a. FromCursor a => Cursor -> [a]
fromCursor
    [Text]
as <- Maybe [Text] -> [[Text]]
forall a. Maybe a -> [a]
maybeToList (Maybe [Text] -> [[Text]]) -> Maybe [Text] -> [[Text]]
forall a b. (a -> b) -> a -> b
$ Formula -> Maybe [Text]
readListFormulas Formula
f
    ValidationType -> [ValidationType]
forall (m :: * -> *) a. Monad m => a -> m a
return (ValidationType -> [ValidationType])
-> ValidationType -> [ValidationType]
forall a b. (a -> b) -> a -> b
$ [Text] -> ValidationType
ValidationTypeList [Text]
as
readValidationType Text
op Text
ty Cursor
cur = do
    ValidationExpression
opExp <- Text -> Cursor -> [ValidationExpression]
readOpExpression2 Text
op Cursor
cur
    Text -> ValidationExpression -> [ValidationType]
readValidationTypeOpExp Text
ty ValidationExpression
opExp

readListFormulas :: Formula -> Maybe [Text]
readListFormulas :: Formula -> Maybe [Text]
readListFormulas (Formula Text
f) = Text -> Maybe [Text]
readQuotedList Text
f
  where
    readQuotedList :: Text -> Maybe [Text]
readQuotedList Text
t
        | Just Text
t'  <- Text -> Text -> Maybe Text
T.stripPrefix Text
"\"" ((Char -> Bool) -> Text -> Text
T.dropAround Char -> Bool
isSpace Text
t)
        , Just Text
t'' <- Text -> Text -> Maybe Text
T.stripSuffix Text
"\"" Text
t'
        = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just ([Text] -> Maybe [Text]) -> [Text] -> Maybe [Text]
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> Text -> Text
T.dropAround Char -> Bool
isSpace) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
T.splitOn Text
"," Text
t''
        | Bool
otherwise = Maybe [Text]
forall a. Maybe a
Nothing
  -- This parser expects a comma-separated list surrounded by quotation marks.
  -- Spaces around the quotation marks and commas are removed, but inner spaces
  -- are kept.
  --
  -- The parser seems to be consistent with how Excel treats list formulas, but
  -- I wasn't able to find a specification of the format.

readOpExpression2 :: Text -> Cursor -> [ValidationExpression]
readOpExpression2 :: Text -> Cursor -> [ValidationExpression]
readOpExpression2 Text
op Cursor
cur
    | Text
op Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"between", Text
"notBetween"] = do
        Formula
f1 <- Cursor
cur Cursor -> (Cursor -> [Formula]) -> [Formula]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"formula1") Axis -> (Cursor -> [Formula]) -> Cursor -> [Formula]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [Formula]
forall a. FromCursor a => Cursor -> [a]
fromCursor
        Formula
f2 <- Cursor
cur Cursor -> (Cursor -> [Formula]) -> [Formula]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"formula2") Axis -> (Cursor -> [Formula]) -> Cursor -> [Formula]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [Formula]
forall a. FromCursor a => Cursor -> [a]
fromCursor
        Text -> [Formula] -> [ValidationExpression]
readValExpression Text
op [Formula
f1,Formula
f2]
readOpExpression2 Text
op Cursor
cur = do
    Formula
f <- Cursor
cur Cursor -> (Cursor -> [Formula]) -> [Formula]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"formula1") Axis -> (Cursor -> [Formula]) -> Cursor -> [Formula]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [Formula]
forall a. FromCursor a => Cursor -> [a]
fromCursor
    Text -> [Formula] -> [ValidationExpression]
readValExpression Text
op [Formula
f]

readValidationTypeOpExp :: Text -> ValidationExpression -> [ValidationType]
readValidationTypeOpExp :: Text -> ValidationExpression -> [ValidationType]
readValidationTypeOpExp Text
"date"       ValidationExpression
oe = [ValidationExpression -> ValidationType
ValidationTypeDate       ValidationExpression
oe]
readValidationTypeOpExp Text
"decimal"    ValidationExpression
oe = [ValidationExpression -> ValidationType
ValidationTypeDecimal    ValidationExpression
oe]
readValidationTypeOpExp Text
"textLength" ValidationExpression
oe = [ValidationExpression -> ValidationType
ValidationTypeTextLength ValidationExpression
oe]
readValidationTypeOpExp Text
"time"       ValidationExpression
oe = [ValidationExpression -> ValidationType
ValidationTypeTime       ValidationExpression
oe]
readValidationTypeOpExp Text
"whole"      ValidationExpression
oe = [ValidationExpression -> ValidationType
ValidationTypeWhole      ValidationExpression
oe]
readValidationTypeOpExp Text
_ ValidationExpression
_             = []

readValExpression :: Text -> [Formula] -> [ValidationExpression]
readValExpression :: Text -> [Formula] -> [ValidationExpression]
readValExpression Text
"between" [Formula
f1, Formula
f2]       = [Formula -> Formula -> ValidationExpression
ValBetween Formula
f1 Formula
f2]
readValExpression Text
"equal" [Formula
f]              = [Formula -> ValidationExpression
ValEqual Formula
f]
readValExpression Text
"greaterThan" [Formula
f]        = [Formula -> ValidationExpression
ValGreaterThan Formula
f]
readValExpression Text
"greaterThanOrEqual" [Formula
f] = [Formula -> ValidationExpression
ValGreaterThanOrEqual Formula
f]
readValExpression Text
"lessThan" [Formula
f]           = [Formula -> ValidationExpression
ValLessThan Formula
f]
readValExpression Text
"lessThanOrEqual" [Formula
f]    = [Formula -> ValidationExpression
ValLessThanOrEqual Formula
f]
readValExpression Text
"notBetween" [Formula
f1, Formula
f2]    = [Formula -> Formula -> ValidationExpression
ValNotBetween Formula
f1 Formula
f2]
readValExpression Text
"notEqual" [Formula
f]           = [Formula -> ValidationExpression
ValNotEqual Formula
f]
readValExpression Text
_ [Formula]
_                      = []

{-------------------------------------------------------------------------------
  Rendering
-------------------------------------------------------------------------------}

instance ToAttrVal ValidationType where
    toAttrVal :: ValidationType -> Text
toAttrVal ValidationType
ValidationTypeNone           = Text
"none"
    toAttrVal (ValidationTypeCustom Formula
_)     = Text
"custom"
    toAttrVal (ValidationTypeDate ValidationExpression
_)       = Text
"date"
    toAttrVal (ValidationTypeDecimal ValidationExpression
_)    = Text
"decimal"
    toAttrVal (ValidationTypeList [Text]
_)       = Text
"list"
    toAttrVal (ValidationTypeTextLength ValidationExpression
_) = Text
"textLength"
    toAttrVal (ValidationTypeTime ValidationExpression
_)       = Text
"time"
    toAttrVal (ValidationTypeWhole ValidationExpression
_)      = Text
"whole"

instance ToAttrVal ErrorStyle where
    toAttrVal :: ErrorStyle -> Text
toAttrVal ErrorStyle
ErrorStyleInformation = Text
"information"
    toAttrVal ErrorStyle
ErrorStyleStop        = Text
"stop"
    toAttrVal ErrorStyle
ErrorStyleWarning     = Text
"warning"

instance ToElement DataValidation where
    toElement :: Name -> DataValidation -> Element
toElement Name
nm DataValidation{Bool
Maybe Text
ErrorStyle
ValidationType
_dvValidationType :: ValidationType
_dvShowInputMessage :: Bool
_dvShowErrorMessage :: Bool
_dvShowDropDown :: Bool
_dvPromptTitle :: Maybe Text
_dvPrompt :: Maybe Text
_dvErrorTitle :: Maybe Text
_dvErrorStyle :: ErrorStyle
_dvError :: Maybe Text
_dvAllowBlank :: Bool
_dvValidationType :: DataValidation -> ValidationType
_dvShowInputMessage :: DataValidation -> Bool
_dvShowErrorMessage :: DataValidation -> Bool
_dvShowDropDown :: DataValidation -> Bool
_dvPromptTitle :: DataValidation -> Maybe Text
_dvPrompt :: DataValidation -> Maybe Text
_dvErrorTitle :: DataValidation -> Maybe Text
_dvErrorStyle :: DataValidation -> ErrorStyle
_dvError :: DataValidation -> Maybe Text
_dvAllowBlank :: DataValidation -> Bool
..} = Element :: Name -> Map Name Text -> [Node] -> Element
Element
        { elementName :: Name
elementName       = Name
nm
        , elementAttributes :: Map Name Text
elementAttributes = [(Name, Text)] -> Map Name Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, Text)] -> Map Name Text)
-> ([Maybe (Name, Text)] -> [(Name, Text)])
-> [Maybe (Name, Text)]
-> Map Name Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Name, Text)] -> [(Name, Text)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Name, Text)] -> Map Name Text)
-> [Maybe (Name, Text)] -> Map Name Text
forall a b. (a -> b) -> a -> b
$
            [ (Name, Text) -> Maybe (Name, Text)
forall a. a -> Maybe a
Just ((Name, Text) -> Maybe (Name, Text))
-> (Name, Text) -> Maybe (Name, Text)
forall a b. (a -> b) -> a -> b
$ Name
"allowBlank"       Name -> Bool -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.=  Bool
_dvAllowBlank
            ,        Name
"error"            Name -> Maybe Text -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Text
_dvError
            , (Name, Text) -> Maybe (Name, Text)
forall a. a -> Maybe a
Just ((Name, Text) -> Maybe (Name, Text))
-> (Name, Text) -> Maybe (Name, Text)
forall a b. (a -> b) -> a -> b
$ Name
"errorStyle"       Name -> ErrorStyle -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.=  ErrorStyle
_dvErrorStyle
            ,        Name
"errorTitle"       Name -> Maybe Text -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Text
_dvErrorTitle
            ,        Name
"operator"         Name -> Maybe Text -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Text
op
            ,        Name
"prompt"           Name -> Maybe Text -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Text
_dvPrompt
            ,        Name
"promptTitle"      Name -> Maybe Text -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Text
_dvPromptTitle
            , (Name, Text) -> Maybe (Name, Text)
forall a. a -> Maybe a
Just ((Name, Text) -> Maybe (Name, Text))
-> (Name, Text) -> Maybe (Name, Text)
forall a b. (a -> b) -> a -> b
$ Name
"showDropDown"     Name -> Bool -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.=  Bool
_dvShowDropDown
            , (Name, Text) -> Maybe (Name, Text)
forall a. a -> Maybe a
Just ((Name, Text) -> Maybe (Name, Text))
-> (Name, Text) -> Maybe (Name, Text)
forall a b. (a -> b) -> a -> b
$ Name
"showErrorMessage" Name -> Bool -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.=  Bool
_dvShowErrorMessage
            , (Name, Text) -> Maybe (Name, Text)
forall a. a -> Maybe a
Just ((Name, Text) -> Maybe (Name, Text))
-> (Name, Text) -> Maybe (Name, Text)
forall a b. (a -> b) -> a -> b
$ Name
"showInputMessage" Name -> Bool -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.=  Bool
_dvShowInputMessage
            , (Name, Text) -> Maybe (Name, Text)
forall a. a -> Maybe a
Just ((Name, Text) -> Maybe (Name, Text))
-> (Name, Text) -> Maybe (Name, Text)
forall a b. (a -> b) -> a -> b
$ Name
"type"             Name -> ValidationType -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.=  ValidationType
_dvValidationType
            ]
        , elementNodes :: [Node]
elementNodes      = [Maybe Node] -> [Node]
forall a. [Maybe a] -> [a]
catMaybes
            [ (Formula -> Node) -> Maybe Formula -> Maybe Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Element -> Node
NodeElement (Element -> Node) -> (Formula -> Element) -> Formula -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Formula -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"formula1") Maybe Formula
f1
            , (Formula -> Node) -> Maybe Formula -> Maybe Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Element -> Node
NodeElement (Element -> Node) -> (Formula -> Element) -> Formula -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Formula -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"formula2") Maybe Formula
f2
            ]
        }
      where
        opExp :: (a, a, c) -> (Maybe a, Maybe a, c)
opExp (a
o,a
f1',c
f2') = (a -> Maybe a
forall a. a -> Maybe a
Just a
o, a -> Maybe a
forall a. a -> Maybe a
Just a
f1', c
f2')

        op    :: Maybe Text
        f1,f2 :: Maybe Formula
        (Maybe Text
op,Maybe Formula
f1,Maybe Formula
f2) = case ValidationType
_dvValidationType of
          ValidationType
ValidationTypeNone         -> (Maybe Text
forall a. Maybe a
Nothing, Maybe Formula
forall a. Maybe a
Nothing, Maybe Formula
forall a. Maybe a
Nothing)
          ValidationTypeCustom Formula
f     -> (Maybe Text
forall a. Maybe a
Nothing, Formula -> Maybe Formula
forall a. a -> Maybe a
Just Formula
f, Maybe Formula
forall a. Maybe a
Nothing)
          ValidationTypeDate ValidationExpression
f       -> (Text, Formula, Maybe Formula)
-> (Maybe Text, Maybe Formula, Maybe Formula)
forall a a c. (a, a, c) -> (Maybe a, Maybe a, c)
opExp ((Text, Formula, Maybe Formula)
 -> (Maybe Text, Maybe Formula, Maybe Formula))
-> (Text, Formula, Maybe Formula)
-> (Maybe Text, Maybe Formula, Maybe Formula)
forall a b. (a -> b) -> a -> b
$ ValidationExpression -> (Text, Formula, Maybe Formula)
viewValidationExpression ValidationExpression
f
          ValidationTypeDecimal ValidationExpression
f    -> (Text, Formula, Maybe Formula)
-> (Maybe Text, Maybe Formula, Maybe Formula)
forall a a c. (a, a, c) -> (Maybe a, Maybe a, c)
opExp ((Text, Formula, Maybe Formula)
 -> (Maybe Text, Maybe Formula, Maybe Formula))
-> (Text, Formula, Maybe Formula)
-> (Maybe Text, Maybe Formula, Maybe Formula)
forall a b. (a -> b) -> a -> b
$ ValidationExpression -> (Text, Formula, Maybe Formula)
viewValidationExpression ValidationExpression
f
          ValidationTypeTextLength ValidationExpression
f -> (Text, Formula, Maybe Formula)
-> (Maybe Text, Maybe Formula, Maybe Formula)
forall a a c. (a, a, c) -> (Maybe a, Maybe a, c)
opExp ((Text, Formula, Maybe Formula)
 -> (Maybe Text, Maybe Formula, Maybe Formula))
-> (Text, Formula, Maybe Formula)
-> (Maybe Text, Maybe Formula, Maybe Formula)
forall a b. (a -> b) -> a -> b
$ ValidationExpression -> (Text, Formula, Maybe Formula)
viewValidationExpression ValidationExpression
f
          ValidationTypeTime ValidationExpression
f       -> (Text, Formula, Maybe Formula)
-> (Maybe Text, Maybe Formula, Maybe Formula)
forall a a c. (a, a, c) -> (Maybe a, Maybe a, c)
opExp ((Text, Formula, Maybe Formula)
 -> (Maybe Text, Maybe Formula, Maybe Formula))
-> (Text, Formula, Maybe Formula)
-> (Maybe Text, Maybe Formula, Maybe Formula)
forall a b. (a -> b) -> a -> b
$ ValidationExpression -> (Text, Formula, Maybe Formula)
viewValidationExpression ValidationExpression
f
          ValidationTypeWhole ValidationExpression
f      -> (Text, Formula, Maybe Formula)
-> (Maybe Text, Maybe Formula, Maybe Formula)
forall a a c. (a, a, c) -> (Maybe a, Maybe a, c)
opExp ((Text, Formula, Maybe Formula)
 -> (Maybe Text, Maybe Formula, Maybe Formula))
-> (Text, Formula, Maybe Formula)
-> (Maybe Text, Maybe Formula, Maybe Formula)
forall a b. (a -> b) -> a -> b
$ ValidationExpression -> (Text, Formula, Maybe Formula)
viewValidationExpression ValidationExpression
f
          ValidationTypeList [Text]
as      ->
            let f :: Formula
f = Text -> Formula
Formula (Text -> Formula) -> Text -> Formula
forall a b. (a -> b) -> a -> b
$ Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"," [Text]
as Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
            in  (Maybe Text
forall a. Maybe a
Nothing, Formula -> Maybe Formula
forall a. a -> Maybe a
Just Formula
f, Maybe Formula
forall a. Maybe a
Nothing)

viewValidationExpression :: ValidationExpression -> (Text, Formula, Maybe Formula)
viewValidationExpression :: ValidationExpression -> (Text, Formula, Maybe Formula)
viewValidationExpression (ValBetween Formula
f1 Formula
f2)         = (Text
"between",            Formula
f1, Formula -> Maybe Formula
forall a. a -> Maybe a
Just Formula
f2)
viewValidationExpression (ValEqual Formula
f)               = (Text
"equal",              Formula
f,  Maybe Formula
forall a. Maybe a
Nothing)
viewValidationExpression (ValGreaterThan Formula
f)         = (Text
"greaterThan",        Formula
f,  Maybe Formula
forall a. Maybe a
Nothing)
viewValidationExpression (ValGreaterThanOrEqual Formula
f)  = (Text
"greaterThanOrEqual", Formula
f,  Maybe Formula
forall a. Maybe a
Nothing)
viewValidationExpression (ValLessThan Formula
f)            = (Text
"lessThan",           Formula
f,  Maybe Formula
forall a. Maybe a
Nothing)
viewValidationExpression (ValLessThanOrEqual Formula
f)     = (Text
"lessThanOrEqual",    Formula
f,  Maybe Formula
forall a. Maybe a
Nothing)
viewValidationExpression (ValNotBetween Formula
f1 Formula
f2)      = (Text
"notBetween",         Formula
f1, Formula -> Maybe Formula
forall a. a -> Maybe a
Just Formula
f2)
viewValidationExpression (ValNotEqual Formula
f)            = (Text
"notEqual",           Formula
f,  Maybe Formula
forall a. Maybe a
Nothing)