    {-# 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
    $c== :: Variant -> Variant -> Bool
    == :: Variant -> Variant -> Bool
    $c/= :: Variant -> Variant -> Bool
    /= :: 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
    $cshowsPrec :: Int -> Variant -> ShowS
    showsPrec :: Int -> Variant -> ShowS
    $cshow :: Variant -> String
    show :: Variant -> String
    $cshowList :: [Variant] -> ShowS
    showList :: [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
    $cfrom :: forall x. Variant -> Rep Variant x
    from :: forall x. Variant -> Rep Variant x
    $cto :: forall x. Rep Variant x -> Variant
    to :: forall x. Rep Variant x -> Variant
    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 a b. (a -> b) -> [a] -> [b]
    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 a b. (a -> b) -> [a] -> [b]
    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 a b. (a -> b) -> [a] -> [b]
    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 a b. (a -> b) -> [a] -> [b]
    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 a. String -> [a]
    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 :: 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 -> ByteString -> m ByteString
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    bs
      Left String
    err -> String -> m ByteString
    forall a. String -> m a
    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
      { 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)