    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE DeriveGeneric #-}
    module Codec.Xlsx.Types.PivotTable.Internal
      ( CacheId(..)
      , CacheField(..)
      , CacheRecordValue(..)
      , CacheRecord
      , recordValueFromNode
      ) where

    import GHC.Generics (Generic)

    import Control.Arrow (first)
    import Data.Maybe (catMaybes)
    import Data.Text (Text)
    import Text.XML
    import Text.XML.Cursor

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

    newtype CacheId = CacheId Int deriving (CacheId -> CacheId -> Bool
    (CacheId -> CacheId -> Bool)
    -> (CacheId -> CacheId -> Bool) -> Eq CacheId
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: CacheId -> CacheId -> Bool
    == :: CacheId -> CacheId -> Bool
    $c/= :: CacheId -> CacheId -> Bool
    /= :: CacheId -> CacheId -> Bool
    Eq, (forall x. CacheId -> Rep CacheId x)
    -> (forall x. Rep CacheId x -> CacheId) -> Generic CacheId
    forall x. Rep CacheId x -> CacheId
    forall x. CacheId -> Rep CacheId x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. CacheId -> Rep CacheId x
    from :: forall x. CacheId -> Rep CacheId x
    $cto :: forall x. Rep CacheId x -> CacheId
    to :: forall x. Rep CacheId x -> CacheId
    Generic)

    data CacheField = CacheField
      { CacheField -> PivotFieldName
    cfName :: PivotFieldName
      , CacheField -> [CellValue]
    cfItems :: [CellValue]
      } deriving (CacheField -> CacheField -> Bool
    (CacheField -> CacheField -> Bool)
    -> (CacheField -> CacheField -> Bool) -> Eq CacheField
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: CacheField -> CacheField -> Bool
    == :: CacheField -> CacheField -> Bool
    $c/= :: CacheField -> CacheField -> Bool
    /= :: CacheField -> CacheField -> Bool
    Eq, Int -> CacheField -> ShowS
    [CacheField] -> ShowS
    CacheField -> String
    (Int -> CacheField -> ShowS)
    -> (CacheField -> String)
    -> ([CacheField] -> ShowS)
    -> Show CacheField
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> CacheField -> ShowS
    showsPrec :: Int -> CacheField -> ShowS
    $cshow :: CacheField -> String
    show :: CacheField -> String
    $cshowList :: [CacheField] -> ShowS
    showList :: [CacheField] -> ShowS
    Show, (forall x. CacheField -> Rep CacheField x)
    -> (forall x. Rep CacheField x -> CacheField) -> Generic CacheField
    forall x. Rep CacheField x -> CacheField
    forall x. CacheField -> Rep CacheField x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. CacheField -> Rep CacheField x
    from :: forall x. CacheField -> Rep CacheField x
    $cto :: forall x. Rep CacheField x -> CacheField
    to :: forall x. Rep CacheField x -> CacheField
    Generic)

    data CacheRecordValue
      = CacheText Text
      | CacheNumber Double
      | CacheIndex Int
      deriving (CacheRecordValue -> CacheRecordValue -> Bool
    (CacheRecordValue -> CacheRecordValue -> Bool)
    -> (CacheRecordValue -> CacheRecordValue -> Bool)
    -> Eq CacheRecordValue
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: CacheRecordValue -> CacheRecordValue -> Bool
    == :: CacheRecordValue -> CacheRecordValue -> Bool
    $c/= :: CacheRecordValue -> CacheRecordValue -> Bool
    /= :: CacheRecordValue -> CacheRecordValue -> Bool
    Eq, Int -> CacheRecordValue -> ShowS
    [CacheRecordValue] -> ShowS
    CacheRecordValue -> String
    (Int -> CacheRecordValue -> ShowS)
    -> (CacheRecordValue -> String)
    -> ([CacheRecordValue] -> ShowS)
    -> Show CacheRecordValue
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> CacheRecordValue -> ShowS
    showsPrec :: Int -> CacheRecordValue -> ShowS
    $cshow :: CacheRecordValue -> String
    show :: CacheRecordValue -> String
    $cshowList :: [CacheRecordValue] -> ShowS
    showList :: [CacheRecordValue] -> ShowS
    Show, (forall x. CacheRecordValue -> Rep CacheRecordValue x)
    -> (forall x. Rep CacheRecordValue x -> CacheRecordValue)
    -> Generic CacheRecordValue
    forall x. Rep CacheRecordValue x -> CacheRecordValue
    forall x. CacheRecordValue -> Rep CacheRecordValue x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. CacheRecordValue -> Rep CacheRecordValue x
    from :: forall x. CacheRecordValue -> Rep CacheRecordValue x
    $cto :: forall x. Rep CacheRecordValue x -> CacheRecordValue
    to :: forall x. Rep CacheRecordValue x -> CacheRecordValue
    Generic)

    type CacheRecord = [CacheRecordValue]

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

    instance FromAttrVal CacheId where
      fromAttrVal :: Reader CacheId
    fromAttrVal = ((Int, Text) -> (CacheId, Text))
    -> Either String (Int, Text) -> Either String (CacheId, Text)
    forall a b. (a -> b) -> Either String a -> Either String b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Int -> CacheId) -> (Int, Text) -> (CacheId, Text)
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first Int -> CacheId
    CacheId) (Either String (Int, Text) -> Either String (CacheId, Text))
    -> (Text -> Either String (Int, Text)) -> Reader CacheId
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Either String (Int, Text)
    forall a. FromAttrVal a => Reader a
    fromAttrVal

    instance FromCursor CacheField where
      fromCursor :: Cursor -> [CacheField]
    fromCursor Cursor
    cur = do
        PivotFieldName
    cfName <- Name -> Cursor -> [PivotFieldName]
    forall a. FromAttrVal a => Name -> Cursor -> [a]
    fromAttribute Name
    "name" Cursor
    cur
        let cfItems :: [CellValue]
    cfItems =
              Cursor
    cur Cursor -> (Cursor -> [CellValue]) -> [CellValue]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ Name -> Axis
    element (Text -> Name
    n_ Text
    "sharedItems") Axis -> (Cursor -> [CellValue]) -> Cursor -> [CellValue]
    forall node a.
    Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
    &/ Axis
    anyElement Axis -> (Cursor -> [CellValue]) -> Cursor -> [CellValue]
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=>
              Node -> [CellValue]
    cellValueFromNode (Node -> [CellValue]) -> (Cursor -> Node) -> Cursor -> [CellValue]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Cursor -> Node
    forall node. Cursor node -> node
    node
        CacheField -> [CacheField]
    forall a. a -> [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return CacheField {[CellValue]
    PivotFieldName
    cfName :: PivotFieldName
    cfItems :: [CellValue]
    cfName :: PivotFieldName
    cfItems :: [CellValue]
    ..}

    cellValueFromNode :: Node -> [CellValue]
    cellValueFromNode :: Node -> [CellValue]
    cellValueFromNode Node
    n
      | Node
    n Node -> Name -> Bool
    `nodeElNameIs` (Text -> Name
    n_ Text
    "s") = Text -> CellValue
    CellText (Text -> CellValue) -> [Text] -> [CellValue]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Text]
    forall a. FromAttrVal a => [a]
    attributeV
      | Node
    n Node -> Name -> Bool
    `nodeElNameIs` (Text -> Name
    n_ Text
    "n") = Double -> CellValue
    CellDouble (Double -> CellValue) -> [Double] -> [CellValue]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Double]
    forall a. FromAttrVal a => [a]
    attributeV
      | Bool
    otherwise = String -> [CellValue]
    forall a. String -> [a]
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "no matching shared item"
      where
        cur :: Cursor
    cur = Node -> Cursor
    fromNode Node
    n
        attributeV :: FromAttrVal a => [a]
        attributeV :: forall a. FromAttrVal a => [a]
    attributeV = Name -> Cursor -> [a]
    forall a. FromAttrVal a => Name -> Cursor -> [a]
    fromAttribute Name
    "v" Cursor
    cur

    recordValueFromNode :: Node -> [CacheRecordValue]
    recordValueFromNode :: Node -> [CacheRecordValue]
    recordValueFromNode Node
    n
      | Node
    n Node -> Name -> Bool
    `nodeElNameIs` (Text -> Name
    n_ Text
    "s") = Text -> CacheRecordValue
    CacheText (Text -> CacheRecordValue) -> [Text] -> [CacheRecordValue]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Text]
    forall a. FromAttrVal a => [a]
    attributeV
      | Node
    n Node -> Name -> Bool
    `nodeElNameIs` (Text -> Name
    n_ Text
    "n") = Double -> CacheRecordValue
    CacheNumber (Double -> CacheRecordValue) -> [Double] -> [CacheRecordValue]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Double]
    forall a. FromAttrVal a => [a]
    attributeV
      | Node
    n Node -> Name -> Bool
    `nodeElNameIs` (Text -> Name
    n_ Text
    "x") = Int -> CacheRecordValue
    CacheIndex (Int -> CacheRecordValue) -> [Int] -> [CacheRecordValue]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Int]
    forall a. FromAttrVal a => [a]
    attributeV
      | Bool
    otherwise = String -> [CacheRecordValue]
    forall a. String -> [a]
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "not valid cache record value"
      where
        cur :: Cursor
    cur = Node -> Cursor
    fromNode Node
    n
        attributeV :: FromAttrVal a => [a]
        attributeV :: forall a. FromAttrVal a => [a]
    attributeV = Name -> Cursor -> [a]
    forall a. FromAttrVal a => Name -> Cursor -> [a]
    fromAttribute Name
    "v" Cursor
    cur

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

    instance ToElement CacheField where
      toElement :: Name -> CacheField -> Element
    toElement Name
    nm CacheField {[CellValue]
    PivotFieldName
    cfName :: CacheField -> PivotFieldName
    cfItems :: CacheField -> [CellValue]
    cfName :: PivotFieldName
    cfItems :: [CellValue]
    ..} =
        Name -> [(Name, Text)] -> [Element] -> Element
    elementList Name
    nm [Name
    "name" Name -> PivotFieldName -> (Name, Text)
    forall a. ToAttrVal a => Name -> a -> (Name, Text)
    .= PivotFieldName
    cfName] [Element
    sharedItems]
        where
          -- Excel doesn't like embedded integer sharedImes in cache
          sharedItems :: Element
    sharedItems = Name -> [(Name, Text)] -> [Element] -> Element
    elementList Name
    "sharedItems" [(Name, Text)]
    typeAttrs ([Element] -> Element) -> [Element] -> Element
    forall a b. (a -> b) -> a -> b
    $
            if Bool
    containsString then (CellValue -> Element) -> [CellValue] -> [Element]
    forall a b. (a -> b) -> [a] -> [b]
    map CellValue -> Element
    cvToItem [CellValue]
    cfItems else []
          cvToItem :: CellValue -> Element
    cvToItem (CellText Text
    t) = Name -> [(Name, Text)] -> Element
    leafElement Name
    "s" [Name
    "v" Name -> Text -> (Name, Text)
    forall a. ToAttrVal a => Name -> a -> (Name, Text)
    .= Text
    t]
          cvToItem (CellDouble Double
    n) = Name -> [(Name, Text)] -> Element
    leafElement Name
    "n" [Name
    "v" Name -> Double -> (Name, Text)
    forall a. ToAttrVal a => Name -> a -> (Name, Text)
    .= Double
    n]
          cvToItem CellValue
    _ = String -> Element
    forall a. HasCallStack => String -> a
    error String
    "Only string and number values are currently supported"
          typeAttrs :: [(Name, Text)]
    typeAttrs =
            [Maybe (Name, Text)] -> [(Name, Text)]
    forall a. [Maybe a] -> [a]
    catMaybes
              [ Name
    "containsNumber" Name -> Maybe Bool -> Maybe (Name, Text)
    forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
    .=? Bool -> Maybe Bool
    justTrue Bool
    containsNumber
              , Name
    "containsString" Name -> Maybe Bool -> Maybe (Name, Text)
    forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
    .=? Bool -> Maybe Bool
    justFalse Bool
    containsString
              , Name
    "containsSemiMixedTypes" Name -> Maybe Bool -> Maybe (Name, Text)
    forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
    .=? Bool -> Maybe Bool
    justFalse Bool
    containsString
              , Name
    "containsMixedTypes" Name -> Maybe Bool -> Maybe (Name, Text)
    forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
    .=? Bool -> Maybe Bool
    justTrue (Bool
    containsNumber Bool -> Bool -> Bool
    && Bool
    containsString)
              ]
          containsNumber :: Bool
    containsNumber = (CellValue -> Bool) -> [CellValue] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any CellValue -> Bool
    isNumber [CellValue]
    cfItems
          isNumber :: CellValue -> Bool
    isNumber (CellDouble Double
    _) = Bool
    True
          isNumber CellValue
    _ = Bool
    False
          containsString :: Bool
    containsString = (CellValue -> Bool) -> [CellValue] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any CellValue -> Bool
    isString [CellValue]
    cfItems
          isString :: CellValue -> Bool
    isString (CellText Text
    _) = Bool
    True
          isString CellValue
    _ = Bool
    False