    {-# LANGUAGE FlexibleInstances   #-}
    {-# LANGUAGE OverloadedStrings   #-}
    {-# LANGUAGE RecordWildCards     #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE DeriveGeneric #-}

    module Codec.Xlsx.Writer.Internal (
        -- * Rendering documents
        ToDocument(..)
      , documentFromElement
      , documentFromNsElement
      , documentFromNsPrefElement
        -- * Rendering elements
      , ToElement(..)
      , countedElementList
      , nonEmptyCountedElementList
      , elementList
      , elementListSimple
      , nonEmptyElListSimple
      , leafElement
      , emptyElement
      , elementContent0
      , elementContent
      , elementContentPreserved
      , elementValue
      , elementValueDef
        -- * Rendering attributes
      , ToAttrVal(..)
      , (.=)
      , (.=?)
      , setAttr
        -- * Dealing with namespaces
      , addNS
      , mainNamespace
        -- * Misc
      , txti
      , txtb
      , txtd
      , justNonDef
      , justTrue
      , justFalse
      ) where

    import qualified Data.Map as Map
    import Data.Maybe (catMaybes)
    import Data.String (fromString)
    import Data.Text (Text)
    import qualified Data.Text as T
    import Data.Text.Lazy (toStrict)
    import Data.Text.Lazy.Builder (toLazyText)
    import Data.Text.Lazy.Builder.Int
    import Data.Text.Lazy.Builder.RealFloat
    import Text.XML

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

    class ToDocument a where
      toDocument :: a -> Document

    documentFromElement :: Text -> Element -> Document
    documentFromElement :: Text -> Element -> Document
    documentFromElement Text
    comment Element
    e =
      Text -> Text -> Element -> Document
    documentFromNsElement Text
    comment Text
    mainNamespace Element
    e

    documentFromNsElement :: Text -> Text -> Element -> Document
    documentFromNsElement :: Text -> Text -> Element -> Document
    documentFromNsElement Text
    comment Text
    ns Element
    e =
      Text -> Text -> Maybe Text -> Element -> Document
    documentFromNsPrefElement Text
    comment Text
    ns Maybe Text
    forall a. Maybe a
    Nothing Element
    e

    documentFromNsPrefElement :: Text -> Text -> Maybe Text -> Element -> Document
    documentFromNsPrefElement :: Text -> Text -> Maybe Text -> Element -> Document
    documentFromNsPrefElement Text
    comment Text
    ns Maybe Text
    prefix Element
    e = Document {
          documentRoot :: Element
    documentRoot     = Text -> Maybe Text -> Element -> Element
    addNS Text
    ns Maybe Text
    prefix Element
    e
        , documentEpilogue :: [Miscellaneous]
    documentEpilogue = []
        , documentPrologue :: Prologue
    documentPrologue = Prologue {
              prologueBefore :: [Miscellaneous]
    prologueBefore  = [Text -> Miscellaneous
    MiscComment Text
    comment]
            , prologueDoctype :: Maybe Doctype
    prologueDoctype = Maybe Doctype
    forall a. Maybe a
    Nothing
            , prologueAfter :: [Miscellaneous]
    prologueAfter   = []
            }
        }

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

    class ToElement a where
      toElement :: Name -> a -> Element

    countedElementList :: Name -> [Element] -> Element
    countedElementList :: Name -> [Element] -> Element
    countedElementList Name
    nm [Element]
    as = Name -> [(Name, Text)] -> [Element] -> Element
    elementList Name
    nm [ Name
    "count" Name -> Int -> (Name, Text)
    forall a. ToAttrVal a => Name -> a -> (Name, Text)
    .= [Element] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Element]
    as ] [Element]
    as

    nonEmptyCountedElementList :: Name -> [Element] -> Maybe Element
    nonEmptyCountedElementList :: Name -> [Element] -> Maybe Element
    nonEmptyCountedElementList Name
    nm [Element]
    as = case [Element]
    as of
      [] -> Maybe Element
    forall a. Maybe a
    Nothing
      [Element]
    _ -> Element -> Maybe Element
    forall a. a -> Maybe a
    Just (Element -> Maybe Element) -> Element -> Maybe Element
    forall a b. (a -> b) -> a -> b
    $ Name -> [Element] -> Element
    countedElementList Name
    nm [Element]
    as

    elementList :: Name -> [(Name, Text)] -> [Element] -> Element
    elementList :: Name -> [(Name, Text)] -> [Element] -> Element
    elementList Name
    nm [(Name, Text)]
    attrs [Element]
    els = Element {
          elementName :: Name
    elementName       = Name
    nm
        , elementNodes :: [Node]
    elementNodes      = (Element -> Node) -> [Element] -> [Node]
    forall a b. (a -> b) -> [a] -> [b]
    map Element -> Node
    NodeElement [Element]
    els
        , elementAttributes :: Map Name Text
    elementAttributes = [(Name, Text)] -> Map Name Text
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList [(Name, Text)]
    attrs
        }

    elementListSimple :: Name -> [Element] -> Element
    elementListSimple :: Name -> [Element] -> Element
    elementListSimple Name
    nm [Element]
    els = Name -> [(Name, Text)] -> [Element] -> Element
    elementList Name
    nm [] [Element]
    els

    nonEmptyElListSimple :: Name -> [Element] -> Maybe Element
    nonEmptyElListSimple :: Name -> [Element] -> Maybe Element
    nonEmptyElListSimple Name
    _  []  = Maybe Element
    forall a. Maybe a
    Nothing
    nonEmptyElListSimple Name
    nm [Element]
    els = Element -> Maybe Element
    forall a. a -> Maybe a
    Just (Element -> Maybe Element) -> Element -> Maybe Element
    forall a b. (a -> b) -> a -> b
    $ Name -> [Element] -> Element
    elementListSimple Name
    nm [Element]
    els

    leafElement :: Name -> [(Name, Text)] -> Element
    leafElement :: Name -> [(Name, Text)] -> Element
    leafElement Name
    nm [(Name, Text)]
    attrs = Name -> [(Name, Text)] -> [Element] -> Element
    elementList Name
    nm [(Name, Text)]
    attrs []

    emptyElement :: Name -> Element
    emptyElement :: Name -> Element
    emptyElement Name
    nm = Name -> [(Name, Text)] -> [Element] -> Element
    elementList Name
    nm [] []

    elementContent0 :: Name -> [(Name, Text)] -> Text -> Element
    elementContent0 :: Name -> [(Name, Text)] -> Text -> Element
    elementContent0 Name
    nm [(Name, Text)]
    attrs Text
    txt = Element {
          elementName :: Name
    elementName       = Name
    nm
        , elementAttributes :: Map Name Text
    elementAttributes = [(Name, Text)] -> Map Name Text
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList [(Name, Text)]
    attrs
        , elementNodes :: [Node]
    elementNodes      = [Text -> Node
    NodeContent Text
    txt]
        }

    elementContent :: Name -> Text -> Element
    elementContent :: Name -> Text -> Element
    elementContent Name
    nm Text
    txt = Name -> [(Name, Text)] -> Text -> Element
    elementContent0 Name
    nm [] Text
    txt

    elementContentPreserved :: Name -> Text -> Element
    elementContentPreserved :: Name -> Text -> Element
    elementContentPreserved Name
    nm Text
    txt = Name -> [(Name, Text)] -> Text -> Element
    elementContent0 Name
    nm [ (Name, Text)
    preserveSpace ] Text
    txt
      where
        preserveSpace :: (Name, Text)
    preserveSpace = (
            Name { nameLocalName :: Text
    nameLocalName = Text
    "space"
                 , nameNamespace :: Maybe Text
    nameNamespace = Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    "http://www.w3.org/XML/1998/namespace"
                 , namePrefix :: Maybe Text
    namePrefix    = Maybe Text
    forall a. Maybe a
    Nothing
                 }
          , Text
    "preserve"
          )

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

    class ToAttrVal a where
      toAttrVal :: a -> Text

    instance ToAttrVal Text    where toAttrVal :: Text -> Text
    toAttrVal = Text -> Text
    forall a. a -> a
    id
    instance ToAttrVal String  where toAttrVal :: String -> Text
    toAttrVal = String -> Text
    forall a. IsString a => String -> a
    fromString
    instance ToAttrVal Int     where toAttrVal :: Int -> Text
    toAttrVal = Int -> Text
    forall a. Integral a => a -> Text
    txti
    instance ToAttrVal Integer where toAttrVal :: Integer -> Text
    toAttrVal = Integer -> Text
    forall a. Integral a => a -> Text
    txti
    instance ToAttrVal Double  where toAttrVal :: Double -> Text
    toAttrVal = Double -> Text
    txtd

    instance ToAttrVal Bool where
      toAttrVal :: Bool -> Text
    toAttrVal Bool
    True  = Text
    "1"
      toAttrVal Bool
    False = Text
    "0"

    elementValue :: ToAttrVal a => Name -> a -> Element
    elementValue :: forall a. ToAttrVal a => Name -> a -> Element
    elementValue Name
    nm a
    a = Name -> [(Name, Text)] -> Element
    leafElement Name
    nm [ Name
    "val" Name -> a -> (Name, Text)
    forall a. ToAttrVal a => Name -> a -> (Name, Text)
    .= a
    a ]

    elementValueDef :: (Eq a, ToAttrVal a) => Name -> a -> a -> Element
    elementValueDef :: forall a. (Eq a, ToAttrVal a) => Name -> a -> a -> Element
    elementValueDef Name
    nm a
    defVal a
    a =
      Name -> [(Name, Text)] -> Element
    leafElement Name
    nm ([(Name, Text)] -> Element) -> [(Name, Text)] -> Element
    forall a b. (a -> b) -> a -> b
    $ [Maybe (Name, Text)] -> [(Name, Text)]
    forall a. [Maybe a] -> [a]
    catMaybes [ Name
    "val" Name -> Maybe a -> Maybe (Name, Text)
    forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
    .=? a -> a -> Maybe a
    forall a. Eq a => a -> a -> Maybe a
    justNonDef a
    defVal a
    a ]

    (.=) :: ToAttrVal a => Name -> a -> (Name, Text)
    Name
    nm .= :: forall a. ToAttrVal a => Name -> a -> (Name, Text)
    .= a
    a = (Name
    nm, a -> Text
    forall a. ToAttrVal a => a -> Text
    toAttrVal a
    a)

    (.=?) :: ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
    Name
    _  .=? :: forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
    .=? Maybe a
    Nothing  = Maybe (Name, Text)
    forall a. Maybe a
    Nothing
    Name
    nm .=? (Just a
    a) = (Name, Text) -> Maybe (Name, Text)
    forall a. a -> Maybe a
    Just (Name
    nm Name -> a -> (Name, Text)
    forall a. ToAttrVal a => Name -> a -> (Name, Text)
    .= a
    a)

    setAttr :: ToAttrVal a => Name -> a -> Element -> Element
    setAttr :: forall a. ToAttrVal a => Name -> a -> Element -> Element
    setAttr Name
    nm a
    a el :: Element
    el@Element{[Node]
    Map Name Text
    Name
    elementName :: Element -> Name
    elementNodes :: Element -> [Node]
    elementAttributes :: Element -> Map Name Text
    elementName :: Name
    elementAttributes :: Map Name Text
    elementNodes :: [Node]
    ..} = Element
    el{ elementAttributes = attrs' }
      where
        attrs' :: Map Name Text
    attrs' = Name -> Text -> Map Name Text -> Map Name Text
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert Name
    nm (a -> Text
    forall a. ToAttrVal a => a -> Text
    toAttrVal a
    a) Map Name Text
    elementAttributes

    {-------------------------------------------------------------------------------
      Dealing with namespaces
    -------------------------------------------------------------------------------}

    -- | Set the namespace for the entire document
    --
    -- This follows the same policy that the rest of the xlsx package uses.
    addNS :: Text -> Maybe Text -> Element -> Element
    addNS :: Text -> Maybe Text -> Element -> Element
    addNS Text
    ns Maybe Text
    prefix Element{[Node]
    Map Name Text
    Name
    elementName :: Element -> Name
    elementNodes :: Element -> [Node]
    elementAttributes :: Element -> Map Name Text
    elementName :: Name
    elementAttributes :: Map Name Text
    elementNodes :: [Node]
    ..} = Element{
          elementName :: Name
    elementName       = Name -> Name
    goName Name
    elementName
        , elementAttributes :: Map Name Text
    elementAttributes = Map Name Text
    elementAttributes
        , elementNodes :: [Node]
    elementNodes      = (Node -> Node) -> [Node] -> [Node]
    forall a b. (a -> b) -> [a] -> [b]
    map Node -> Node
    goNode [Node]
    elementNodes
        }
      where
        goName :: Name -> Name
        goName :: Name -> Name
    goName n :: Name
    n@Name{Maybe Text
    Text
    nameLocalName :: Name -> Text
    nameNamespace :: Name -> Maybe Text
    namePrefix :: Name -> Maybe Text
    nameLocalName :: Text
    nameNamespace :: Maybe Text
    namePrefix :: Maybe Text
    ..} =
          case Maybe Text
    nameNamespace of
            Just Text
    _  -> Name
    n -- If a namespace was explicitly set, leave it
            Maybe Text
    Nothing -> Name{
                nameLocalName :: Text
    nameLocalName = Text
    nameLocalName
              , nameNamespace :: Maybe Text
    nameNamespace = Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    ns
              , namePrefix :: Maybe Text
    namePrefix    = Maybe Text
    prefix
              }

        goNode :: Node -> Node
        goNode :: Node -> Node
    goNode (NodeElement Element
    e) = Element -> Node
    NodeElement (Element -> Node) -> Element -> Node
    forall a b. (a -> b) -> a -> b
    $ Text -> Maybe Text -> Element -> Element
    addNS Text
    ns Maybe Text
    prefix Element
    e
        goNode Node
    n               = Node
    n

    -- | The main namespace for Excel
    mainNamespace :: Text
    mainNamespace :: Text
    mainNamespace = Text
    "http://schemas.openxmlformats.org/spreadsheetml/2006/main"

    txtd :: Double -> Text
    txtd :: Double -> Text
    txtd Double
    v
      | Double
    v Double -> Double -> Double
    forall a. Num a => a -> a -> a
    - Integer -> Double
    forall a. Num a => Integer -> a
    fromInteger Integer
    v' Double -> Double -> Bool
    forall a. Eq a => a -> a -> Bool
    == Double
    0 = Integer -> Text
    forall a. Integral a => a -> Text
    txti Integer
    v'
      | Bool
    otherwise = LazyText -> Text
    toStrict (LazyText -> Text) -> (Builder -> LazyText) -> Builder -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Builder -> LazyText
    toLazyText (Builder -> Text) -> Builder -> Text
    forall a b. (a -> b) -> a -> b
    $ Double -> Builder
    forall a. RealFloat a => a -> Builder
    realFloat Double
    v
      where
        v' :: Integer
    v' = Double -> Integer
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor Double
    v

    txtb :: Bool -> Text
    txtb :: Bool -> Text
    txtb = Text -> Text
    T.toLower (Text -> Text) -> (Bool -> Text) -> Bool -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text
    T.pack (String -> Text) -> (Bool -> String) -> Bool -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> String
    forall a. Show a => a -> String
    show

    txti :: (Integral a) => a -> Text
    txti :: forall a. Integral a => a -> Text
    txti = LazyText -> Text
    toStrict (LazyText -> Text) -> (a -> LazyText) -> a -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Builder -> LazyText
    toLazyText (Builder -> LazyText) -> (a -> Builder) -> a -> LazyText
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Builder
    forall a. Integral a => a -> Builder
    decimal

    justNonDef :: (Eq a) => a -> a -> Maybe a
    justNonDef :: forall a. Eq a => a -> a -> Maybe a
    justNonDef a
    defVal a
    a | a
    a a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    defVal = Maybe a
    forall a. Maybe a
    Nothing
                        | Bool
    otherwise   = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    a

    justFalse :: Bool -> Maybe Bool
    justFalse :: Bool -> Maybe Bool
    justFalse = Bool -> Bool -> Maybe Bool
    forall a. Eq a => a -> a -> Maybe a
    justNonDef Bool
    True

    justTrue :: Bool -> Maybe Bool
    justTrue :: Bool -> Maybe Bool
    justTrue = Bool -> Bool -> Maybe Bool
    forall a. Eq a => a -> a -> Maybe a
    justNonDef Bool
    False