{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
module Codec.Xlsx.Types.Internal.CfPair where

import GHC.Generics (Generic)
import Text.XML.Cursor

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

-- | Internal helper type for parsing "conditionalFormatting recods
-- TODO: pivot, extList
-- Implementing those will need this implementation to be changed
--
-- See 18.3.1.18 "conditionalFormatting (Conditional Formatting)" (p. 1610)
newtype CfPair = CfPair
    { CfPair -> (SqRef, ConditionalFormatting)
unCfPair :: (SqRef, ConditionalFormatting)
    } deriving (CfPair -> CfPair -> Bool
(CfPair -> CfPair -> Bool)
-> (CfPair -> CfPair -> Bool) -> Eq CfPair
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CfPair -> CfPair -> Bool
$c/= :: CfPair -> CfPair -> Bool
== :: CfPair -> CfPair -> Bool
$c== :: CfPair -> CfPair -> Bool
Eq, Int -> CfPair -> ShowS
[CfPair] -> ShowS
CfPair -> String
(Int -> CfPair -> ShowS)
-> (CfPair -> String) -> ([CfPair] -> ShowS) -> Show CfPair
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CfPair] -> ShowS
$cshowList :: [CfPair] -> ShowS
show :: CfPair -> String
$cshow :: CfPair -> String
showsPrec :: Int -> CfPair -> ShowS
$cshowsPrec :: Int -> CfPair -> ShowS
Show, (forall x. CfPair -> Rep CfPair x)
-> (forall x. Rep CfPair x -> CfPair) -> Generic CfPair
forall x. Rep CfPair x -> CfPair
forall x. CfPair -> Rep CfPair x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CfPair x -> CfPair
$cfrom :: forall x. CfPair -> Rep CfPair x
Generic)

instance FromCursor CfPair where
    fromCursor :: Cursor -> [CfPair]
fromCursor Cursor
cur = do
        SqRef
sqref <- Name -> Cursor -> [SqRef]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"sqref" Cursor
cur
        let cfRules :: ConditionalFormatting
cfRules = Cursor
cur Cursor
-> (Cursor -> ConditionalFormatting) -> ConditionalFormatting
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"cfRule") Axis
-> (Cursor -> ConditionalFormatting)
-> Cursor
-> ConditionalFormatting
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> ConditionalFormatting
forall a. FromCursor a => Cursor -> [a]
fromCursor
        CfPair -> [CfPair]
forall (m :: * -> *) a. Monad m => a -> m a
return (CfPair -> [CfPair]) -> CfPair -> [CfPair]
forall a b. (a -> b) -> a -> b
$ (SqRef, ConditionalFormatting) -> CfPair
CfPair (SqRef
sqref, ConditionalFormatting
cfRules)

instance FromXenoNode CfPair where
  fromXenoNode :: Node -> Either Text CfPair
fromXenoNode Node
root = do
    SqRef
sqref <- Node -> AttrParser SqRef -> Either Text SqRef
forall a. Node -> AttrParser a -> Either Text a
parseAttributes Node
root (AttrParser SqRef -> Either Text SqRef)
-> AttrParser SqRef -> Either Text SqRef
forall a b. (a -> b) -> a -> b
$ ByteString -> AttrParser SqRef
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"sqref"
    ConditionalFormatting
cfRules <- Node
-> ChildCollector ConditionalFormatting
-> Either Text ConditionalFormatting
forall a. Node -> ChildCollector a -> Either Text a
collectChildren Node
root (ChildCollector ConditionalFormatting
 -> Either Text ConditionalFormatting)
-> ChildCollector ConditionalFormatting
-> Either Text ConditionalFormatting
forall a b. (a -> b) -> a -> b
$ ByteString -> ChildCollector ConditionalFormatting
forall a. FromXenoNode a => ByteString -> ChildCollector [a]
fromChildList ByteString
"cfRule"
    CfPair -> Either Text CfPair
forall (m :: * -> *) a. Monad m => a -> m a
return (CfPair -> Either Text CfPair) -> CfPair -> Either Text CfPair
forall a b. (a -> b) -> a -> b
$ (SqRef, ConditionalFormatting) -> CfPair
CfPair (SqRef
sqref, ConditionalFormatting
cfRules)

instance ToElement CfPair where
    toElement :: Name -> CfPair -> Element
toElement Name
nm (CfPair (SqRef
sqRef, ConditionalFormatting
cfRules)) =
        Name -> [(Name, Text)] -> [Element] -> Element
elementList Name
nm [ Name
"sqref" Name -> Text -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= SqRef -> Text
forall a. ToAttrVal a => a -> Text
toAttrVal SqRef
sqRef ]
                    ((CfRule -> Element) -> ConditionalFormatting -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> CfRule -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"cfRule") ConditionalFormatting
cfRules)