{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
module Codec.Xlsx.Types.AutoFilter where

import Control.Arrow (first)
import Control.DeepSeq (NFData)
#ifdef USE_MICROLENS
import Lens.Micro.TH (makeLenses)
#else
import Control.Lens (makeLenses)
#endif
import Data.Bool (bool)
import Data.ByteString (ByteString)
import Data.Default
import Data.Foldable (asum)
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe (catMaybes)
import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Generics (Generic)
import Text.XML
import Text.XML.Cursor hiding (bool)
import qualified Xeno.DOM as Xeno

import Codec.Xlsx.Parser.Internal
import Codec.Xlsx.Types.Common
import Codec.Xlsx.Types.ConditionalFormatting (IconSetType)
import Codec.Xlsx.Writer.Internal

-- | The filterColumn collection identifies a particular column in the
-- AutoFilter range and specifies filter information that has been
-- applied to this column. If a column in the AutoFilter range has no
-- criteria specified, then there is no corresponding filterColumn
-- collection expressed for that column.
--
-- See 18.3.2.7 "filterColumn (AutoFilter Column)" (p. 1717)
data FilterColumn
  = Filters FilterByBlank [FilterCriterion]
  | ColorFilter ColorFilterOptions
  | ACustomFilter CustomFilter
  | CustomFiltersOr CustomFilter CustomFilter
  | CustomFiltersAnd CustomFilter CustomFilter
  | DynamicFilter DynFilterOptions
  | IconFilter (Maybe Int) IconSetType
  -- ^ Specifies the icon set and particular icon within that set to
  -- filter by. Icon is specified using zero-based index of an icon in
  -- an icon set. 'Nothing' means "no icon"
  | BottomNFilter EdgeFilterOptions
  -- ^ Specifies the bottom N (percent or number of items) to filter by
  | TopNFilter EdgeFilterOptions
  -- ^ Specifies the top N (percent or number of items) to filter by
  deriving (FilterColumn -> FilterColumn -> Bool
(FilterColumn -> FilterColumn -> Bool)
-> (FilterColumn -> FilterColumn -> Bool) -> Eq FilterColumn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilterColumn -> FilterColumn -> Bool
$c/= :: FilterColumn -> FilterColumn -> Bool
== :: FilterColumn -> FilterColumn -> Bool
$c== :: FilterColumn -> FilterColumn -> Bool
Eq, Int -> FilterColumn -> ShowS
[FilterColumn] -> ShowS
FilterColumn -> String
(Int -> FilterColumn -> ShowS)
-> (FilterColumn -> String)
-> ([FilterColumn] -> ShowS)
-> Show FilterColumn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FilterColumn] -> ShowS
$cshowList :: [FilterColumn] -> ShowS
show :: FilterColumn -> String
$cshow :: FilterColumn -> String
showsPrec :: Int -> FilterColumn -> ShowS
$cshowsPrec :: Int -> FilterColumn -> ShowS
Show, (forall x. FilterColumn -> Rep FilterColumn x)
-> (forall x. Rep FilterColumn x -> FilterColumn)
-> Generic FilterColumn
forall x. Rep FilterColumn x -> FilterColumn
forall x. FilterColumn -> Rep FilterColumn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FilterColumn x -> FilterColumn
$cfrom :: forall x. FilterColumn -> Rep FilterColumn x
Generic)
instance NFData FilterColumn

data FilterByBlank
  = FilterByBlank
  | DontFilterByBlank
  deriving (FilterByBlank -> FilterByBlank -> Bool
(FilterByBlank -> FilterByBlank -> Bool)
-> (FilterByBlank -> FilterByBlank -> Bool) -> Eq FilterByBlank
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilterByBlank -> FilterByBlank -> Bool
$c/= :: FilterByBlank -> FilterByBlank -> Bool
== :: FilterByBlank -> FilterByBlank -> Bool
$c== :: FilterByBlank -> FilterByBlank -> Bool
Eq, Int -> FilterByBlank -> ShowS
[FilterByBlank] -> ShowS
FilterByBlank -> String
(Int -> FilterByBlank -> ShowS)
-> (FilterByBlank -> String)
-> ([FilterByBlank] -> ShowS)
-> Show FilterByBlank
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FilterByBlank] -> ShowS
$cshowList :: [FilterByBlank] -> ShowS
show :: FilterByBlank -> String
$cshow :: FilterByBlank -> String
showsPrec :: Int -> FilterByBlank -> ShowS
$cshowsPrec :: Int -> FilterByBlank -> ShowS
Show, (forall x. FilterByBlank -> Rep FilterByBlank x)
-> (forall x. Rep FilterByBlank x -> FilterByBlank)
-> Generic FilterByBlank
forall x. Rep FilterByBlank x -> FilterByBlank
forall x. FilterByBlank -> Rep FilterByBlank x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FilterByBlank x -> FilterByBlank
$cfrom :: forall x. FilterByBlank -> Rep FilterByBlank x
Generic)
instance NFData FilterByBlank

data FilterCriterion
  = FilterValue Text
  | FilterDateGroup DateGroup
  deriving (FilterCriterion -> FilterCriterion -> Bool
(FilterCriterion -> FilterCriterion -> Bool)
-> (FilterCriterion -> FilterCriterion -> Bool)
-> Eq FilterCriterion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilterCriterion -> FilterCriterion -> Bool
$c/= :: FilterCriterion -> FilterCriterion -> Bool
== :: FilterCriterion -> FilterCriterion -> Bool
$c== :: FilterCriterion -> FilterCriterion -> Bool
Eq, Int -> FilterCriterion -> ShowS
[FilterCriterion] -> ShowS
FilterCriterion -> String
(Int -> FilterCriterion -> ShowS)
-> (FilterCriterion -> String)
-> ([FilterCriterion] -> ShowS)
-> Show FilterCriterion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FilterCriterion] -> ShowS
$cshowList :: [FilterCriterion] -> ShowS
show :: FilterCriterion -> String
$cshow :: FilterCriterion -> String
showsPrec :: Int -> FilterCriterion -> ShowS
$cshowsPrec :: Int -> FilterCriterion -> ShowS
Show, (forall x. FilterCriterion -> Rep FilterCriterion x)
-> (forall x. Rep FilterCriterion x -> FilterCriterion)
-> Generic FilterCriterion
forall x. Rep FilterCriterion x -> FilterCriterion
forall x. FilterCriterion -> Rep FilterCriterion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FilterCriterion x -> FilterCriterion
$cfrom :: forall x. FilterCriterion -> Rep FilterCriterion x
Generic)
instance NFData FilterCriterion

-- | Used to express a group of dates or times which are used in an
-- AutoFilter criteria
--
-- Section 18.3.2.4 "dateGroupItem (Date Grouping)" (p. 1714)
data DateGroup
  = DateGroupByYear Int
  | DateGroupByMonth Int Int
  | DateGroupByDay Int Int Int
  | DateGroupByHour Int Int Int Int
  | DateGroupByMinute Int Int Int Int Int
  | DateGroupBySecond Int Int Int Int Int Int
  deriving (DateGroup -> DateGroup -> Bool
(DateGroup -> DateGroup -> Bool)
-> (DateGroup -> DateGroup -> Bool) -> Eq DateGroup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DateGroup -> DateGroup -> Bool
$c/= :: DateGroup -> DateGroup -> Bool
== :: DateGroup -> DateGroup -> Bool
$c== :: DateGroup -> DateGroup -> Bool
Eq, Int -> DateGroup -> ShowS
[DateGroup] -> ShowS
DateGroup -> String
(Int -> DateGroup -> ShowS)
-> (DateGroup -> String)
-> ([DateGroup] -> ShowS)
-> Show DateGroup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DateGroup] -> ShowS
$cshowList :: [DateGroup] -> ShowS
show :: DateGroup -> String
$cshow :: DateGroup -> String
showsPrec :: Int -> DateGroup -> ShowS
$cshowsPrec :: Int -> DateGroup -> ShowS
Show, (forall x. DateGroup -> Rep DateGroup x)
-> (forall x. Rep DateGroup x -> DateGroup) -> Generic DateGroup
forall x. Rep DateGroup x -> DateGroup
forall x. DateGroup -> Rep DateGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DateGroup x -> DateGroup
$cfrom :: forall x. DateGroup -> Rep DateGroup x
Generic)
instance NFData DateGroup

data CustomFilter = CustomFilter
  { CustomFilter -> CustomFilterOperator
cfltOperator :: CustomFilterOperator
  , CustomFilter -> Text
cfltValue :: Text
  } deriving (CustomFilter -> CustomFilter -> Bool
(CustomFilter -> CustomFilter -> Bool)
-> (CustomFilter -> CustomFilter -> Bool) -> Eq CustomFilter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CustomFilter -> CustomFilter -> Bool
$c/= :: CustomFilter -> CustomFilter -> Bool
== :: CustomFilter -> CustomFilter -> Bool
$c== :: CustomFilter -> CustomFilter -> Bool
Eq, Int -> CustomFilter -> ShowS
[CustomFilter] -> ShowS
CustomFilter -> String
(Int -> CustomFilter -> ShowS)
-> (CustomFilter -> String)
-> ([CustomFilter] -> ShowS)
-> Show CustomFilter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CustomFilter] -> ShowS
$cshowList :: [CustomFilter] -> ShowS
show :: CustomFilter -> String
$cshow :: CustomFilter -> String
showsPrec :: Int -> CustomFilter -> ShowS
$cshowsPrec :: Int -> CustomFilter -> ShowS
Show, (forall x. CustomFilter -> Rep CustomFilter x)
-> (forall x. Rep CustomFilter x -> CustomFilter)
-> Generic CustomFilter
forall x. Rep CustomFilter x -> CustomFilter
forall x. CustomFilter -> Rep CustomFilter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CustomFilter x -> CustomFilter
$cfrom :: forall x. CustomFilter -> Rep CustomFilter x
Generic)
instance NFData CustomFilter

data CustomFilterOperator
  = FltrEqual
    -- ^ Show results which are equal to criteria.
  | FltrGreaterThan
    -- ^ Show results which are greater than criteria.
  | FltrGreaterThanOrEqual
    -- ^ Show results which are greater than or equal to criteria.
  | FltrLessThan
    -- ^ Show results which are less than criteria.
  | FltrLessThanOrEqual
    -- ^ Show results which are less than or equal to criteria.
  | FltrNotEqual
    -- ^ Show results which are not equal to criteria.
  deriving (CustomFilterOperator -> CustomFilterOperator -> Bool
(CustomFilterOperator -> CustomFilterOperator -> Bool)
-> (CustomFilterOperator -> CustomFilterOperator -> Bool)
-> Eq CustomFilterOperator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CustomFilterOperator -> CustomFilterOperator -> Bool
$c/= :: CustomFilterOperator -> CustomFilterOperator -> Bool
== :: CustomFilterOperator -> CustomFilterOperator -> Bool
$c== :: CustomFilterOperator -> CustomFilterOperator -> Bool
Eq, Int -> CustomFilterOperator -> ShowS
[CustomFilterOperator] -> ShowS
CustomFilterOperator -> String
(Int -> CustomFilterOperator -> ShowS)
-> (CustomFilterOperator -> String)
-> ([CustomFilterOperator] -> ShowS)
-> Show CustomFilterOperator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CustomFilterOperator] -> ShowS
$cshowList :: [CustomFilterOperator] -> ShowS
show :: CustomFilterOperator -> String
$cshow :: CustomFilterOperator -> String
showsPrec :: Int -> CustomFilterOperator -> ShowS
$cshowsPrec :: Int -> CustomFilterOperator -> ShowS
Show, (forall x. CustomFilterOperator -> Rep CustomFilterOperator x)
-> (forall x. Rep CustomFilterOperator x -> CustomFilterOperator)
-> Generic CustomFilterOperator
forall x. Rep CustomFilterOperator x -> CustomFilterOperator
forall x. CustomFilterOperator -> Rep CustomFilterOperator x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CustomFilterOperator x -> CustomFilterOperator
$cfrom :: forall x. CustomFilterOperator -> Rep CustomFilterOperator x
Generic)
instance NFData CustomFilterOperator

data EdgeFilterOptions = EdgeFilterOptions
  { EdgeFilterOptions -> Bool
_efoUsePercents :: Bool
  -- ^ Flag indicating whether or not to filter by percent value of
  -- the column. A false value filters by number of items.
  , EdgeFilterOptions -> Double
_efoVal :: Double
  -- ^ Top or bottom value to use as the filter criteria.
  -- Example: "Filter by Top 10 Percent" or "Filter by Top 5 Items"
  , EdgeFilterOptions -> Maybe Double
_efoFilterVal :: Maybe Double
  -- ^ The actual cell value in the range which is used to perform the
  -- comparison for this filter.
  } deriving (EdgeFilterOptions -> EdgeFilterOptions -> Bool
(EdgeFilterOptions -> EdgeFilterOptions -> Bool)
-> (EdgeFilterOptions -> EdgeFilterOptions -> Bool)
-> Eq EdgeFilterOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EdgeFilterOptions -> EdgeFilterOptions -> Bool
$c/= :: EdgeFilterOptions -> EdgeFilterOptions -> Bool
== :: EdgeFilterOptions -> EdgeFilterOptions -> Bool
$c== :: EdgeFilterOptions -> EdgeFilterOptions -> Bool
Eq, Int -> EdgeFilterOptions -> ShowS
[EdgeFilterOptions] -> ShowS
EdgeFilterOptions -> String
(Int -> EdgeFilterOptions -> ShowS)
-> (EdgeFilterOptions -> String)
-> ([EdgeFilterOptions] -> ShowS)
-> Show EdgeFilterOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EdgeFilterOptions] -> ShowS
$cshowList :: [EdgeFilterOptions] -> ShowS
show :: EdgeFilterOptions -> String
$cshow :: EdgeFilterOptions -> String
showsPrec :: Int -> EdgeFilterOptions -> ShowS
$cshowsPrec :: Int -> EdgeFilterOptions -> ShowS
Show, (forall x. EdgeFilterOptions -> Rep EdgeFilterOptions x)
-> (forall x. Rep EdgeFilterOptions x -> EdgeFilterOptions)
-> Generic EdgeFilterOptions
forall x. Rep EdgeFilterOptions x -> EdgeFilterOptions
forall x. EdgeFilterOptions -> Rep EdgeFilterOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EdgeFilterOptions x -> EdgeFilterOptions
$cfrom :: forall x. EdgeFilterOptions -> Rep EdgeFilterOptions x
Generic)
instance NFData EdgeFilterOptions

-- | Specifies the color to filter by and whether to use the cell's
-- fill or font color in the filter criteria. If the cell's font or
-- fill color does not match the color specified in the criteria, the
-- rows corresponding to those cells are hidden from view.
--
-- See 18.3.2.1 "colorFilter (Color Filter Criteria)" (p. 1712)
data ColorFilterOptions = ColorFilterOptions
  { ColorFilterOptions -> Bool
_cfoCellColor :: Bool
  -- ^ Flag indicating whether or not to filter by the cell's fill
  -- color. 'True' indicates to filter by cell fill. 'False' indicates
  -- to filter by the cell's font color.
  --
  -- For rich text in cells, if the color specified appears in the
  -- cell at all, it shall be included in the filter.
  , ColorFilterOptions -> Maybe Int
_cfoDxfId :: Maybe Int
  -- ^ Id of differential format record (dxf) in the Styles Part (see
  -- '_styleSheetDxfs') which expresses the color value to filter by.
  } deriving (ColorFilterOptions -> ColorFilterOptions -> Bool
(ColorFilterOptions -> ColorFilterOptions -> Bool)
-> (ColorFilterOptions -> ColorFilterOptions -> Bool)
-> Eq ColorFilterOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColorFilterOptions -> ColorFilterOptions -> Bool
$c/= :: ColorFilterOptions -> ColorFilterOptions -> Bool
== :: ColorFilterOptions -> ColorFilterOptions -> Bool
$c== :: ColorFilterOptions -> ColorFilterOptions -> Bool
Eq, Int -> ColorFilterOptions -> ShowS
[ColorFilterOptions] -> ShowS
ColorFilterOptions -> String
(Int -> ColorFilterOptions -> ShowS)
-> (ColorFilterOptions -> String)
-> ([ColorFilterOptions] -> ShowS)
-> Show ColorFilterOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColorFilterOptions] -> ShowS
$cshowList :: [ColorFilterOptions] -> ShowS
show :: ColorFilterOptions -> String
$cshow :: ColorFilterOptions -> String
showsPrec :: Int -> ColorFilterOptions -> ShowS
$cshowsPrec :: Int -> ColorFilterOptions -> ShowS
Show, (forall x. ColorFilterOptions -> Rep ColorFilterOptions x)
-> (forall x. Rep ColorFilterOptions x -> ColorFilterOptions)
-> Generic ColorFilterOptions
forall x. Rep ColorFilterOptions x -> ColorFilterOptions
forall x. ColorFilterOptions -> Rep ColorFilterOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ColorFilterOptions x -> ColorFilterOptions
$cfrom :: forall x. ColorFilterOptions -> Rep ColorFilterOptions x
Generic)
instance NFData ColorFilterOptions

-- | Specifies dynamic filter criteria. These criteria are considered
-- dynamic because they can change, either with the data itself (e.g.,
-- "above average") or with the current system date (e.g., show values
-- for "today"). For any cells whose values do not meet the specified
-- criteria, the corresponding rows shall be hidden from view when the
-- filter is applied.
--
-- '_dfoMaxVal' shall be required for 'DynFilterTday',
-- 'DynFilterYesterday', 'DynFilterTomorrow', 'DynFilterNextWeek',
-- 'DynFilterThisWeek', 'DynFilterLastWeek', 'DynFilterNextMonth',
-- 'DynFilterThisMonth', 'DynFilterLastMonth', 'DynFilterNextQuarter',
-- 'DynFilterThisQuarter', 'DynFilterLastQuarter',
-- 'DynFilterNextYear', 'DynFilterThisYear', 'DynFilterLastYear', and
-- 'DynFilterYearToDate.
--
-- The above criteria are based on a value range; that is, if today's
-- date is September 22nd, then the range for thisWeek is the values
-- greater than or equal to September 17 and less than September
-- 24. In the thisWeek range, the lower value is expressed
-- '_dfoval'. The higher value is expressed using '_dfoMmaxVal'.
--
-- These dynamic filters shall not require '_dfoVal or '_dfoMaxVal':
-- 'DynFilterQ1', 'DynFilterQ2', 'DynFilterQ3', 'DynFilterQ4',
-- 'DynFilterM1', 'DynFilterM2', 'DynFilterM3', 'DynFilterM4',
-- 'DynFilterM5', 'DynFilterM6', 'DynFilterM7', 'DynFilterM8',
-- 'DynFilterM9', 'DynFilterM10', 'DynFilterM11' and 'DynFilterM12'.
--
-- The above criteria shall not specify the range using valIso and
-- maxValIso because Q1 always starts from M1 to M3, and M1 is always
-- January.
--
-- These types of dynamic filters shall use valIso and shall not use
-- '_dfoMaxVal': 'DynFilterAboveAverage' and 'DynFilterBelowAverage'
--
-- /Note:/ Specification lists 'valIso' and 'maxIso' to store datetime
-- values but it appears that Excel doesn't use them and stored them
-- as numeric values (as it does for datetimes in cell values)
--
-- See 18.3.2.5 "dynamicFilter (Dynamic Filter)" (p. 1715)
data DynFilterOptions = DynFilterOptions
  { DynFilterOptions -> DynFilterType
_dfoType :: DynFilterType
  , DynFilterOptions -> Maybe Double
_dfoVal :: Maybe Double
  -- ^ A minimum numeric value for dynamic filter.
  , DynFilterOptions -> Maybe Double
_dfoMaxVal :: Maybe Double
  -- ^ A maximum value for dynamic filter.
  } deriving (DynFilterOptions -> DynFilterOptions -> Bool
(DynFilterOptions -> DynFilterOptions -> Bool)
-> (DynFilterOptions -> DynFilterOptions -> Bool)
-> Eq DynFilterOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DynFilterOptions -> DynFilterOptions -> Bool
$c/= :: DynFilterOptions -> DynFilterOptions -> Bool
== :: DynFilterOptions -> DynFilterOptions -> Bool
$c== :: DynFilterOptions -> DynFilterOptions -> Bool
Eq, Int -> DynFilterOptions -> ShowS
[DynFilterOptions] -> ShowS
DynFilterOptions -> String
(Int -> DynFilterOptions -> ShowS)
-> (DynFilterOptions -> String)
-> ([DynFilterOptions] -> ShowS)
-> Show DynFilterOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DynFilterOptions] -> ShowS
$cshowList :: [DynFilterOptions] -> ShowS
show :: DynFilterOptions -> String
$cshow :: DynFilterOptions -> String
showsPrec :: Int -> DynFilterOptions -> ShowS
$cshowsPrec :: Int -> DynFilterOptions -> ShowS
Show, (forall x. DynFilterOptions -> Rep DynFilterOptions x)
-> (forall x. Rep DynFilterOptions x -> DynFilterOptions)
-> Generic DynFilterOptions
forall x. Rep DynFilterOptions x -> DynFilterOptions
forall x. DynFilterOptions -> Rep DynFilterOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DynFilterOptions x -> DynFilterOptions
$cfrom :: forall x. DynFilterOptions -> Rep DynFilterOptions x
Generic)
instance NFData DynFilterOptions

-- | Specifies concrete type of dynamic filter used
--
-- See 18.18.26 "ST_DynamicFilterType (Dynamic Filter)" (p. 2452)
data DynFilterType
  = DynFilterAboveAverage
  -- ^ Shows values that are above average.
  | DynFilterBelowAverage
  -- ^ Shows values that are below average.
  | DynFilterLastMonth
  -- ^ Shows last month's dates.
  | DynFilterLastQuarter
  -- ^ Shows last calendar quarter's dates.
  | DynFilterLastWeek
  -- ^ Shows last week's dates, using Sunday as the first weekday.
  | DynFilterLastYear
  -- ^ Shows last year's dates.
  | DynFilterM1
  -- ^ Shows the dates that are in January, regardless of year.
  | DynFilterM10
  -- ^ Shows the dates that are in October, regardless of year.
  | DynFilterM11
  -- ^ Shows the dates that are in November, regardless of year.
  | DynFilterM12
  -- ^ Shows the dates that are in December, regardless of year.
  | DynFilterM2
  -- ^ Shows the dates that are in February, regardless of year.
  | DynFilterM3
  -- ^ Shows the dates that are in March, regardless of year.
  | DynFilterM4
  -- ^ Shows the dates that are in April, regardless of year.
  | DynFilterM5
  -- ^ Shows the dates that are in May, regardless of year.
  | DynFilterM6
  -- ^ Shows the dates that are in June, regardless of year.
  | DynFilterM7
  -- ^ Shows the dates that are in July, regardless of year.
  | DynFilterM8
  -- ^ Shows the dates that are in August, regardless of year.
  | DynFilterM9
  -- ^ Shows the dates that are in September, regardless of year.
  | DynFilterNextMonth
  -- ^ Shows next month's dates.
  | DynFilterNextQuarter
  -- ^ Shows next calendar quarter's dates.
  | DynFilterNextWeek
  -- ^ Shows next week's dates, using Sunday as the first weekday.
  | DynFilterNextYear
  -- ^ Shows next year's dates.
  | DynFilterNull
  -- ^ Common filter type not available.
  | DynFilterQ1
  -- ^ Shows the dates that are in the 1st calendar quarter,
  -- regardless of year.
  | DynFilterQ2
  -- ^ Shows the dates that are in the 2nd calendar quarter,
  -- regardless of year.
  | DynFilterQ3
  -- ^ Shows the dates that are in the 3rd calendar quarter,
  -- regardless of year.
  | DynFilterQ4
  -- ^ Shows the dates that are in the 4th calendar quarter,
  -- regardless of year.
  | DynFilterThisMonth
  -- ^ Shows this month's dates.
  | DynFilterThisQuarter
  -- ^ Shows this calendar quarter's dates.
  | DynFilterThisWeek
  -- ^ Shows this week's dates, using Sunday as the first weekday.
  | DynFilterThisYear
  -- ^ Shows this year's dates.
  | DynFilterToday
  -- ^ Shows today's dates.
  | DynFilterTomorrow
  -- ^ Shows tomorrow's dates.
  | DynFilterYearToDate
  -- ^ Shows the dates between the beginning of the year and today, inclusive.
  | DynFilterYesterday
  -- ^ Shows yesterday's dates.
  deriving (DynFilterType -> DynFilterType -> Bool
(DynFilterType -> DynFilterType -> Bool)
-> (DynFilterType -> DynFilterType -> Bool) -> Eq DynFilterType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DynFilterType -> DynFilterType -> Bool
$c/= :: DynFilterType -> DynFilterType -> Bool
== :: DynFilterType -> DynFilterType -> Bool
$c== :: DynFilterType -> DynFilterType -> Bool
Eq, Int -> DynFilterType -> ShowS
[DynFilterType] -> ShowS
DynFilterType -> String
(Int -> DynFilterType -> ShowS)
-> (DynFilterType -> String)
-> ([DynFilterType] -> ShowS)
-> Show DynFilterType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DynFilterType] -> ShowS
$cshowList :: [DynFilterType] -> ShowS
show :: DynFilterType -> String
$cshow :: DynFilterType -> String
showsPrec :: Int -> DynFilterType -> ShowS
$cshowsPrec :: Int -> DynFilterType -> ShowS
Show, (forall x. DynFilterType -> Rep DynFilterType x)
-> (forall x. Rep DynFilterType x -> DynFilterType)
-> Generic DynFilterType
forall x. Rep DynFilterType x -> DynFilterType
forall x. DynFilterType -> Rep DynFilterType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DynFilterType x -> DynFilterType
$cfrom :: forall x. DynFilterType -> Rep DynFilterType x
Generic)
instance NFData DynFilterType

-- | AutoFilter temporarily hides rows based on a filter criteria,
-- which is applied column by column to a table of datain the
-- worksheet.
--
-- TODO: sortState, extList
--
-- See 18.3.1.2 "autoFilter (AutoFilter Settings)" (p. 1596)
data AutoFilter = AutoFilter
  { AutoFilter -> Maybe CellRef
_afRef :: Maybe CellRef
  , AutoFilter -> Map Int FilterColumn
_afFilterColumns :: Map Int FilterColumn
  } deriving (AutoFilter -> AutoFilter -> Bool
(AutoFilter -> AutoFilter -> Bool)
-> (AutoFilter -> AutoFilter -> Bool) -> Eq AutoFilter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AutoFilter -> AutoFilter -> Bool
$c/= :: AutoFilter -> AutoFilter -> Bool
== :: AutoFilter -> AutoFilter -> Bool
$c== :: AutoFilter -> AutoFilter -> Bool
Eq, Int -> AutoFilter -> ShowS
[AutoFilter] -> ShowS
AutoFilter -> String
(Int -> AutoFilter -> ShowS)
-> (AutoFilter -> String)
-> ([AutoFilter] -> ShowS)
-> Show AutoFilter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AutoFilter] -> ShowS
$cshowList :: [AutoFilter] -> ShowS
show :: AutoFilter -> String
$cshow :: AutoFilter -> String
showsPrec :: Int -> AutoFilter -> ShowS
$cshowsPrec :: Int -> AutoFilter -> ShowS
Show, (forall x. AutoFilter -> Rep AutoFilter x)
-> (forall x. Rep AutoFilter x -> AutoFilter) -> Generic AutoFilter
forall x. Rep AutoFilter x -> AutoFilter
forall x. AutoFilter -> Rep AutoFilter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AutoFilter x -> AutoFilter
$cfrom :: forall x. AutoFilter -> Rep AutoFilter x
Generic)
instance NFData AutoFilter

makeLenses ''AutoFilter


{-------------------------------------------------------------------------------
  Default instances
-------------------------------------------------------------------------------}

instance Default AutoFilter where
    def :: AutoFilter
def = Maybe CellRef -> Map Int FilterColumn -> AutoFilter
AutoFilter Maybe CellRef
forall a. Maybe a
Nothing Map Int FilterColumn
forall k a. Map k a
M.empty

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

instance FromCursor AutoFilter where
  fromCursor :: Cursor -> [AutoFilter]
fromCursor Cursor
cur = do
    Maybe CellRef
_afRef <- Name -> Cursor -> [Maybe CellRef]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"ref" Cursor
cur
    let _afFilterColumns :: Map Int FilterColumn
_afFilterColumns = [(Int, FilterColumn)] -> Map Int FilterColumn
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Int, FilterColumn)] -> Map Int FilterColumn)
-> [(Int, FilterColumn)] -> Map Int FilterColumn
forall a b. (a -> b) -> a -> b
$ Cursor
cur Cursor
-> (Cursor -> [(Int, FilterColumn)]) -> [(Int, FilterColumn)]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"filterColumn") Axis
-> (Cursor -> [(Int, FilterColumn)])
-> Cursor
-> [(Int, FilterColumn)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \Cursor
c -> do
          Int
colId <- Name -> Cursor -> [Int]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"colId" Cursor
c
          FilterColumn
fcol <- Cursor
c Cursor -> (Cursor -> [FilterColumn]) -> [FilterColumn]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Axis
anyElement Axis -> (Cursor -> [FilterColumn]) -> Cursor -> [FilterColumn]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Node -> [FilterColumn]
fltColFromNode (Node -> [FilterColumn])
-> (Cursor -> Node) -> Cursor -> [FilterColumn]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cursor -> Node
forall node. Cursor node -> node
node
          (Int, FilterColumn) -> [(Int, FilterColumn)]
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
colId, FilterColumn
fcol)
    AutoFilter -> [AutoFilter]
forall (m :: * -> *) a. Monad m => a -> m a
return AutoFilter :: Maybe CellRef -> Map Int FilterColumn -> AutoFilter
AutoFilter {Maybe CellRef
Map Int FilterColumn
_afFilterColumns :: Map Int FilterColumn
_afRef :: Maybe CellRef
_afFilterColumns :: Map Int FilterColumn
_afRef :: Maybe CellRef
..}

instance FromXenoNode AutoFilter where
  fromXenoNode :: Node -> Either Text AutoFilter
fromXenoNode Node
root = do
    Maybe CellRef
_afRef <- Node -> AttrParser (Maybe CellRef) -> Either Text (Maybe CellRef)
forall a. Node -> AttrParser a -> Either Text a
parseAttributes Node
root (AttrParser (Maybe CellRef) -> Either Text (Maybe CellRef))
-> AttrParser (Maybe CellRef) -> Either Text (Maybe CellRef)
forall a b. (a -> b) -> a -> b
$ ByteString -> AttrParser (Maybe CellRef)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"ref"
    Map Int FilterColumn
_afFilterColumns <-
      ([(Int, FilterColumn)] -> Map Int FilterColumn)
-> Either Text [(Int, FilterColumn)]
-> Either Text (Map Int FilterColumn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Int, FilterColumn)] -> Map Int FilterColumn
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (Either Text [(Int, FilterColumn)]
 -> Either Text (Map Int FilterColumn))
-> (ChildCollector [(Int, FilterColumn)]
    -> Either Text [(Int, FilterColumn)])
-> ChildCollector [(Int, FilterColumn)]
-> Either Text (Map Int FilterColumn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node
-> ChildCollector [(Int, FilterColumn)]
-> Either Text [(Int, FilterColumn)]
forall a. Node -> ChildCollector a -> Either Text a
collectChildren Node
root (ChildCollector [(Int, FilterColumn)]
 -> Either Text (Map Int FilterColumn))
-> ChildCollector [(Int, FilterColumn)]
-> Either Text (Map Int FilterColumn)
forall a b. (a -> b) -> a -> b
$ ByteString -> ChildCollector [(Int, FilterColumn)]
forall a. FromXenoNode a => ByteString -> ChildCollector [a]
fromChildList ByteString
"filterColumn"
    AutoFilter -> Either Text AutoFilter
forall (m :: * -> *) a. Monad m => a -> m a
return AutoFilter :: Maybe CellRef -> Map Int FilterColumn -> AutoFilter
AutoFilter {Maybe CellRef
Map Int FilterColumn
_afFilterColumns :: Map Int FilterColumn
_afRef :: Maybe CellRef
_afFilterColumns :: Map Int FilterColumn
_afRef :: Maybe CellRef
..}

instance FromXenoNode (Int, FilterColumn) where
  fromXenoNode :: Node -> Either Text (Int, FilterColumn)
fromXenoNode Node
root = do
    Int
colId <- Node -> AttrParser Int -> Either Text Int
forall a. Node -> AttrParser a -> Either Text a
parseAttributes Node
root (AttrParser Int -> Either Text Int)
-> AttrParser Int -> Either Text Int
forall a b. (a -> b) -> a -> b
$ ByteString -> AttrParser Int
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"colId"
    FilterColumn
fCol <-
      Node -> ChildCollector FilterColumn -> Either Text FilterColumn
forall a. Node -> ChildCollector a -> Either Text a
collectChildren Node
root (ChildCollector FilterColumn -> Either Text FilterColumn)
-> ChildCollector FilterColumn -> Either Text FilterColumn
forall a b. (a -> b) -> a -> b
$ [ChildCollector FilterColumn] -> ChildCollector FilterColumn
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [ChildCollector FilterColumn
filters, ChildCollector FilterColumn
color, ChildCollector FilterColumn
custom, ChildCollector FilterColumn
dynamic, ChildCollector FilterColumn
icon, ChildCollector FilterColumn
top10]
    (Int, FilterColumn) -> Either Text (Int, FilterColumn)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
colId, FilterColumn
fCol)
    where
      filters :: ChildCollector FilterColumn
filters =
        ByteString
-> (Node -> Either Text FilterColumn)
-> ChildCollector FilterColumn
forall a. ByteString -> (Node -> Either Text a) -> ChildCollector a
requireAndParse ByteString
"filters" ((Node -> Either Text FilterColumn) -> ChildCollector FilterColumn)
-> (Node -> Either Text FilterColumn)
-> ChildCollector FilterColumn
forall a b. (a -> b) -> a -> b
$ \Node
node -> do
          FilterByBlank
filterBlank <-
            Node -> AttrParser FilterByBlank -> Either Text FilterByBlank
forall a. Node -> AttrParser a -> Either Text a
parseAttributes Node
node (AttrParser FilterByBlank -> Either Text FilterByBlank)
-> AttrParser FilterByBlank -> Either Text FilterByBlank
forall a b. (a -> b) -> a -> b
$ ByteString -> FilterByBlank -> AttrParser FilterByBlank
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"blank" FilterByBlank
DontFilterByBlank
          [FilterCriterion]
filterCriteria <- Node -> Either Text [FilterCriterion]
forall a. FromXenoNode a => Node -> Either Text [a]
childListAny Node
node
          FilterColumn -> Either Text FilterColumn
forall (m :: * -> *) a. Monad m => a -> m a
return (FilterColumn -> Either Text FilterColumn)
-> FilterColumn -> Either Text FilterColumn
forall a b. (a -> b) -> a -> b
$ FilterByBlank -> [FilterCriterion] -> FilterColumn
Filters FilterByBlank
filterBlank [FilterCriterion]
filterCriteria
      color :: ChildCollector FilterColumn
color =
        ByteString
-> (Node -> Either Text FilterColumn)
-> ChildCollector FilterColumn
forall a. ByteString -> (Node -> Either Text a) -> ChildCollector a
requireAndParse ByteString
"colorFilter" ((Node -> Either Text FilterColumn) -> ChildCollector FilterColumn)
-> (Node -> Either Text FilterColumn)
-> ChildCollector FilterColumn
forall a b. (a -> b) -> a -> b
$ \Node
node ->
          Node -> AttrParser FilterColumn -> Either Text FilterColumn
forall a. Node -> AttrParser a -> Either Text a
parseAttributes Node
node (AttrParser FilterColumn -> Either Text FilterColumn)
-> AttrParser FilterColumn -> Either Text FilterColumn
forall a b. (a -> b) -> a -> b
$ do
            Bool
_cfoCellColor <- ByteString -> Bool -> AttrParser Bool
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"cellColor" Bool
True
            Maybe Int
_cfoDxfId <- ByteString -> AttrParser (Maybe Int)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"dxfId"
            FilterColumn -> AttrParser FilterColumn
forall (m :: * -> *) a. Monad m => a -> m a
return (FilterColumn -> AttrParser FilterColumn)
-> FilterColumn -> AttrParser FilterColumn
forall a b. (a -> b) -> a -> b
$ ColorFilterOptions -> FilterColumn
ColorFilter ColorFilterOptions :: Bool -> Maybe Int -> ColorFilterOptions
ColorFilterOptions {Bool
Maybe Int
_cfoDxfId :: Maybe Int
_cfoCellColor :: Bool
_cfoDxfId :: Maybe Int
_cfoCellColor :: Bool
..}
      custom :: ChildCollector FilterColumn
custom =
        ByteString
-> (Node -> Either Text FilterColumn)
-> ChildCollector FilterColumn
forall a. ByteString -> (Node -> Either Text a) -> ChildCollector a
requireAndParse ByteString
"customFilters" ((Node -> Either Text FilterColumn) -> ChildCollector FilterColumn)
-> (Node -> Either Text FilterColumn)
-> ChildCollector FilterColumn
forall a b. (a -> b) -> a -> b
$ \Node
node -> do
          Bool
isAnd <- Node -> AttrParser Bool -> Either Text Bool
forall a. Node -> AttrParser a -> Either Text a
parseAttributes Node
node (AttrParser Bool -> Either Text Bool)
-> AttrParser Bool -> Either Text Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> Bool -> AttrParser Bool
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"and" Bool
False
          [CustomFilter]
cfilters <- Node -> ChildCollector [CustomFilter] -> Either Text [CustomFilter]
forall a. Node -> ChildCollector a -> Either Text a
collectChildren Node
node (ChildCollector [CustomFilter] -> Either Text [CustomFilter])
-> ChildCollector [CustomFilter] -> Either Text [CustomFilter]
forall a b. (a -> b) -> a -> b
$ ByteString -> ChildCollector [CustomFilter]
forall a. FromXenoNode a => ByteString -> ChildCollector [a]
fromChildList ByteString
"customFilter"
          case [CustomFilter]
cfilters of
            [CustomFilter
f] -> FilterColumn -> Either Text FilterColumn
forall (m :: * -> *) a. Monad m => a -> m a
return (FilterColumn -> Either Text FilterColumn)
-> FilterColumn -> Either Text FilterColumn
forall a b. (a -> b) -> a -> b
$ CustomFilter -> FilterColumn
ACustomFilter CustomFilter
f
            [CustomFilter
f1, CustomFilter
f2] ->
              if Bool
isAnd
                then FilterColumn -> Either Text FilterColumn
forall (m :: * -> *) a. Monad m => a -> m a
return (FilterColumn -> Either Text FilterColumn)
-> FilterColumn -> Either Text FilterColumn
forall a b. (a -> b) -> a -> b
$ CustomFilter -> CustomFilter -> FilterColumn
CustomFiltersAnd CustomFilter
f1 CustomFilter
f2
                else FilterColumn -> Either Text FilterColumn
forall (m :: * -> *) a. Monad m => a -> m a
return (FilterColumn -> Either Text FilterColumn)
-> FilterColumn -> Either Text FilterColumn
forall a b. (a -> b) -> a -> b
$ CustomFilter -> CustomFilter -> FilterColumn
CustomFiltersOr CustomFilter
f1 CustomFilter
f2
            [CustomFilter]
_ ->
              Text -> Either Text FilterColumn
forall a b. a -> Either a b
Left (Text -> Either Text FilterColumn)
-> Text -> Either Text FilterColumn
forall a b. (a -> b) -> a -> b
$
              Text
"expected 1 or 2 custom filters but found " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
              String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ [CustomFilter] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CustomFilter]
cfilters)
      dynamic :: ChildCollector FilterColumn
dynamic =
        ByteString
-> (Node -> Either Text FilterColumn)
-> ChildCollector FilterColumn
forall a. ByteString -> (Node -> Either Text a) -> ChildCollector a
requireAndParse ByteString
"dynamicFilter" ((Node -> Either Text FilterColumn) -> ChildCollector FilterColumn)
-> (AttrParser FilterColumn -> Node -> Either Text FilterColumn)
-> AttrParser FilterColumn
-> ChildCollector FilterColumn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node -> AttrParser FilterColumn -> Either Text FilterColumn)
-> AttrParser FilterColumn -> Node -> Either Text FilterColumn
forall a b c. (a -> b -> c) -> b -> a -> c
flip Node -> AttrParser FilterColumn -> Either Text FilterColumn
forall a. Node -> AttrParser a -> Either Text a
parseAttributes (AttrParser FilterColumn -> ChildCollector FilterColumn)
-> AttrParser FilterColumn -> ChildCollector FilterColumn
forall a b. (a -> b) -> a -> b
$ do
          DynFilterType
_dfoType <- ByteString -> AttrParser DynFilterType
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"type"
          Maybe Double
_dfoVal <- ByteString -> AttrParser (Maybe Double)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"val"
          Maybe Double
_dfoMaxVal <- ByteString -> AttrParser (Maybe Double)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"maxVal"
          FilterColumn -> AttrParser FilterColumn
forall (m :: * -> *) a. Monad m => a -> m a
return (FilterColumn -> AttrParser FilterColumn)
-> FilterColumn -> AttrParser FilterColumn
forall a b. (a -> b) -> a -> b
$ DynFilterOptions -> FilterColumn
DynamicFilter DynFilterOptions :: DynFilterType -> Maybe Double -> Maybe Double -> DynFilterOptions
DynFilterOptions {Maybe Double
DynFilterType
_dfoMaxVal :: Maybe Double
_dfoVal :: Maybe Double
_dfoType :: DynFilterType
_dfoMaxVal :: Maybe Double
_dfoVal :: Maybe Double
_dfoType :: DynFilterType
..}
      icon :: ChildCollector FilterColumn
icon =
        ByteString
-> (Node -> Either Text FilterColumn)
-> ChildCollector FilterColumn
forall a. ByteString -> (Node -> Either Text a) -> ChildCollector a
requireAndParse ByteString
"iconFilter" ((Node -> Either Text FilterColumn) -> ChildCollector FilterColumn)
-> (AttrParser FilterColumn -> Node -> Either Text FilterColumn)
-> AttrParser FilterColumn
-> ChildCollector FilterColumn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node -> AttrParser FilterColumn -> Either Text FilterColumn)
-> AttrParser FilterColumn -> Node -> Either Text FilterColumn
forall a b c. (a -> b -> c) -> b -> a -> c
flip Node -> AttrParser FilterColumn -> Either Text FilterColumn
forall a. Node -> AttrParser a -> Either Text a
parseAttributes (AttrParser FilterColumn -> ChildCollector FilterColumn)
-> AttrParser FilterColumn -> ChildCollector FilterColumn
forall a b. (a -> b) -> a -> b
$
        Maybe Int -> IconSetType -> FilterColumn
IconFilter (Maybe Int -> IconSetType -> FilterColumn)
-> AttrParser (Maybe Int)
-> AttrParser (IconSetType -> FilterColumn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> AttrParser (Maybe Int)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"iconId" AttrParser (IconSetType -> FilterColumn)
-> AttrParser IconSetType -> AttrParser FilterColumn
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> AttrParser IconSetType
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"iconSet"
      top10 :: ChildCollector FilterColumn
top10 =
        ByteString
-> (Node -> Either Text FilterColumn)
-> ChildCollector FilterColumn
forall a. ByteString -> (Node -> Either Text a) -> ChildCollector a
requireAndParse ByteString
"top10" ((Node -> Either Text FilterColumn) -> ChildCollector FilterColumn)
-> (AttrParser FilterColumn -> Node -> Either Text FilterColumn)
-> AttrParser FilterColumn
-> ChildCollector FilterColumn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node -> AttrParser FilterColumn -> Either Text FilterColumn)
-> AttrParser FilterColumn -> Node -> Either Text FilterColumn
forall a b c. (a -> b -> c) -> b -> a -> c
flip Node -> AttrParser FilterColumn -> Either Text FilterColumn
forall a. Node -> AttrParser a -> Either Text a
parseAttributes (AttrParser FilterColumn -> ChildCollector FilterColumn)
-> AttrParser FilterColumn -> ChildCollector FilterColumn
forall a b. (a -> b) -> a -> b
$ do
          Bool
top <- ByteString -> Bool -> AttrParser Bool
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"top" Bool
True
          Bool
percent <- ByteString -> Bool -> AttrParser Bool
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"percent" Bool
False
          Double
val <- ByteString -> AttrParser Double
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"val"
          Maybe Double
filterVal <- ByteString -> AttrParser (Maybe Double)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"filterVal"
          let opts :: EdgeFilterOptions
opts = Bool -> Double -> Maybe Double -> EdgeFilterOptions
EdgeFilterOptions Bool
percent Double
val Maybe Double
filterVal
          if Bool
top
            then FilterColumn -> AttrParser FilterColumn
forall (m :: * -> *) a. Monad m => a -> m a
return (FilterColumn -> AttrParser FilterColumn)
-> FilterColumn -> AttrParser FilterColumn
forall a b. (a -> b) -> a -> b
$ EdgeFilterOptions -> FilterColumn
TopNFilter EdgeFilterOptions
opts
            else FilterColumn -> AttrParser FilterColumn
forall (m :: * -> *) a. Monad m => a -> m a
return (FilterColumn -> AttrParser FilterColumn)
-> FilterColumn -> AttrParser FilterColumn
forall a b. (a -> b) -> a -> b
$ EdgeFilterOptions -> FilterColumn
BottomNFilter EdgeFilterOptions
opts

instance FromXenoNode CustomFilter where
  fromXenoNode :: Node -> Either Text CustomFilter
fromXenoNode Node
root =
    Node -> AttrParser CustomFilter -> Either Text CustomFilter
forall a. Node -> AttrParser a -> Either Text a
parseAttributes Node
root (AttrParser CustomFilter -> Either Text CustomFilter)
-> AttrParser CustomFilter -> Either Text CustomFilter
forall a b. (a -> b) -> a -> b
$
    CustomFilterOperator -> Text -> CustomFilter
CustomFilter (CustomFilterOperator -> Text -> CustomFilter)
-> AttrParser CustomFilterOperator
-> AttrParser (Text -> CustomFilter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString
-> CustomFilterOperator -> AttrParser CustomFilterOperator
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"operator" CustomFilterOperator
FltrEqual AttrParser (Text -> CustomFilter)
-> AttrParser Text -> AttrParser CustomFilter
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> AttrParser Text
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"val"

fltColFromNode :: Node -> [FilterColumn]
fltColFromNode :: Node -> [FilterColumn]
fltColFromNode Node
n | Node
n Node -> Name -> Bool
`nodeElNameIs` (Text -> Name
n_ Text
"filters") = do
                     let filterCriteria :: [FilterCriterion]
filterCriteria = Cursor
cur Cursor -> (Cursor -> [FilterCriterion]) -> [FilterCriterion]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Axis
anyElement Axis
-> (Cursor -> [FilterCriterion]) -> Cursor -> [FilterCriterion]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [FilterCriterion]
forall a. FromCursor a => Cursor -> [a]
fromCursor
                     FilterByBlank
filterBlank <- Name -> FilterByBlank -> Cursor -> [FilterByBlank]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"blank" FilterByBlank
DontFilterByBlank Cursor
cur
                     FilterColumn -> [FilterColumn]
forall (m :: * -> *) a. Monad m => a -> m a
return (FilterColumn -> [FilterColumn]) -> FilterColumn -> [FilterColumn]
forall a b. (a -> b) -> a -> b
$ FilterByBlank -> [FilterCriterion] -> FilterColumn
Filters FilterByBlank
filterBlank [FilterCriterion]
filterCriteria
                 | Node
n Node -> Name -> Bool
`nodeElNameIs` (Text -> Name
n_ Text
"colorFilter") = do
                     Bool
_cfoCellColor <- Name -> Bool -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"cellColor" Bool
True Cursor
cur
                     Maybe Int
_cfoDxfId <- Name -> Cursor -> [Maybe Int]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"dxfId" Cursor
cur
                     FilterColumn -> [FilterColumn]
forall (m :: * -> *) a. Monad m => a -> m a
return (FilterColumn -> [FilterColumn]) -> FilterColumn -> [FilterColumn]
forall a b. (a -> b) -> a -> b
$ ColorFilterOptions -> FilterColumn
ColorFilter ColorFilterOptions :: Bool -> Maybe Int -> ColorFilterOptions
ColorFilterOptions {Bool
Maybe Int
_cfoDxfId :: Maybe Int
_cfoCellColor :: Bool
_cfoDxfId :: Maybe Int
_cfoCellColor :: Bool
..}
                 | Node
n Node -> Name -> Bool
`nodeElNameIs` (Text -> Name
n_ Text
"customFilters") = do
                     Bool
isAnd <- Name -> Bool -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"and" Bool
False Cursor
cur
                     let cFilters :: [CustomFilter]
cFilters = Cursor
cur Cursor -> (Cursor -> [CustomFilter]) -> [CustomFilter]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"customFilter") Axis -> (Cursor -> [CustomFilter]) -> Cursor -> [CustomFilter]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \Cursor
c -> do
                           CustomFilterOperator
op <- Name -> CustomFilterOperator -> Cursor -> [CustomFilterOperator]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"operator" CustomFilterOperator
FltrEqual Cursor
c
                           Text
val <- Name -> Cursor -> [Text]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"val" Cursor
c
                           CustomFilter -> [CustomFilter]
forall (m :: * -> *) a. Monad m => a -> m a
return (CustomFilter -> [CustomFilter]) -> CustomFilter -> [CustomFilter]
forall a b. (a -> b) -> a -> b
$ CustomFilterOperator -> Text -> CustomFilter
CustomFilter CustomFilterOperator
op Text
val
                     case [CustomFilter]
cFilters of
                       [CustomFilter
f] ->
                         FilterColumn -> [FilterColumn]
forall (m :: * -> *) a. Monad m => a -> m a
return (FilterColumn -> [FilterColumn]) -> FilterColumn -> [FilterColumn]
forall a b. (a -> b) -> a -> b
$ CustomFilter -> FilterColumn
ACustomFilter CustomFilter
f
                       [CustomFilter
f1, CustomFilter
f2] ->
                         if Bool
isAnd
                           then FilterColumn -> [FilterColumn]
forall (m :: * -> *) a. Monad m => a -> m a
return (FilterColumn -> [FilterColumn]) -> FilterColumn -> [FilterColumn]
forall a b. (a -> b) -> a -> b
$ CustomFilter -> CustomFilter -> FilterColumn
CustomFiltersAnd CustomFilter
f1 CustomFilter
f2
                           else FilterColumn -> [FilterColumn]
forall (m :: * -> *) a. Monad m => a -> m a
return (FilterColumn -> [FilterColumn]) -> FilterColumn -> [FilterColumn]
forall a b. (a -> b) -> a -> b
$ CustomFilter -> CustomFilter -> FilterColumn
CustomFiltersOr CustomFilter
f1 CustomFilter
f2
                       [CustomFilter]
_ ->
                         String -> [FilterColumn]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"bad custom filter"
                 | Node
n Node -> Name -> Bool
`nodeElNameIs` (Text -> Name
n_ Text
"dynamicFilter") = do
                     DynFilterType
_dfoType <- Name -> Cursor -> [DynFilterType]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"type" Cursor
cur
                     Maybe Double
_dfoVal <- Name -> Cursor -> [Maybe Double]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"val" Cursor
cur
                     Maybe Double
_dfoMaxVal <- Name -> Cursor -> [Maybe Double]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"maxVal" Cursor
cur
                     FilterColumn -> [FilterColumn]
forall (m :: * -> *) a. Monad m => a -> m a
return (FilterColumn -> [FilterColumn]) -> FilterColumn -> [FilterColumn]
forall a b. (a -> b) -> a -> b
$ DynFilterOptions -> FilterColumn
DynamicFilter DynFilterOptions :: DynFilterType -> Maybe Double -> Maybe Double -> DynFilterOptions
DynFilterOptions{Maybe Double
DynFilterType
_dfoMaxVal :: Maybe Double
_dfoVal :: Maybe Double
_dfoType :: DynFilterType
_dfoMaxVal :: Maybe Double
_dfoVal :: Maybe Double
_dfoType :: DynFilterType
..}
                 | Node
n Node -> Name -> Bool
`nodeElNameIs` (Text -> Name
n_ Text
"iconFilter") = do
                     Maybe Int
iconId <- Name -> Cursor -> [Maybe Int]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"iconId" Cursor
cur
                     IconSetType
iconSet <- Name -> Cursor -> [IconSetType]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"iconSet" Cursor
cur
                     FilterColumn -> [FilterColumn]
forall (m :: * -> *) a. Monad m => a -> m a
return (FilterColumn -> [FilterColumn]) -> FilterColumn -> [FilterColumn]
forall a b. (a -> b) -> a -> b
$ Maybe Int -> IconSetType -> FilterColumn
IconFilter Maybe Int
iconId IconSetType
iconSet
                 | Node
n Node -> Name -> Bool
`nodeElNameIs` (Text -> Name
n_ Text
"top10") = do
                     Bool
top <- Name -> Bool -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"top" Bool
True Cursor
cur
                     let percent :: [Bool]
percent = Name -> Bool -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"percent" Bool
False Cursor
cur
                         val :: [Double]
val = Name -> Cursor -> [Double]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"val" Cursor
cur
                         filterVal :: [Maybe Double]
filterVal = Name -> Cursor -> [Maybe Double]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"filterVal" Cursor
cur
                     if Bool
top
                       then (EdgeFilterOptions -> FilterColumn)
-> [EdgeFilterOptions] -> [FilterColumn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EdgeFilterOptions -> FilterColumn
TopNFilter ([EdgeFilterOptions] -> [FilterColumn])
-> [EdgeFilterOptions] -> [FilterColumn]
forall a b. (a -> b) -> a -> b
$
                            Bool -> Double -> Maybe Double -> EdgeFilterOptions
EdgeFilterOptions (Bool -> Double -> Maybe Double -> EdgeFilterOptions)
-> [Bool] -> [Double -> Maybe Double -> EdgeFilterOptions]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bool]
percent [Double -> Maybe Double -> EdgeFilterOptions]
-> [Double] -> [Maybe Double -> EdgeFilterOptions]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Double]
val [Maybe Double -> EdgeFilterOptions]
-> [Maybe Double] -> [EdgeFilterOptions]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Maybe Double]
filterVal
                       else (EdgeFilterOptions -> FilterColumn)
-> [EdgeFilterOptions] -> [FilterColumn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EdgeFilterOptions -> FilterColumn
BottomNFilter ([EdgeFilterOptions] -> [FilterColumn])
-> [EdgeFilterOptions] -> [FilterColumn]
forall a b. (a -> b) -> a -> b
$
                            Bool -> Double -> Maybe Double -> EdgeFilterOptions
EdgeFilterOptions (Bool -> Double -> Maybe Double -> EdgeFilterOptions)
-> [Bool] -> [Double -> Maybe Double -> EdgeFilterOptions]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bool]
percent [Double -> Maybe Double -> EdgeFilterOptions]
-> [Double] -> [Maybe Double -> EdgeFilterOptions]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Double]
val [Maybe Double -> EdgeFilterOptions]
-> [Maybe Double] -> [EdgeFilterOptions]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Maybe Double]
filterVal
                 | Bool
otherwise = String -> [FilterColumn]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"no matching nodes"
  where
    cur :: Cursor
cur = Node -> Cursor
fromNode Node
n

instance FromCursor FilterCriterion where
  fromCursor :: Cursor -> [FilterCriterion]
fromCursor = Node -> [FilterCriterion]
filterCriterionFromNode (Node -> [FilterCriterion])
-> (Cursor -> Node) -> Cursor -> [FilterCriterion]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cursor -> Node
forall node. Cursor node -> node
node

instance FromXenoNode FilterCriterion where
  fromXenoNode :: Node -> Either Text FilterCriterion
fromXenoNode Node
root =
    case Node -> ByteString
Xeno.name Node
root of
      ByteString
"filter" -> Node -> AttrParser FilterCriterion -> Either Text FilterCriterion
forall a. Node -> AttrParser a -> Either Text a
parseAttributes Node
root (AttrParser FilterCriterion -> Either Text FilterCriterion)
-> AttrParser FilterCriterion -> Either Text FilterCriterion
forall a b. (a -> b) -> a -> b
$ do Text -> FilterCriterion
FilterValue (Text -> FilterCriterion)
-> AttrParser Text -> AttrParser FilterCriterion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> AttrParser Text
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"val"
      ByteString
"dateGroupItem" ->
        Node -> AttrParser FilterCriterion -> Either Text FilterCriterion
forall a. Node -> AttrParser a -> Either Text a
parseAttributes Node
root (AttrParser FilterCriterion -> Either Text FilterCriterion)
-> AttrParser FilterCriterion -> Either Text FilterCriterion
forall a b. (a -> b) -> a -> b
$ do
          ByteString
grouping <- ByteString -> AttrParser ByteString
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"dateTimeGrouping"
          DateGroup
group <- case ByteString
grouping of
            (ByteString
"year" :: ByteString) ->
              Int -> DateGroup
DateGroupByYear (Int -> DateGroup) -> AttrParser Int -> AttrParser DateGroup
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> AttrParser Int
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"year"
            ByteString
"month" ->
              Int -> Int -> DateGroup
DateGroupByMonth (Int -> Int -> DateGroup)
-> AttrParser Int -> AttrParser (Int -> DateGroup)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> AttrParser Int
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"year"
                               AttrParser (Int -> DateGroup)
-> AttrParser Int -> AttrParser DateGroup
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> AttrParser Int
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"month"
            ByteString
"day" ->
              Int -> Int -> Int -> DateGroup
DateGroupByDay (Int -> Int -> Int -> DateGroup)
-> AttrParser Int -> AttrParser (Int -> Int -> DateGroup)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> AttrParser Int
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"year"
                             AttrParser (Int -> Int -> DateGroup)
-> AttrParser Int -> AttrParser (Int -> DateGroup)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> AttrParser Int
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"month"
                             AttrParser (Int -> DateGroup)
-> AttrParser Int -> AttrParser DateGroup
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> AttrParser Int
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"day"
            ByteString
"hour" ->
              Int -> Int -> Int -> Int -> DateGroup
DateGroupByHour (Int -> Int -> Int -> Int -> DateGroup)
-> AttrParser Int -> AttrParser (Int -> Int -> Int -> DateGroup)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> AttrParser Int
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"year"
                              AttrParser (Int -> Int -> Int -> DateGroup)
-> AttrParser Int -> AttrParser (Int -> Int -> DateGroup)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> AttrParser Int
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"month"
                              AttrParser (Int -> Int -> DateGroup)
-> AttrParser Int -> AttrParser (Int -> DateGroup)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> AttrParser Int
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"day"
                              AttrParser (Int -> DateGroup)
-> AttrParser Int -> AttrParser DateGroup
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> AttrParser Int
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"hour"
            ByteString
"minute" ->
              Int -> Int -> Int -> Int -> Int -> DateGroup
DateGroupByMinute (Int -> Int -> Int -> Int -> Int -> DateGroup)
-> AttrParser Int
-> AttrParser (Int -> Int -> Int -> Int -> DateGroup)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> AttrParser Int
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"year"
                                AttrParser (Int -> Int -> Int -> Int -> DateGroup)
-> AttrParser Int -> AttrParser (Int -> Int -> Int -> DateGroup)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> AttrParser Int
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"month"
                                AttrParser (Int -> Int -> Int -> DateGroup)
-> AttrParser Int -> AttrParser (Int -> Int -> DateGroup)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> AttrParser Int
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"day"
                                AttrParser (Int -> Int -> DateGroup)
-> AttrParser Int -> AttrParser (Int -> DateGroup)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> AttrParser Int
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"hour"
                                AttrParser (Int -> DateGroup)
-> AttrParser Int -> AttrParser DateGroup
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> AttrParser Int
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"minute"
            ByteString
"second" ->
              Int -> Int -> Int -> Int -> Int -> Int -> DateGroup
DateGroupBySecond (Int -> Int -> Int -> Int -> Int -> Int -> DateGroup)
-> AttrParser Int
-> AttrParser (Int -> Int -> Int -> Int -> Int -> DateGroup)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> AttrParser Int
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"year"
                                AttrParser (Int -> Int -> Int -> Int -> Int -> DateGroup)
-> AttrParser Int
-> AttrParser (Int -> Int -> Int -> Int -> DateGroup)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> AttrParser Int
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"month"
                                AttrParser (Int -> Int -> Int -> Int -> DateGroup)
-> AttrParser Int -> AttrParser (Int -> Int -> Int -> DateGroup)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> AttrParser Int
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"day"
                                AttrParser (Int -> Int -> Int -> DateGroup)
-> AttrParser Int -> AttrParser (Int -> Int -> DateGroup)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> AttrParser Int
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"hour"
                                AttrParser (Int -> Int -> DateGroup)
-> AttrParser Int -> AttrParser (Int -> DateGroup)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> AttrParser Int
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"minute"
                                AttrParser (Int -> DateGroup)
-> AttrParser Int -> AttrParser DateGroup
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> AttrParser Int
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"second"
            ByteString
_ -> Either Text DateGroup -> AttrParser DateGroup
forall a. Either Text a -> AttrParser a
toAttrParser (Either Text DateGroup -> AttrParser DateGroup)
-> (Text -> Either Text DateGroup) -> Text -> AttrParser DateGroup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text DateGroup
forall a b. a -> Either a b
Left (Text -> AttrParser DateGroup) -> Text -> AttrParser DateGroup
forall a b. (a -> b) -> a -> b
$ Text
"Unexpected date grouping"
          FilterCriterion -> AttrParser FilterCriterion
forall (m :: * -> *) a. Monad m => a -> m a
return (FilterCriterion -> AttrParser FilterCriterion)
-> FilterCriterion -> AttrParser FilterCriterion
forall a b. (a -> b) -> a -> b
$ DateGroup -> FilterCriterion
FilterDateGroup DateGroup
group
      ByteString
_ -> Text -> Either Text FilterCriterion
forall a b. a -> Either a b
Left Text
"Bad FilterCriterion"

-- TODO: follow the spec about the fact that dategroupitem always go after filter
filterCriterionFromNode :: Node -> [FilterCriterion]
filterCriterionFromNode :: Node -> [FilterCriterion]
filterCriterionFromNode Node
n
  | Node
n Node -> Name -> Bool
`nodeElNameIs` (Text -> Name
n_ Text
"filter") = do
    Text
v <- Name -> Cursor -> [Text]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"val" Cursor
cur
    FilterCriterion -> [FilterCriterion]
forall (m :: * -> *) a. Monad m => a -> m a
return (FilterCriterion -> [FilterCriterion])
-> FilterCriterion -> [FilterCriterion]
forall a b. (a -> b) -> a -> b
$ Text -> FilterCriterion
FilterValue Text
v
  | Node
n Node -> Name -> Bool
`nodeElNameIs` (Text -> Name
n_ Text
"dateGroupItem") = do
    Text
g <- Name -> Cursor -> [Text]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"dateTimeGrouping" Cursor
cur
    let year :: [Int]
year = Name -> Cursor -> [Int]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"year" Cursor
cur
        month :: [Int]
month = Name -> Cursor -> [Int]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"month" Cursor
cur
        day :: [Int]
day = Name -> Cursor -> [Int]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"day" Cursor
cur
        hour :: [Int]
hour = Name -> Cursor -> [Int]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"hour" Cursor
cur
        minute :: [Int]
minute = Name -> Cursor -> [Int]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"minute" Cursor
cur
        second :: [Int]
second = Name -> Cursor -> [Int]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"second" Cursor
cur
    DateGroup -> FilterCriterion
FilterDateGroup (DateGroup -> FilterCriterion) -> [DateGroup] -> [FilterCriterion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      case Text
g of
        Text
"year" -> Int -> DateGroup
DateGroupByYear (Int -> DateGroup) -> [Int] -> [DateGroup]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int]
year
        Text
"month" -> Int -> Int -> DateGroup
DateGroupByMonth (Int -> Int -> DateGroup) -> [Int] -> [Int -> DateGroup]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int]
year [Int -> DateGroup] -> [Int] -> [DateGroup]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Int]
month
        Text
"day" -> Int -> Int -> Int -> DateGroup
DateGroupByDay (Int -> Int -> Int -> DateGroup)
-> [Int] -> [Int -> Int -> DateGroup]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int]
year [Int -> Int -> DateGroup] -> [Int] -> [Int -> DateGroup]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Int]
month [Int -> DateGroup] -> [Int] -> [DateGroup]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Int]
day
        Text
"hour" -> Int -> Int -> Int -> Int -> DateGroup
DateGroupByHour (Int -> Int -> Int -> Int -> DateGroup)
-> [Int] -> [Int -> Int -> Int -> DateGroup]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int]
year [Int -> Int -> Int -> DateGroup]
-> [Int] -> [Int -> Int -> DateGroup]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Int]
month [Int -> Int -> DateGroup] -> [Int] -> [Int -> DateGroup]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Int]
day [Int -> DateGroup] -> [Int] -> [DateGroup]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Int]
hour
        Text
"minute" ->
          Int -> Int -> Int -> Int -> Int -> DateGroup
DateGroupByMinute (Int -> Int -> Int -> Int -> Int -> DateGroup)
-> [Int] -> [Int -> Int -> Int -> Int -> DateGroup]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int]
year [Int -> Int -> Int -> Int -> DateGroup]
-> [Int] -> [Int -> Int -> Int -> DateGroup]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Int]
month [Int -> Int -> Int -> DateGroup]
-> [Int] -> [Int -> Int -> DateGroup]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Int]
day [Int -> Int -> DateGroup] -> [Int] -> [Int -> DateGroup]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Int]
hour [Int -> DateGroup] -> [Int] -> [DateGroup]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Int]
minute
        Text
"second" ->
          Int -> Int -> Int -> Int -> Int -> Int -> DateGroup
DateGroupBySecond (Int -> Int -> Int -> Int -> Int -> Int -> DateGroup)
-> [Int] -> [Int -> Int -> Int -> Int -> Int -> DateGroup]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int]
year [Int -> Int -> Int -> Int -> Int -> DateGroup]
-> [Int] -> [Int -> Int -> Int -> Int -> DateGroup]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Int]
month [Int -> Int -> Int -> Int -> DateGroup]
-> [Int] -> [Int -> Int -> Int -> DateGroup]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Int]
day [Int -> Int -> Int -> DateGroup]
-> [Int] -> [Int -> Int -> DateGroup]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Int]
hour [Int -> Int -> DateGroup] -> [Int] -> [Int -> DateGroup]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Int]
minute [Int -> DateGroup] -> [Int] -> [DateGroup]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
          [Int]
second
        Text
_ -> String -> [DateGroup]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> [DateGroup]) -> String -> [DateGroup]
forall a b. (a -> b) -> a -> b
$ String
"unexpected dateTimeGrouping " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show (Text
g :: Text)
  | Bool
otherwise = String -> [FilterCriterion]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"no matching nodes"
  where
    cur :: Cursor
cur = Node -> Cursor
fromNode Node
n

instance FromAttrVal CustomFilterOperator where
  fromAttrVal :: Reader CustomFilterOperator
fromAttrVal Text
"equal" = CustomFilterOperator -> Either String (CustomFilterOperator, Text)
forall a. a -> Either String (a, Text)
readSuccess CustomFilterOperator
FltrEqual
  fromAttrVal Text
"greaterThan" = CustomFilterOperator -> Either String (CustomFilterOperator, Text)
forall a. a -> Either String (a, Text)
readSuccess CustomFilterOperator
FltrGreaterThan
  fromAttrVal Text
"greaterThanOrEqual" = CustomFilterOperator -> Either String (CustomFilterOperator, Text)
forall a. a -> Either String (a, Text)
readSuccess CustomFilterOperator
FltrGreaterThanOrEqual
  fromAttrVal Text
"lessThan" = CustomFilterOperator -> Either String (CustomFilterOperator, Text)
forall a. a -> Either String (a, Text)
readSuccess CustomFilterOperator
FltrLessThan
  fromAttrVal Text
"lessThanOrEqual" = CustomFilterOperator -> Either String (CustomFilterOperator, Text)
forall a. a -> Either String (a, Text)
readSuccess CustomFilterOperator
FltrLessThanOrEqual
  fromAttrVal Text
"notEqual" = CustomFilterOperator -> Either String (CustomFilterOperator, Text)
forall a. a -> Either String (a, Text)
readSuccess CustomFilterOperator
FltrNotEqual
  fromAttrVal Text
t = Text -> Reader CustomFilterOperator
forall a. Text -> Text -> Either String (a, Text)
invalidText Text
"CustomFilterOperator" Text
t

instance FromAttrBs CustomFilterOperator where
  fromAttrBs :: ByteString -> Either Text CustomFilterOperator
fromAttrBs ByteString
"equal" = CustomFilterOperator -> Either Text CustomFilterOperator
forall (m :: * -> *) a. Monad m => a -> m a
return CustomFilterOperator
FltrEqual
  fromAttrBs ByteString
"greaterThan" = CustomFilterOperator -> Either Text CustomFilterOperator
forall (m :: * -> *) a. Monad m => a -> m a
return CustomFilterOperator
FltrGreaterThan
  fromAttrBs ByteString
"greaterThanOrEqual" = CustomFilterOperator -> Either Text CustomFilterOperator
forall (m :: * -> *) a. Monad m => a -> m a
return CustomFilterOperator
FltrGreaterThanOrEqual
  fromAttrBs ByteString
"lessThan" = CustomFilterOperator -> Either Text CustomFilterOperator
forall (m :: * -> *) a. Monad m => a -> m a
return CustomFilterOperator
FltrLessThan
  fromAttrBs ByteString
"lessThanOrEqual" = CustomFilterOperator -> Either Text CustomFilterOperator
forall (m :: * -> *) a. Monad m => a -> m a
return CustomFilterOperator
FltrLessThanOrEqual
  fromAttrBs ByteString
"notEqual" = CustomFilterOperator -> Either Text CustomFilterOperator
forall (m :: * -> *) a. Monad m => a -> m a
return CustomFilterOperator
FltrNotEqual
  fromAttrBs ByteString
x = Text -> ByteString -> Either Text CustomFilterOperator
forall a. Text -> ByteString -> Either Text a
unexpectedAttrBs Text
"CustomFilterOperator" ByteString
x

instance FromAttrVal FilterByBlank where
  fromAttrVal :: Reader FilterByBlank
fromAttrVal =
    ((Bool, Text) -> (FilterByBlank, Text))
-> Either String (Bool, Text)
-> Either String (FilterByBlank, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Bool -> FilterByBlank) -> (Bool, Text) -> (FilterByBlank, Text)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((Bool -> FilterByBlank) -> (Bool, Text) -> (FilterByBlank, Text))
-> (Bool -> FilterByBlank) -> (Bool, Text) -> (FilterByBlank, Text)
forall a b. (a -> b) -> a -> b
$ FilterByBlank -> FilterByBlank -> Bool -> FilterByBlank
forall a. a -> a -> Bool -> a
bool FilterByBlank
DontFilterByBlank FilterByBlank
FilterByBlank) (Either String (Bool, Text) -> Either String (FilterByBlank, Text))
-> (Text -> Either String (Bool, Text)) -> Reader FilterByBlank
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String (Bool, Text)
forall a. FromAttrVal a => Reader a
fromAttrVal

instance FromAttrBs FilterByBlank where
  fromAttrBs :: ByteString -> Either Text FilterByBlank
fromAttrBs = (Bool -> FilterByBlank)
-> Either Text Bool -> Either Text FilterByBlank
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilterByBlank -> FilterByBlank -> Bool -> FilterByBlank
forall a. a -> a -> Bool -> a
bool FilterByBlank
DontFilterByBlank FilterByBlank
FilterByBlank) (Either Text Bool -> Either Text FilterByBlank)
-> (ByteString -> Either Text Bool)
-> ByteString
-> Either Text FilterByBlank
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either Text Bool
forall a. FromAttrBs a => ByteString -> Either Text a
fromAttrBs

instance FromAttrVal DynFilterType where
  fromAttrVal :: Reader DynFilterType
fromAttrVal Text
"aboveAverage" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterAboveAverage
  fromAttrVal Text
"belowAverage" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterBelowAverage
  fromAttrVal Text
"lastMonth" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterLastMonth
  fromAttrVal Text
"lastQuarter" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterLastQuarter
  fromAttrVal Text
"lastWeek" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterLastWeek
  fromAttrVal Text
"lastYear" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterLastYear
  fromAttrVal Text
"M1" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterM1
  fromAttrVal Text
"M10" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterM10
  fromAttrVal Text
"M11" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterM11
  fromAttrVal Text
"M12" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterM12
  fromAttrVal Text
"M2" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterM2
  fromAttrVal Text
"M3" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterM3
  fromAttrVal Text
"M4" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterM4
  fromAttrVal Text
"M5" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterM5
  fromAttrVal Text
"M6" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterM6
  fromAttrVal Text
"M7" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterM7
  fromAttrVal Text
"M8" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterM8
  fromAttrVal Text
"M9" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterM9
  fromAttrVal Text
"nextMonth" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterNextMonth
  fromAttrVal Text
"nextQuarter" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterNextQuarter
  fromAttrVal Text
"nextWeek" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterNextWeek
  fromAttrVal Text
"nextYear" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterNextYear
  fromAttrVal Text
"null" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterNull
  fromAttrVal Text
"Q1" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterQ1
  fromAttrVal Text
"Q2" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterQ2
  fromAttrVal Text
"Q3" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterQ3
  fromAttrVal Text
"Q4" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterQ4
  fromAttrVal Text
"thisMonth" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterThisMonth
  fromAttrVal Text
"thisQuarter" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterThisQuarter
  fromAttrVal Text
"thisWeek" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterThisWeek
  fromAttrVal Text
"thisYear" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterThisYear
  fromAttrVal Text
"today" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterToday
  fromAttrVal Text
"tomorrow" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterTomorrow
  fromAttrVal Text
"yearToDate" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterYearToDate
  fromAttrVal Text
"yesterday" = DynFilterType -> Either String (DynFilterType, Text)
forall a. a -> Either String (a, Text)
readSuccess DynFilterType
DynFilterYesterday
  fromAttrVal Text
t = Text -> Reader DynFilterType
forall a. Text -> Text -> Either String (a, Text)
invalidText Text
"DynFilterType" Text
t

instance FromAttrBs DynFilterType where
  fromAttrBs :: ByteString -> Either Text DynFilterType
fromAttrBs ByteString
"aboveAverage" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterAboveAverage
  fromAttrBs ByteString
"belowAverage" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterBelowAverage
  fromAttrBs ByteString
"lastMonth" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterLastMonth
  fromAttrBs ByteString
"lastQuarter" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterLastQuarter
  fromAttrBs ByteString
"lastWeek" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterLastWeek
  fromAttrBs ByteString
"lastYear" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterLastYear
  fromAttrBs ByteString
"M1" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterM1
  fromAttrBs ByteString
"M10" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterM10
  fromAttrBs ByteString
"M11" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterM11
  fromAttrBs ByteString
"M12" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterM12
  fromAttrBs ByteString
"M2" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterM2
  fromAttrBs ByteString
"M3" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterM3
  fromAttrBs ByteString
"M4" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterM4
  fromAttrBs ByteString
"M5" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterM5
  fromAttrBs ByteString
"M6" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterM6
  fromAttrBs ByteString
"M7" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterM7
  fromAttrBs ByteString
"M8" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterM8
  fromAttrBs ByteString
"M9" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterM9
  fromAttrBs ByteString
"nextMonth" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterNextMonth
  fromAttrBs ByteString
"nextQuarter" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterNextQuarter
  fromAttrBs ByteString
"nextWeek" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterNextWeek
  fromAttrBs ByteString
"nextYear" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterNextYear
  fromAttrBs ByteString
"null" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterNull
  fromAttrBs ByteString
"Q1" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterQ1
  fromAttrBs ByteString
"Q2" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterQ2
  fromAttrBs ByteString
"Q3" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterQ3
  fromAttrBs ByteString
"Q4" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterQ4
  fromAttrBs ByteString
"thisMonth" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterThisMonth
  fromAttrBs ByteString
"thisQuarter" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterThisQuarter
  fromAttrBs ByteString
"thisWeek" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterThisWeek
  fromAttrBs ByteString
"thisYear" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterThisYear
  fromAttrBs ByteString
"today" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterToday
  fromAttrBs ByteString
"tomorrow" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterTomorrow
  fromAttrBs ByteString
"yearToDate" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterYearToDate
  fromAttrBs ByteString
"yesterday" = DynFilterType -> Either Text DynFilterType
forall (m :: * -> *) a. Monad m => a -> m a
return DynFilterType
DynFilterYesterday
  fromAttrBs ByteString
x = Text -> ByteString -> Either Text DynFilterType
forall a. Text -> ByteString -> Either Text a
unexpectedAttrBs Text
"DynFilterType" ByteString
x

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

instance ToElement AutoFilter where
  toElement :: Name -> AutoFilter -> Element
toElement Name
nm AutoFilter {Maybe CellRef
Map Int FilterColumn
_afFilterColumns :: Map Int FilterColumn
_afRef :: Maybe CellRef
_afFilterColumns :: AutoFilter -> Map Int FilterColumn
_afRef :: AutoFilter -> Maybe CellRef
..} =
    Name -> [(Name, Text)] -> [Element] -> Element
elementList
      Name
nm
      ([Maybe (Name, Text)] -> [(Name, Text)]
forall a. [Maybe a] -> [a]
catMaybes [Name
"ref" Name -> Maybe CellRef -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe CellRef
_afRef])
      [ Name -> [(Name, Text)] -> [Element] -> Element
elementList
        (Text -> Name
n_ Text
"filterColumn")
        [Name
"colId" Name -> Int -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Int
colId]
        [FilterColumn -> Element
fltColToElement FilterColumn
fCol]
      | (Int
colId, FilterColumn
fCol) <- Map Int FilterColumn -> [(Int, FilterColumn)]
forall k a. Map k a -> [(k, a)]
M.toList Map Int FilterColumn
_afFilterColumns
      ]

fltColToElement :: FilterColumn -> Element
fltColToElement :: FilterColumn -> Element
fltColToElement (Filters FilterByBlank
filterBlank [FilterCriterion]
filterCriteria) =
  let attrs :: [(Name, Text)]
attrs = [Maybe (Name, Text)] -> [(Name, Text)]
forall a. [Maybe a] -> [a]
catMaybes [Name
"blank" Name -> Maybe FilterByBlank -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? FilterByBlank -> FilterByBlank -> Maybe FilterByBlank
forall a. Eq a => a -> a -> Maybe a
justNonDef FilterByBlank
DontFilterByBlank FilterByBlank
filterBlank]
  in Name -> [(Name, Text)] -> [Element] -> Element
elementList
     (Text -> Name
n_ Text
"filters") [(Name, Text)]
attrs ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ (FilterCriterion -> Element) -> [FilterCriterion] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map FilterCriterion -> Element
filterCriterionToElement [FilterCriterion]
filterCriteria
fltColToElement (ColorFilter ColorFilterOptions
opts) = Name -> ColorFilterOptions -> Element
forall a. ToElement a => Name -> a -> Element
toElement (Text -> Name
n_ Text
"colorFilter") ColorFilterOptions
opts
fltColToElement (ACustomFilter CustomFilter
f) =
  Name -> [Element] -> Element
elementListSimple (Text -> Name
n_ Text
"customFilters") [Name -> CustomFilter -> Element
forall a. ToElement a => Name -> a -> Element
toElement (Text -> Name
n_ Text
"customFilter") CustomFilter
f]
fltColToElement (CustomFiltersOr CustomFilter
f1 CustomFilter
f2) =
  Name -> [Element] -> Element
elementListSimple
    (Text -> Name
n_ Text
"customFilters")
    [Name -> CustomFilter -> Element
forall a. ToElement a => Name -> a -> Element
toElement (Text -> Name
n_ Text
"customFilter") CustomFilter
f | CustomFilter
f <- [CustomFilter
f1, CustomFilter
f2]]
fltColToElement (CustomFiltersAnd CustomFilter
f1 CustomFilter
f2) =
  Name -> [(Name, Text)] -> [Element] -> Element
elementList
    (Text -> Name
n_ Text
"customFilters")
    [Name
"and" Name -> Bool -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Bool
True]
    [Name -> CustomFilter -> Element
forall a. ToElement a => Name -> a -> Element
toElement (Text -> Name
n_ Text
"customFilter") CustomFilter
f | CustomFilter
f <- [CustomFilter
f1, CustomFilter
f2]]
fltColToElement (DynamicFilter DynFilterOptions
opts) = Name -> DynFilterOptions -> Element
forall a. ToElement a => Name -> a -> Element
toElement (Text -> Name
n_ Text
"dynamicFilter") DynFilterOptions
opts
fltColToElement (IconFilter Maybe Int
iconId IconSetType
iconSet) =
  Name -> [(Name, Text)] -> Element
leafElement (Text -> Name
n_ Text
"iconFilter") ([(Name, Text)] -> Element) -> [(Name, Text)] -> Element
forall a b. (a -> b) -> a -> b
$
  [Name
"iconSet" Name -> IconSetType -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= IconSetType
iconSet] [(Name, Text)] -> [(Name, Text)] -> [(Name, Text)]
forall a. [a] -> [a] -> [a]
++ [Maybe (Name, Text)] -> [(Name, Text)]
forall a. [Maybe a] -> [a]
catMaybes [Name
"iconId" Name -> Maybe Int -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Int
iconId]
fltColToElement (BottomNFilter EdgeFilterOptions
opts) = Bool -> EdgeFilterOptions -> Element
edgeFilter Bool
False EdgeFilterOptions
opts
fltColToElement (TopNFilter EdgeFilterOptions
opts) = Bool -> EdgeFilterOptions -> Element
edgeFilter Bool
True EdgeFilterOptions
opts

edgeFilter :: Bool -> EdgeFilterOptions -> Element
edgeFilter :: Bool -> EdgeFilterOptions -> Element
edgeFilter Bool
top EdgeFilterOptions {Bool
Double
Maybe Double
_efoFilterVal :: Maybe Double
_efoVal :: Double
_efoUsePercents :: Bool
_efoFilterVal :: EdgeFilterOptions -> Maybe Double
_efoVal :: EdgeFilterOptions -> Double
_efoUsePercents :: EdgeFilterOptions -> Bool
..} =
  Name -> [(Name, Text)] -> Element
leafElement (Text -> Name
n_ Text
"top10") ([(Name, Text)] -> Element) -> [(Name, Text)] -> Element
forall a b. (a -> b) -> a -> b
$
  [Name
"top" Name -> Bool -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Bool
top, Name
"percent" Name -> Bool -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Bool
_efoUsePercents, Name
"val" Name -> Double -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Double
_efoVal] [(Name, Text)] -> [(Name, Text)] -> [(Name, Text)]
forall a. [a] -> [a] -> [a]
++
  [Maybe (Name, Text)] -> [(Name, Text)]
forall a. [Maybe a] -> [a]
catMaybes [Name
"filterVal" Name -> Maybe Double -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Double
_efoFilterVal]

filterCriterionToElement :: FilterCriterion -> Element
filterCriterionToElement :: FilterCriterion -> Element
filterCriterionToElement (FilterValue Text
v) =
  Name -> [(Name, Text)] -> Element
leafElement (Text -> Name
n_ Text
"filter") [Name
"val" Name -> Text -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Text
v]
filterCriterionToElement (FilterDateGroup (DateGroupByYear Int
y)) =
  Name -> [(Name, Text)] -> Element
leafElement
    (Text -> Name
n_ Text
"dateGroupItem")
    [Name
"dateTimeGrouping" Name -> Text -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= (Text
"year" :: Text), Name
"year" Name -> Int -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Int
y]
filterCriterionToElement (FilterDateGroup (DateGroupByMonth Int
y Int
m)) =
  Name -> [(Name, Text)] -> Element
leafElement
    (Text -> Name
n_ Text
"dateGroupItem")
    [Name
"dateTimeGrouping" Name -> Text -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= (Text
"month" :: Text), Name
"year" Name -> Int -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Int
y, Name
"month" Name -> Int -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Int
m]
filterCriterionToElement (FilterDateGroup (DateGroupByDay Int
y Int
m Int
d)) =
  Name -> [(Name, Text)] -> Element
leafElement
    (Text -> Name
n_ Text
"dateGroupItem")
    [Name
"dateTimeGrouping" Name -> Text -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= (Text
"day" :: Text), Name
"year" Name -> Int -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Int
y, Name
"month" Name -> Int -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Int
m, Name
"day" Name -> Int -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Int
d]
filterCriterionToElement (FilterDateGroup (DateGroupByHour Int
y Int
m Int
d Int
h)) =
  Name -> [(Name, Text)] -> Element
leafElement
    (Text -> Name
n_ Text
"dateGroupItem")
    [ Name
"dateTimeGrouping" Name -> Text -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= (Text
"hour" :: Text)
    , Name
"year" Name -> Int -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Int
y
    , Name
"month" Name -> Int -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Int
m
    , Name
"day" Name -> Int -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Int
d
    , Name
"hour" Name -> Int -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Int
h
    ]
filterCriterionToElement (FilterDateGroup (DateGroupByMinute Int
y Int
m Int
d Int
h Int
mi)) =
  Name -> [(Name, Text)] -> Element
leafElement
    (Text -> Name
n_ Text
"dateGroupItem")
    [ Name
"dateTimeGrouping" Name -> Text -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= (Text
"minute" :: Text)
    , Name
"year" Name -> Int -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Int
y
    , Name
"month" Name -> Int -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Int
m
    , Name
"day" Name -> Int -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Int
d
    , Name
"hour" Name -> Int -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Int
h
    , Name
"minute" Name -> Int -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Int
mi
    ]
filterCriterionToElement (FilterDateGroup (DateGroupBySecond Int
y Int
m Int
d Int
h Int
mi Int
s)) =
  Name -> [(Name, Text)] -> Element
leafElement
    (Text -> Name
n_ Text
"dateGroupItem")
    [ Name
"dateTimeGrouping" Name -> Text -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= (Text
"second" :: Text)
    , Name
"year" Name -> Int -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Int
y
    , Name
"month" Name -> Int -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Int
m
    , Name
"day" Name -> Int -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Int
d
    , Name
"hour" Name -> Int -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Int
h
    , Name
"minute" Name -> Int -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Int
mi
    , Name
"second" Name -> Int -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Int
s
    ]

instance ToElement CustomFilter where
  toElement :: Name -> CustomFilter -> Element
toElement Name
nm CustomFilter {Text
CustomFilterOperator
cfltValue :: Text
cfltOperator :: CustomFilterOperator
cfltValue :: CustomFilter -> Text
cfltOperator :: CustomFilter -> CustomFilterOperator
..} =
    Name -> [(Name, Text)] -> Element
leafElement Name
nm [Name
"operator" Name -> CustomFilterOperator -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= CustomFilterOperator
cfltOperator, Name
"val" Name -> Text -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Text
cfltValue]

instance ToAttrVal CustomFilterOperator where
  toAttrVal :: CustomFilterOperator -> Text
toAttrVal CustomFilterOperator
FltrEqual = Text
"equal"
  toAttrVal CustomFilterOperator
FltrGreaterThan = Text
"greaterThan"
  toAttrVal CustomFilterOperator
FltrGreaterThanOrEqual = Text
"greaterThanOrEqual"
  toAttrVal CustomFilterOperator
FltrLessThan = Text
"lessThan"
  toAttrVal CustomFilterOperator
FltrLessThanOrEqual = Text
"lessThanOrEqual"
  toAttrVal CustomFilterOperator
FltrNotEqual = Text
"notEqual"

instance ToAttrVal FilterByBlank where
  toAttrVal :: FilterByBlank -> Text
toAttrVal FilterByBlank
FilterByBlank = Bool -> Text
forall a. ToAttrVal a => a -> Text
toAttrVal Bool
True
  toAttrVal FilterByBlank
DontFilterByBlank = Bool -> Text
forall a. ToAttrVal a => a -> Text
toAttrVal Bool
False

instance ToElement ColorFilterOptions where
  toElement :: Name -> ColorFilterOptions -> Element
toElement Name
nm ColorFilterOptions {Bool
Maybe Int
_cfoDxfId :: Maybe Int
_cfoCellColor :: Bool
_cfoDxfId :: ColorFilterOptions -> Maybe Int
_cfoCellColor :: ColorFilterOptions -> Bool
..} =
    Name -> [(Name, Text)] -> Element
leafElement Name
nm ([(Name, Text)] -> Element) -> [(Name, Text)] -> Element
forall a b. (a -> b) -> a -> b
$
    [Maybe (Name, Text)] -> [(Name, Text)]
forall a. [Maybe a] -> [a]
catMaybes [Name
"cellColor" Name -> Maybe Bool -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Bool -> Maybe Bool
justFalse Bool
_cfoCellColor, Name
"dxfId" Name -> Maybe Int -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Int
_cfoDxfId]

instance ToElement DynFilterOptions where
  toElement :: Name -> DynFilterOptions -> Element
toElement Name
nm DynFilterOptions {Maybe Double
DynFilterType
_dfoMaxVal :: Maybe Double
_dfoVal :: Maybe Double
_dfoType :: DynFilterType
_dfoMaxVal :: DynFilterOptions -> Maybe Double
_dfoVal :: DynFilterOptions -> Maybe Double
_dfoType :: DynFilterOptions -> DynFilterType
..} =
    Name -> [(Name, Text)] -> Element
leafElement Name
nm ([(Name, Text)] -> Element) -> [(Name, Text)] -> Element
forall a b. (a -> b) -> a -> b
$
    [Name
"type" Name -> DynFilterType -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= DynFilterType
_dfoType] [(Name, Text)] -> [(Name, Text)] -> [(Name, Text)]
forall a. [a] -> [a] -> [a]
++
    [Maybe (Name, Text)] -> [(Name, Text)]
forall a. [Maybe a] -> [a]
catMaybes [Name
"val" Name -> Maybe Double -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Double
_dfoVal, Name
"maxVal" Name -> Maybe Double -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Double
_dfoMaxVal]

instance ToAttrVal DynFilterType where
  toAttrVal :: DynFilterType -> Text
toAttrVal DynFilterType
DynFilterAboveAverage = Text
"aboveAverage"
  toAttrVal DynFilterType
DynFilterBelowAverage = Text
"belowAverage"
  toAttrVal DynFilterType
DynFilterLastMonth = Text
"lastMonth"
  toAttrVal DynFilterType
DynFilterLastQuarter = Text
"lastQuarter"
  toAttrVal DynFilterType
DynFilterLastWeek = Text
"lastWeek"
  toAttrVal DynFilterType
DynFilterLastYear = Text
"lastYear"
  toAttrVal DynFilterType
DynFilterM1 = Text
"M1"
  toAttrVal DynFilterType
DynFilterM10 = Text
"M10"
  toAttrVal DynFilterType
DynFilterM11 = Text
"M11"
  toAttrVal DynFilterType
DynFilterM12 = Text
"M12"
  toAttrVal DynFilterType
DynFilterM2 = Text
"M2"
  toAttrVal DynFilterType
DynFilterM3 = Text
"M3"
  toAttrVal DynFilterType
DynFilterM4 = Text
"M4"
  toAttrVal DynFilterType
DynFilterM5 = Text
"M5"
  toAttrVal DynFilterType
DynFilterM6 = Text
"M6"
  toAttrVal DynFilterType
DynFilterM7 = Text
"M7"
  toAttrVal DynFilterType
DynFilterM8 = Text
"M8"
  toAttrVal DynFilterType
DynFilterM9 = Text
"M9"
  toAttrVal DynFilterType
DynFilterNextMonth = Text
"nextMonth"
  toAttrVal DynFilterType
DynFilterNextQuarter = Text
"nextQuarter"
  toAttrVal DynFilterType
DynFilterNextWeek = Text
"nextWeek"
  toAttrVal DynFilterType
DynFilterNextYear = Text
"nextYear"
  toAttrVal DynFilterType
DynFilterNull = Text
"null"
  toAttrVal DynFilterType
DynFilterQ1 = Text
"Q1"
  toAttrVal DynFilterType
DynFilterQ2 = Text
"Q2"
  toAttrVal DynFilterType
DynFilterQ3 = Text
"Q3"
  toAttrVal DynFilterType
DynFilterQ4 = Text
"Q4"
  toAttrVal DynFilterType
DynFilterThisMonth = Text
"thisMonth"
  toAttrVal DynFilterType
DynFilterThisQuarter = Text
"thisQuarter"
  toAttrVal DynFilterType
DynFilterThisWeek = Text
"thisWeek"
  toAttrVal DynFilterType
DynFilterThisYear = Text
"thisYear"
  toAttrVal DynFilterType
DynFilterToday = Text
"today"
  toAttrVal DynFilterType
DynFilterTomorrow = Text
"tomorrow"
  toAttrVal DynFilterType
DynFilterYearToDate = Text
"yearToDate"
  toAttrVal DynFilterType
DynFilterYesterday = Text
"yesterday"