{-# 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 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 = 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" forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= 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
  [] -> forall a. Maybe a
Nothing
  [Element]
_ -> forall a. a -> Maybe a
Just 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      = forall a b. (a -> b) -> [a] -> [b]
map Element -> Node
NodeElement [Element]
els
    , elementAttributes :: Map Name Text
elementAttributes = 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
_  []  = forall a. Maybe a
Nothing
nonEmptyElListSimple Name
nm [Element]
els = forall a. a -> Maybe a
Just 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 = 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 = forall a. a -> Maybe a
Just Text
"http://www.w3.org/XML/1998/namespace"
             , namePrefix :: Maybe Text
namePrefix    = forall a. Maybe a
Nothing
             }
      , Text
"preserve"
      )

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

class ToAttrVal a where
  toAttrVal :: a -> Text

instance ToAttrVal Text    where toAttrVal :: Text -> Text
toAttrVal = forall a. a -> a
id
instance ToAttrVal String  where toAttrVal :: String -> Text
toAttrVal = forall a. IsString a => String -> a
fromString
instance ToAttrVal Int     where toAttrVal :: Int -> Text
toAttrVal = forall a. Integral a => a -> Text
txti
instance ToAttrVal Integer where toAttrVal :: Integer -> Text
toAttrVal = 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" 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 forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [ Name
"val" forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? 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, 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  = forall a. Maybe a
Nothing
Name
nm .=? (Just a
a) = forall a. a -> Maybe a
Just (Name
nm 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
elementNodes :: [Node]
elementAttributes :: Map Name Text
elementName :: Name
elementAttributes :: Element -> Map Name Text
elementNodes :: Element -> [Node]
elementName :: Element -> Name
..} = Element
el{ elementAttributes :: Map Name Text
elementAttributes = Map Name Text
attrs' }
  where
    attrs' :: Map Name Text
attrs' = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
nm (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
elementNodes :: [Node]
elementAttributes :: Map Name Text
elementName :: Name
elementAttributes :: Element -> Map Name Text
elementNodes :: Element -> [Node]
elementName :: Element -> Name
..} = Element{
      elementName :: Name
elementName       = Name -> Name
goName Name
elementName
    , elementAttributes :: Map Name Text
elementAttributes = Map Name Text
elementAttributes
    , elementNodes :: [Node]
elementNodes      = 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
namePrefix :: Maybe Text
nameNamespace :: Maybe Text
nameLocalName :: Text
namePrefix :: Name -> Maybe Text
nameNamespace :: Name -> Maybe Text
nameLocalName :: Name -> 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 = 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 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 forall a. Num a => a -> a -> a
- forall a. Num a => Integer -> a
fromInteger Integer
v' forall a. Eq a => a -> a -> Bool
== Double
0 = forall a. Integral a => a -> Text
txti Integer
v'
  | Bool
otherwise = Text -> Text
toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => a -> Builder
realFloat Double
v
  where
    v' :: Integer
v' = forall a b. (RealFrac a, Integral b) => a -> b
floor Double
v

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

txti :: (Integral a) => a -> Text
txti :: forall a. Integral a => a -> Text
txti = Text -> Text
toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Eq a => a -> a -> Bool
== a
defVal = forall a. Maybe a
Nothing
                    | Bool
otherwise   = forall a. a -> Maybe a
Just a
a

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

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