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

import qualified Data.Map as M
import GHC.Generics (Generic)
import Text.XML (Element(..))

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

-- | Internal helper type for parsing data validation records
--
-- See 18.3.1.32 "dataValidation (Data Validation)" (p. 1614/1624)
newtype DvPair = DvPair
    { DvPair -> (SqRef, DataValidation)
unDvPair :: (SqRef, DataValidation)
    } deriving (DvPair -> DvPair -> Bool
(DvPair -> DvPair -> Bool)
-> (DvPair -> DvPair -> Bool) -> Eq DvPair
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DvPair -> DvPair -> Bool
$c/= :: DvPair -> DvPair -> Bool
== :: DvPair -> DvPair -> Bool
$c== :: DvPair -> DvPair -> Bool
Eq, Int -> DvPair -> ShowS
[DvPair] -> ShowS
DvPair -> String
(Int -> DvPair -> ShowS)
-> (DvPair -> String) -> ([DvPair] -> ShowS) -> Show DvPair
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DvPair] -> ShowS
$cshowList :: [DvPair] -> ShowS
show :: DvPair -> String
$cshow :: DvPair -> String
showsPrec :: Int -> DvPair -> ShowS
$cshowsPrec :: Int -> DvPair -> ShowS
Show, (forall x. DvPair -> Rep DvPair x)
-> (forall x. Rep DvPair x -> DvPair) -> Generic DvPair
forall x. Rep DvPair x -> DvPair
forall x. DvPair -> Rep DvPair x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DvPair x -> DvPair
$cfrom :: forall x. DvPair -> Rep DvPair x
Generic)

instance FromCursor DvPair where
    fromCursor :: Cursor -> [DvPair]
fromCursor Cursor
cur = do
        SqRef
sqref <- Name -> Cursor -> [SqRef]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"sqref" Cursor
cur
        DataValidation
dv    <- Cursor -> [DataValidation]
forall a. FromCursor a => Cursor -> [a]
fromCursor Cursor
cur
        DvPair -> [DvPair]
forall (m :: * -> *) a. Monad m => a -> m a
return (DvPair -> [DvPair]) -> DvPair -> [DvPair]
forall a b. (a -> b) -> a -> b
$ (SqRef, DataValidation) -> DvPair
DvPair (SqRef
sqref, DataValidation
dv)

instance FromXenoNode DvPair where
  fromXenoNode :: Node -> Either Text DvPair
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"
    DataValidation
dv <- Node -> Either Text DataValidation
forall a. FromXenoNode a => Node -> Either Text a
fromXenoNode Node
root
    DvPair -> Either Text DvPair
forall (m :: * -> *) a. Monad m => a -> m a
return (DvPair -> Either Text DvPair) -> DvPair -> Either Text DvPair
forall a b. (a -> b) -> a -> b
$ (SqRef, DataValidation) -> DvPair
DvPair (SqRef
sqref, DataValidation
dv)

instance ToElement DvPair where
    toElement :: Name -> DvPair -> Element
toElement Name
nm (DvPair (SqRef
sqRef,DataValidation
dv)) = Element
e
        {elementAttributes :: Map Name Text
elementAttributes = Name -> Text -> Map Name Text -> Map Name Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
"sqref" (SqRef -> Text
forall a. ToAttrVal a => a -> Text
toAttrVal SqRef
sqRef) (Map Name Text -> Map Name Text) -> Map Name Text -> Map Name Text
forall a b. (a -> b) -> a -> b
$ Element -> Map Name Text
elementAttributes Element
e}
      where
        e :: Element
e = Name -> DataValidation -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
nm DataValidation
dv