{-# 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
(Variant -> Variant -> Bool)
-> (Variant -> Variant -> Bool) -> Eq Variant
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
(Int -> Variant -> ShowS)
-> (Variant -> String) -> ([Variant] -> ShowS) -> Show Variant
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. Variant -> Rep Variant x)
-> (forall x. Rep Variant x -> Variant) -> Generic Variant
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 (Node -> [Variant]) -> (Cursor -> Node) -> Cursor -> [Variant]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cursor -> Node
forall node. Cursor node -> node
node

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

decodeBase64 :: MonadFail m => Text -> m ByteString
decodeBase64 :: Text -> m ByteString
decodeBase64 Text
t = case ByteString -> Either String ByteString
B64.decode (Text -> ByteString
T.encodeUtf8 Text
t) of
  Right ByteString
bs -> ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
  Left String
err -> String -> m ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ByteString) -> String -> m ByteString
forall a b. (a -> b) -> a -> b
$ String
"invalid base64 value: " String -> ShowS
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 :: Text -> Maybe Text -> Maybe Text -> Name
Name
  { nameLocalName :: Text
nameLocalName = Text
x
  , nameNamespace :: Maybe Text
nameNamespace = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
docPropsVtNs
  , namePrefix :: Maybe Text
namePrefix = Maybe Text
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 (ByteString -> Text) -> ByteString -> Text
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")     (Int -> Text
forall a. Integral a => a -> Text
txti Int
i)