content: {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE RecordWildCards   #-}
  {-# LANGUAGE DeriveGeneric #-}
  module Codec.Xlsx.Types.Internal.ContentTypes where
  
  import Control.Arrow
  import Data.Foldable (asum)
  import Data.Map (Map)
  import qualified Data.Map as M
  import Data.Text (Text)
  import qualified Data.Text as T
  import GHC.Generics (Generic)
  import System.FilePath.Posix (takeExtension)
  import Text.XML
  import Text.XML.Cursor
  
  import Codec.Xlsx.Parser.Internal
  
  data CtDefault = CtDefault
      { dfltExtension   :: FilePath
      , dfltContentType :: Text
      } deriving (Eq, Show, Generic)
  
  data Override = Override
      { ovrPartName    :: FilePath
      , ovrContentType :: Text
      } deriving (Eq, Show, Generic)
  
  data ContentTypes = ContentTypes
      { ctDefaults :: Map FilePath Text
      , ctTypes    :: Map FilePath Text
      } deriving (Eq, Show, Generic)
  
  lookup :: FilePath -> ContentTypes -> Maybe Text
  lookup path ContentTypes{..} =
      asum [ flip M.lookup ctDefaults =<< ext, M.lookup path ctTypes ]
    where
      ext = case takeExtension path of
          '.':e -> Just e
          _     -> Nothing
  
  {-------------------------------------------------------------------------------
    Parsing
  -------------------------------------------------------------------------------}
  instance FromCursor ContentTypes where
      fromCursor cur = do
          let ds = M.fromList . map (dfltExtension &&& dfltContentType) $
                   cur $/ element (ct"Default") >=> fromCursor
              ts = M.fromList . map (ovrPartName &&& ovrContentType) $
                   cur $/ element (ct"Override") >=> fromCursor
          return (ContentTypes ds ts)
  
  instance FromCursor CtDefault where
     fromCursor cur = do
         dfltExtension <- T.unpack <$> attribute "Extension" cur
         dfltContentType <- attribute "ContentType" cur
         return CtDefault{..}
  
  instance FromCursor Override where
     fromCursor cur = do
         ovrPartName <- T.unpack <$> attribute "PartName" cur
         ovrContentType <- attribute "ContentType" cur
         return Override{..}
  
  -- | Add package relationship namespace to name
  ct :: Text -> Name
  ct x = Name
    { nameLocalName = x
    , nameNamespace = Just contentTypesNs
    , namePrefix = Nothing
    }
  
  contentTypesNs :: Text
  contentTypesNs = "http://schemas.openxmlformats.org/package/2006/content-types"
  