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

import Control.DeepSeq (NFData)
import Control.Monad.Fail (MonadFail)
import Data.ByteString (ByteString)
import Data.ByteString.Base64 as B64
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import GHC.Generics (Generic)
import Text.XML
import Text.XML.Cursor

import Codec.Xlsx.Parser.Internal
import Codec.Xlsx.Writer.Internal

data Variant
    = VtBlob ByteString
    | VtBool Bool
    | VtDecimal Double
    | VtLpwstr Text
    | VtInt Int
    -- TODO: vt_vector, vt_array, vt_oblob, vt_empty, vt_null, vt_i1, vt_i2,
    -- vt_i4, vt_i8, vt_ui1, vt_ui2, vt_ui4, vt_ui8, vt_uint, vt_r4, vt_r8,
    -- vt_lpstr, vt_bstr, vt_date, vt_filetime, vt_cy, vt_error, vt_stream,
    -- vt_ostream, vt_storage, vt_ostorage, vt_vstream, vt_clsid
    deriving (Variant -> Variant -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Variant -> Variant -> Bool
$c/= :: Variant -> Variant -> Bool
== :: Variant -> Variant -> Bool
$c== :: Variant -> Variant -> Bool
Eq, Int -> Variant -> ShowS
[Variant] -> ShowS
Variant -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Variant] -> ShowS
$cshowList :: [Variant] -> ShowS
show :: Variant -> String
$cshow :: Variant -> String
showsPrec :: Int -> Variant -> ShowS
$cshowsPrec :: Int -> Variant -> ShowS
Show, forall x. Rep Variant x -> Variant
forall x. Variant -> Rep Variant x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Variant x -> Variant
$cfrom :: forall x. Variant -> Rep Variant x
Generic)

instance NFData Variant

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

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

variantFromNode :: Node -> [Variant]
variantFromNode :: Node -> [Variant]
variantFromNode n :: Node
n@(NodeElement Element
el) | Element -> Name
elementName Element
el forall a. Eq a => a -> a -> Bool
== Text -> Name
vt Text
"lpwstr" =
                                         Node -> Cursor
fromNode Node
n forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Cursor -> [Text]
content forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Text -> Variant
VtLpwstr
                                   | Element -> Name
elementName Element
el forall a. Eq a => a -> a -> Bool
== Text -> Name
vt Text
"bool" =
                                         Node -> Cursor
fromNode Node
n forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Cursor -> [Text]
content forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Variant
VtBool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadFail m => Text -> m Bool
boolean
                                   | Element -> Name
elementName Element
el forall a. Eq a => a -> a -> Bool
== Text -> Name
vt Text
"int" =
                                         Node -> Cursor
fromNode Node
n forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Cursor -> [Text]
content forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Variant
VtInt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. (MonadFail m, Integral a) => Text -> m a
decimal
                                   | Element -> Name
elementName Element
el forall a. Eq a => a -> a -> Bool
== Text -> Name
vt Text
"decimal" =
                                         Node -> Cursor
fromNode Node
n forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Cursor -> [Text]
content forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> Variant
VtDecimal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadFail m => Text -> m Double
rational
                                   | Element -> Name
elementName Element
el forall a. Eq a => a -> a -> Bool
== Text -> Name
vt Text
"blob" =
                                         Node -> Cursor
fromNode Node
n forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Cursor -> [Text]
content forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Variant
VtBlob forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadFail m => Text -> m ByteString
decodeBase64 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
killWhitespace
variantFromNode  Node
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"no matching nodes"

killWhitespace :: Text -> Text
killWhitespace :: Text -> Text
killWhitespace = (Char -> Bool) -> Text -> Text
T.filter (forall a. Eq a => a -> a -> Bool
/=Char
' ')

decodeBase64 :: MonadFail m => Text -> m ByteString
decodeBase64 :: forall (m :: * -> *). MonadFail m => Text -> m ByteString
decodeBase64 Text
t = case ByteString -> Either String ByteString
B64.decode (Text -> ByteString
T.encodeUtf8 Text
t) of
  Right ByteString
bs -> forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
  Left String
err -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"invalid base64 value: " forall a. [a] -> [a] -> [a]
++ String
err

-- | Add doc props variant types namespace to name
vt :: Text -> Name
vt :: Text -> Name
vt Text
x = Name
  { nameLocalName :: Text
nameLocalName = Text
x
  , nameNamespace :: Maybe Text
nameNamespace = forall a. a -> Maybe a
Just Text
docPropsVtNs
  , namePrefix :: Maybe Text
namePrefix = forall a. Maybe a
Nothing
  }

docPropsVtNs :: Text
docPropsVtNs :: Text
docPropsVtNs = Text
"http://schemas.openxmlformats.org/officeDocument/2006/docPropsVTypes"

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

variantToElement :: Variant -> Element
variantToElement :: Variant -> Element
variantToElement (VtLpwstr Text
t)  = Name -> Text -> Element
elementContent (Text -> Name
vtText
"lpwstr")  Text
t
variantToElement (VtBlob ByteString
bs)   = Name -> Text -> Element
elementContent (Text -> Name
vtText
"blob")    (ByteString -> Text
T.decodeLatin1 forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B64.encode ByteString
bs)
variantToElement (VtBool Bool
b)    = Name -> Text -> Element
elementContent (Text -> Name
vtText
"bool")    (Bool -> Text
txtb Bool
b)
variantToElement (VtDecimal Double
d) = Name -> Text -> Element
elementContent (Text -> Name
vtText
"decimal") (Double -> Text
txtd Double
d)
variantToElement (VtInt Int
i)     = Name -> Text -> Element
elementContent (Text -> Name
vtText
"int")     (forall a. Integral a => a -> Text
txti Int
i)