{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
module Codec.Xlsx.Types.DataValidation
  ( ValidationExpression(..)
    , ValidationType(..)
    , dvAllowBlank
    , dvError
    , dvErrorStyle
    , dvErrorTitle
    , dvPrompt
    , dvPromptTitle
    , dvShowDropDown
    , dvShowErrorMessage
    , dvShowInputMessage
    , dvValidationType
    , ErrorStyle(..)
    , DataValidation(..)
    , ListOrRangeExpression(..)
    , ValidationList
    , maybePlainValidationList
    , maybeValidationRange
    , readValidationType
    , readListFormulas
    , readOpExpression2
    , readValidationTypeOpExp
    , readValExpression
    , viewValidationExpression
  ) where

import Control.Applicative ((<|>))
import Control.DeepSeq (NFData)
#ifdef USE_MICROLENS
import Lens.Micro.TH (makeLenses)
#else
import Control.Lens.TH (makeLenses)
#endif
import Control.Monad ((>=>), guard)
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
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
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. 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       ListOrRangeExpression
    | ValidationTypeTextLength ValidationExpression
    | ValidationTypeTime       ValidationExpression
    | ValidationTypeWhole      ValidationExpression
    deriving (ValidationType -> ValidationType -> Bool
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
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. 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

type ValidationList = [Text]

data ListOrRangeExpression
  = ListExpression ValidationList -- ^ a plain list of elements
  | RangeExpression Range -- ^ a cell or range reference
  deriving (ListOrRangeExpression -> ListOrRangeExpression -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListOrRangeExpression -> ListOrRangeExpression -> Bool
$c/= :: ListOrRangeExpression -> ListOrRangeExpression -> Bool
== :: ListOrRangeExpression -> ListOrRangeExpression -> Bool
$c== :: ListOrRangeExpression -> ListOrRangeExpression -> Bool
Eq, Int -> ListOrRangeExpression -> ShowS
[ListOrRangeExpression] -> ShowS
ListOrRangeExpression -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListOrRangeExpression] -> ShowS
$cshowList :: [ListOrRangeExpression] -> ShowS
show :: ListOrRangeExpression -> String
$cshow :: ListOrRangeExpression -> String
showsPrec :: Int -> ListOrRangeExpression -> ShowS
$cshowsPrec :: Int -> ListOrRangeExpression -> ShowS
Show, forall x. Rep ListOrRangeExpression x -> ListOrRangeExpression
forall x. ListOrRangeExpression -> Rep ListOrRangeExpression x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListOrRangeExpression x -> ListOrRangeExpression
$cfrom :: forall x. ListOrRangeExpression -> Rep ListOrRangeExpression x
Generic)
instance NFData ListOrRangeExpression

-- See 18.18.18 "ST_DataValidationErrorStyle (Data Validation Error Styles)" (p. 2438/2448)
data ErrorStyle
    = ErrorStyleInformation
    | ErrorStyleStop
    | ErrorStyleWarning
    deriving (ErrorStyle -> ErrorStyle -> Bool
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
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. 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
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
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. 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 forall a. Maybe a
Nothing ErrorStyle
ErrorStyleStop forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing Bool
False Bool
False Bool
False ValidationType
ValidationTypeNone

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

instance FromAttrVal ErrorStyle where
    fromAttrVal :: Reader ErrorStyle
fromAttrVal Text
"information" = forall a. a -> Either String (a, Text)
readSuccess ErrorStyle
ErrorStyleInformation
    fromAttrVal Text
"stop"        = forall a. a -> Either String (a, Text)
readSuccess ErrorStyle
ErrorStyleStop
    fromAttrVal Text
"warning"     = forall a. a -> Either String (a, Text)
readSuccess ErrorStyle
ErrorStyleWarning
    fromAttrVal Text
t             = 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" = forall (m :: * -> *) a. Monad m => a -> m a
return ErrorStyle
ErrorStyleInformation
    fromAttrBs ByteString
"stop"        = forall (m :: * -> *) a. Monad m => a -> m a
return ErrorStyle
ErrorStyleStop
    fromAttrBs ByteString
"warning"     = forall (m :: * -> *) a. Monad m => a -> m a
return ErrorStyle
ErrorStyleWarning
    fromAttrBs ByteString
x             = 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       <- forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"allowBlank"       Bool
False          Cursor
cur
        Maybe Text
_dvError            <- forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute   Name
"error"                           Cursor
cur
        ErrorStyle
_dvErrorStyle       <- forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"errorStyle"       ErrorStyle
ErrorStyleStop Cursor
cur
        Maybe Text
_dvErrorTitle       <- forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute   Name
"errorTitle"                      Cursor
cur
        Text
mop                 <- forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"operator"         Text
"between"      Cursor
cur
        Maybe Text
_dvPrompt           <- forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute   Name
"prompt"                          Cursor
cur
        Maybe Text
_dvPromptTitle      <- forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute   Name
"promptTitle"                     Cursor
cur
        Bool
_dvShowDropDown     <- forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"showDropDown"     Bool
False          Cursor
cur
        Bool
_dvShowErrorMessage <- forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"showErrorMessage" Bool
False          Cursor
cur
        Bool
_dvShowInputMessage <- forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"showInputMessage" Bool
False          Cursor
cur
        Text
mtype               <- 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
        forall (m :: * -> *) a. Monad m => a -> m a
return 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) <- forall a. Node -> AttrParser a -> Either Text a
parseAttributes Node
root forall a b. (a -> b) -> a -> b
$ do
      Bool
_dvAllowBlank <- forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"allowBlank" Bool
False
      Maybe Text
_dvError <- forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"error"
      ErrorStyle
_dvErrorStyle <- forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"errorStyle" ErrorStyle
ErrorStyleStop
      Maybe Text
_dvErrorTitle <- forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"errorTitle"
      Maybe Text
_dvPrompt <- forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"prompt"
      Maybe Text
_dvPromptTitle <- forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"promptTitle"
      Bool
_dvShowDropDown <- forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"showDropDown" Bool
False
      Bool
_dvShowErrorMessage <- forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"showErrorMessage" Bool
False
      Bool
_dvShowInputMessage <- forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"showInputMessage" Bool
False
      ByteString
op <- forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"operator" ByteString
"between"
      ByteString
typ <- forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"type" ByteString
"none"
      forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
op, ByteString
typ, \ValidationType
_dvValidationType -> 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
    forall (m :: * -> *) a. Monad m => a -> m a
return 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" -> forall (m :: * -> *) a. Monad m => a -> m a
return ValidationType
ValidationTypeNone
          ByteString
"custom" ->
            Formula -> ValidationType
ValidationTypeCustom 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 ListOrRangeExpression
readListFormulas Formula
f of
              Maybe ListOrRangeExpression
Nothing -> forall a b. a -> Either a b
Left Text
"validation of type \"list\" with empty formula list"
              Just ListOrRangeExpression
fs -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ListOrRangeExpression -> ValidationType
ValidationTypeList ListOrRangeExpression
fs
          ByteString
"date" ->
            ValidationExpression -> ValidationType
ValidationTypeDate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {a}.
(Eq a, IsString a, Show a) =>
a -> Either Text ValidationExpression
readOpExpression ByteString
op
          ByteString
"decimal"    ->
            ValidationExpression -> ValidationType
ValidationTypeDecimal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {a}.
(Eq a, IsString a, Show a) =>
a -> Either Text ValidationExpression
readOpExpression ByteString
op
          ByteString
"textLength" ->
            ValidationExpression -> ValidationType
ValidationTypeTextLength forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {a}.
(Eq a, IsString a, Show a) =>
a -> Either Text ValidationExpression
readOpExpression ByteString
op
          ByteString
"time"       ->
            ValidationExpression -> ValidationType
ValidationTypeTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {a}.
(Eq a, IsString a, Show a) =>
a -> Either Text ValidationExpression
readOpExpression ByteString
op
          ByteString
"whole"      ->
            ValidationExpression -> ValidationType
ValidationTypeWhole forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {a}.
(Eq a, IsString a, Show a) =>
a -> Either Text ValidationExpression
readOpExpression ByteString
op
          ByteString
unexpected ->
            forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"unexpected type of data validation " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show ByteString
unexpected)
      readOpExpression :: a -> Either Text ValidationExpression
readOpExpression a
"between" = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Formula -> Formula -> ValidationExpression
ValBetween forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Text (Formula, Formula)
formulaPair
      readOpExpression a
"notBetween" = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Formula -> Formula -> ValidationExpression
ValNotBetween forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Text (Formula, Formula)
formulaPair
      readOpExpression a
"equal" = Formula -> ValidationExpression
ValEqual forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Text Formula
formula1
      readOpExpression a
"greaterThan" = Formula -> ValidationExpression
ValGreaterThan forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Text Formula
formula1
      readOpExpression a
"greaterThanOrEqual" = Formula -> ValidationExpression
ValGreaterThanOrEqual forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Text Formula
formula1
      readOpExpression a
"lessThan" = Formula -> ValidationExpression
ValLessThan forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Text Formula
formula1
      readOpExpression a
"lessThanOrEqual" = Formula -> ValidationExpression
ValLessThanOrEqual forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Text Formula
formula1
      readOpExpression a
"notEqual" = Formula -> ValidationExpression
ValNotEqual forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Text Formula
formula1
      readOpExpression a
op = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"data validation, unexpected operator " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show a
op)
      formula1 :: Either Text Formula
formula1 = forall a. Node -> ChildCollector a -> Either Text a
collectChildren Node
root forall a b. (a -> b) -> a -> b
$ forall a. FromXenoNode a => ByteString -> ChildCollector a
fromChild ByteString
"formula1"
      formulaPair :: Either Text (Formula, Formula)
formulaPair =
        forall a. Node -> ChildCollector a -> Either Text a
collectChildren Node
root forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromXenoNode a => ByteString -> ChildCollector a
fromChild ByteString
"formula1" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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
_   = forall (m :: * -> *) a. Monad m => a -> m a
return ValidationType
ValidationTypeNone
readValidationType Text
_ Text
"custom" Cursor
cur = do
    Formula
f <- forall a. FromCursor a => Cursor -> [a]
fromCursor Cursor
cur
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Formula -> ValidationType
ValidationTypeCustom Formula
f
readValidationType Text
_ Text
"list" Cursor
cur = do
    Formula
f  <- Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"formula1") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. FromCursor a => Cursor -> [a]
fromCursor
    ListOrRangeExpression
as <- forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ Formula -> Maybe ListOrRangeExpression
readListFormulas Formula
f
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ListOrRangeExpression -> ValidationType
ValidationTypeList ListOrRangeExpression
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

-- | Attempt to obtain a plain list expression
maybePlainValidationList :: ValidationType -> Maybe ValidationList
maybePlainValidationList :: ValidationType -> Maybe ValidationList
maybePlainValidationList (ValidationTypeList (ListExpression ValidationList
le)) = forall a. a -> Maybe a
Just ValidationList
le
maybePlainValidationList ValidationType
_ = forall a. Maybe a
Nothing

-- | Attempt to obtain a range expression
maybeValidationRange :: ValidationType -> Maybe Range
maybeValidationRange :: ValidationType -> Maybe Range
maybeValidationRange (ValidationTypeList (RangeExpression Range
re)) = forall a. a -> Maybe a
Just Range
re
maybeValidationRange ValidationType
_ = forall a. Maybe a
Nothing

readListFormulas :: Formula -> Maybe ListOrRangeExpression
readListFormulas :: Formula -> Maybe ListOrRangeExpression
readListFormulas (Formula Text
f) = Text -> Maybe ListOrRangeExpression
readQuotedList Text
f forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {f :: * -> *}.
Alternative f =>
Text -> f ListOrRangeExpression
readUnquotedCellRange Text
f
  where
    readQuotedList :: Text -> Maybe ListOrRangeExpression
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'
        = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidationList -> ListOrRangeExpression
ListExpression forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> Text -> Text
T.dropAround Char -> Bool
isSpace) forall a b. (a -> b) -> a -> b
$ Text -> Text -> ValidationList
T.splitOn Text
"," Text
t''
        | Bool
otherwise = forall a. Maybe a
Nothing
    readUnquotedCellRange :: Text -> f ListOrRangeExpression
readUnquotedCellRange Text
t =
      -- a CellRef expression of a range (this is not validated beyond the absence of quotes)
      -- note that the foreign sheet name can be 'single-quoted'
      let stripped :: Text
stripped = (Char -> Bool) -> Text -> Text
T.dropAround Char -> Bool
isSpace Text
t
        in Range -> ListOrRangeExpression
RangeExpression (Text -> Range
CellRef Text
stripped) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Text -> Bool
T.null Text
stripped))
  -- 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.
  --
  -- Addendum: <dataValidation type="list" ...> undescriminately designates an actual list or a cell range.
  -- For a cell range validation, instead of a quoted list, it's an unquoted CellRef-like contents of the form:
  -- ActualSheetName!$C$2:$C$18

readOpExpression2 :: Text -> Cursor -> [ValidationExpression]
readOpExpression2 :: Text -> Cursor -> [ValidationExpression]
readOpExpression2 Text
op Cursor
cur
    | Text
op forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"between", Text
"notBetween"] = do
        Formula
f1 <- Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"formula1") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. FromCursor a => Cursor -> [a]
fromCursor
        Formula
f2 <- Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"formula2") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> 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 forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"formula1") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> 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 ListOrRangeExpression
_)       = 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
        { elementName :: Name
elementName       = Name
nm
        , elementAttributes :: Map Name Text
elementAttributes = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$
            [ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Name
"allowBlank"       forall a. ToAttrVal a => Name -> a -> (Name, Text)
.=  Bool
_dvAllowBlank
            ,        Name
"error"            forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Text
_dvError
            , forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Name
"errorStyle"       forall a. ToAttrVal a => Name -> a -> (Name, Text)
.=  ErrorStyle
_dvErrorStyle
            ,        Name
"errorTitle"       forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Text
_dvErrorTitle
            ,        Name
"operator"         forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Text
op
            ,        Name
"prompt"           forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Text
_dvPrompt
            ,        Name
"promptTitle"      forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Text
_dvPromptTitle
            , forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Name
"showDropDown"     forall a. ToAttrVal a => Name -> a -> (Name, Text)
.=  Bool
_dvShowDropDown
            , forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Name
"showErrorMessage" forall a. ToAttrVal a => Name -> a -> (Name, Text)
.=  Bool
_dvShowErrorMessage
            , forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Name
"showInputMessage" forall a. ToAttrVal a => Name -> a -> (Name, Text)
.=  Bool
_dvShowInputMessage
            , forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Name
"type"             forall a. ToAttrVal a => Name -> a -> (Name, Text)
.=  ValidationType
_dvValidationType
            ]
        , elementNodes :: [Node]
elementNodes      = forall a. [Maybe a] -> [a]
catMaybes
            [ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Element -> Node
NodeElement forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToElement a => Name -> a -> Element
toElement Name
"formula1") Maybe Formula
f1
            , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Element -> Node
NodeElement forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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') = (forall a. a -> Maybe a
Just a
o, 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         -> (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
          ValidationTypeCustom Formula
f     -> (forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just Formula
f, forall a. Maybe a
Nothing)
          ValidationTypeDate ValidationExpression
f       -> forall {a} {a} {c}. (a, a, c) -> (Maybe a, Maybe a, c)
opExp forall a b. (a -> b) -> a -> b
$ ValidationExpression -> (Text, Formula, Maybe Formula)
viewValidationExpression ValidationExpression
f
          ValidationTypeDecimal ValidationExpression
f    -> forall {a} {a} {c}. (a, a, c) -> (Maybe a, Maybe a, c)
opExp forall a b. (a -> b) -> a -> b
$ ValidationExpression -> (Text, Formula, Maybe Formula)
viewValidationExpression ValidationExpression
f
          ValidationTypeTextLength ValidationExpression
f -> forall {a} {a} {c}. (a, a, c) -> (Maybe a, Maybe a, c)
opExp forall a b. (a -> b) -> a -> b
$ ValidationExpression -> (Text, Formula, Maybe Formula)
viewValidationExpression ValidationExpression
f
          ValidationTypeTime ValidationExpression
f       -> forall {a} {a} {c}. (a, a, c) -> (Maybe a, Maybe a, c)
opExp forall a b. (a -> b) -> a -> b
$ ValidationExpression -> (Text, Formula, Maybe Formula)
viewValidationExpression ValidationExpression
f
          ValidationTypeWhole ValidationExpression
f      -> forall {a} {a} {c}. (a, a, c) -> (Maybe a, Maybe a, c)
opExp forall a b. (a -> b) -> a -> b
$ ValidationExpression -> (Text, Formula, Maybe Formula)
viewValidationExpression ValidationExpression
f
          ValidationTypeList ListOrRangeExpression
as      ->
            let renderPlainList :: ValidationList -> Text
renderPlainList ValidationList
l =
                  let csvFy :: ValidationList -> Text
csvFy ValidationList
xs = Text -> ValidationList -> Text
T.intercalate Text
"," ValidationList
xs
                      reQuote :: Text -> Text
reQuote Text
x = Char
'"' Char -> Text -> Text
`T.cons`  Text
x Text -> Char -> Text
`T.snoc` Char
'"'
                    in Text -> Text
reQuote (ValidationList -> Text
csvFy ValidationList
l)
                f :: Formula
f = Text -> Formula
Formula forall a b. (a -> b) -> a -> b
$
                      case ListOrRangeExpression
as of
                        RangeExpression Range
re -> Range -> Text
unCellRef Range
re
                        ListExpression ValidationList
le -> ValidationList -> Text
renderPlainList ValidationList
le
            in  (forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just Formula
f, 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, forall a. a -> Maybe a
Just Formula
f2)
viewValidationExpression (ValEqual Formula
f)               = (Text
"equal",              Formula
f,  forall a. Maybe a
Nothing)
viewValidationExpression (ValGreaterThan Formula
f)         = (Text
"greaterThan",        Formula
f,  forall a. Maybe a
Nothing)
viewValidationExpression (ValGreaterThanOrEqual Formula
f)  = (Text
"greaterThanOrEqual", Formula
f,  forall a. Maybe a
Nothing)
viewValidationExpression (ValLessThan Formula
f)            = (Text
"lessThan",           Formula
f,  forall a. Maybe a
Nothing)
viewValidationExpression (ValLessThanOrEqual Formula
f)     = (Text
"lessThanOrEqual",    Formula
f,  forall a. Maybe a
Nothing)
viewValidationExpression (ValNotBetween Formula
f1 Formula
f2)      = (Text
"notBetween",         Formula
f1, forall a. a -> Maybe a
Just Formula
f2)
viewValidationExpression (ValNotEqual Formula
f)            = (Text
"notEqual",           Formula
f,  forall a. Maybe a
Nothing)