{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Reader.Odt
   Copyright   : Copyright (C) 2015 Martin Linnemann
   License     : GNU GPL, version 2 or above

   Maintainer  : Martin Linnemann <theCodingMarlin@googlemail.com>
   Stability   : alpha
   Portability : portable

Entry point to the odt reader.
-}

module Text.Pandoc.Readers.Odt ( readOdt ) where

import Codec.Archive.Zip
import Text.Pandoc.XML.Light

import qualified Data.ByteString.Lazy as B

import System.FilePath

import Control.Monad.Except (throwError)

import qualified Data.Text as T

import Text.Pandoc.Class.PandocMonad (PandocMonad)
import qualified Text.Pandoc.Class.PandocMonad as P
import Text.Pandoc.Definition
import Text.Pandoc.Error
import Text.Pandoc.MediaBag
import Text.Pandoc.Options
import qualified Text.Pandoc.UTF8 as UTF8

import Text.Pandoc.Readers.Odt.ContentReader
import Text.Pandoc.Readers.Odt.StyleReader

import Text.Pandoc.Readers.Odt.Generic.Fallible
import Text.Pandoc.Readers.Odt.Generic.XMLConverter
import Text.Pandoc.Shared (filteredFilesFromArchive)

readOdt :: PandocMonad m
        => ReaderOptions
        -> B.ByteString
        -> m Pandoc
readOdt :: ReaderOptions -> ByteString -> m Pandoc
readOdt ReaderOptions
opts ByteString
bytes = case ReaderOptions
-> ByteString -> Either PandocError (Pandoc, MediaBag)
readOdt' ReaderOptions
opts ByteString
bytes of
  Right (Pandoc
doc, MediaBag
mb) -> do
    MediaBag -> m ()
forall (m :: * -> *). PandocMonad m => MediaBag -> m ()
P.setMediaBag MediaBag
mb
    Pandoc -> m Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return Pandoc
doc
  Left PandocError
e -> PandocError -> m Pandoc
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PandocError
e

--
readOdt' :: ReaderOptions
         -> B.ByteString
         -> Either PandocError (Pandoc, MediaBag)
readOdt' :: ReaderOptions
-> ByteString -> Either PandocError (Pandoc, MediaBag)
readOdt' ReaderOptions
_ ByteString
bytes = ByteString -> Either PandocError (Pandoc, MediaBag)
bytesToOdt ByteString
bytes-- of
--                    Right (pandoc, mediaBag) -> Right (pandoc , mediaBag)
--                    Left  err                -> Left err

--
bytesToOdt :: B.ByteString -> Either PandocError (Pandoc, MediaBag)
bytesToOdt :: ByteString -> Either PandocError (Pandoc, MediaBag)
bytesToOdt ByteString
bytes = case ByteString -> Either String Archive
toArchiveOrFail ByteString
bytes of
  Right Archive
archive -> Archive -> Either PandocError (Pandoc, MediaBag)
archiveToOdt Archive
archive
  Left String
err      -> PandocError -> Either PandocError (Pandoc, MediaBag)
forall a b. a -> Either a b
Left (PandocError -> Either PandocError (Pandoc, MediaBag))
-> PandocError -> Either PandocError (Pandoc, MediaBag)
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocParseError
                        (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$ Text
"Could not unzip ODT: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
err

--
archiveToOdt :: Archive -> Either PandocError (Pandoc, MediaBag)
archiveToOdt :: Archive -> Either PandocError (Pandoc, MediaBag)
archiveToOdt Archive
archive = do
  let onFailure :: Text -> Maybe b -> Either PandocError b
onFailure Text
msg Maybe b
Nothing = PandocError -> Either PandocError b
forall a b. a -> Either a b
Left (PandocError -> Either PandocError b)
-> PandocError -> Either PandocError b
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocParseError Text
msg
      onFailure Text
_   (Just b
x) = b -> Either PandocError b
forall a b. b -> Either a b
Right b
x
  Entry
contentEntry <- Text -> Maybe Entry -> Either PandocError Entry
forall b. Text -> Maybe b -> Either PandocError b
onFailure Text
"Could not find content.xml"
                   (String -> Archive -> Maybe Entry
findEntryByPath String
"content.xml" Archive
archive)
  Entry
stylesEntry <- Text -> Maybe Entry -> Either PandocError Entry
forall b. Text -> Maybe b -> Either PandocError b
onFailure Text
"Could not find styles.xml"
                   (String -> Archive -> Maybe Entry
findEntryByPath String
"styles.xml" Archive
archive)
  Element
contentElem <- Entry -> Either PandocError Element
entryToXmlElem Entry
contentEntry
  Element
stylesElem <- Entry -> Either PandocError Element
entryToXmlElem Entry
stylesEntry
  Styles
styles <- (() -> Either PandocError Styles)
-> (Styles -> Either PandocError Styles)
-> Either () Styles
-> Either PandocError Styles
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
               (\()
_ -> PandocError -> Either PandocError Styles
forall a b. a -> Either a b
Left (PandocError -> Either PandocError Styles)
-> PandocError -> Either PandocError Styles
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocParseError Text
"Could not read styles")
               Styles -> Either PandocError Styles
forall a b. b -> Either a b
Right
               (Either () Styles -> Either () Styles -> Either () Styles
forall a b.
(Monoid a, Monoid b) =>
Either a b -> Either a b -> Either a b
chooseMax (Element -> Either () Styles
readStylesAt Element
stylesElem ) (Element -> Either () Styles
readStylesAt Element
contentElem))
  let filePathIsOdtMedia :: FilePath -> Bool
      filePathIsOdtMedia :: String -> Bool
filePathIsOdtMedia String
fp =
        let (String
dir, String
name) = String -> (String, String)
splitFileName String
fp
        in  (String
dir String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Pictures/") Bool -> Bool -> Bool
|| (String
dir String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"./" Bool -> Bool -> Bool
&& String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"content.xml")
  let media :: [(String, ByteString)]
media = Archive -> (String -> Bool) -> [(String, ByteString)]
filteredFilesFromArchive Archive
archive String -> Bool
filePathIsOdtMedia
  let startState :: ReaderState
startState = Styles -> [(String, ByteString)] -> ReaderState
readerState Styles
styles [(String, ByteString)]
media
  (() -> Either PandocError (Pandoc, MediaBag))
-> ((Pandoc, MediaBag) -> Either PandocError (Pandoc, MediaBag))
-> Either () (Pandoc, MediaBag)
-> Either PandocError (Pandoc, MediaBag)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\()
_ -> PandocError -> Either PandocError (Pandoc, MediaBag)
forall a b. a -> Either a b
Left (PandocError -> Either PandocError (Pandoc, MediaBag))
-> PandocError -> Either PandocError (Pandoc, MediaBag)
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocParseError Text
"Could not convert opendocument") (Pandoc, MediaBag) -> Either PandocError (Pandoc, MediaBag)
forall a b. b -> Either a b
Right
    (FallibleXMLConverter Namespace ReaderState () (Pandoc, MediaBag)
-> ReaderState -> Element -> Either () (Pandoc, MediaBag)
forall nsID extraState success.
NameSpaceID nsID =>
FallibleXMLConverter nsID extraState () success
-> extraState -> Element -> Fallible success
runConverter' FallibleXMLConverter Namespace ReaderState () (Pandoc, MediaBag)
forall _x. OdtReader _x (Pandoc, MediaBag)
read_body ReaderState
startState Element
contentElem)


--
entryToXmlElem :: Entry -> Either PandocError Element
entryToXmlElem :: Entry -> Either PandocError Element
entryToXmlElem Entry
entry =
  case Text -> Either Text Element
parseXMLElement (Text -> Either Text Element)
-> (Entry -> Text) -> Entry -> Either Text Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
UTF8.toTextLazy (ByteString -> Text) -> (Entry -> ByteString) -> Entry -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry -> ByteString
fromEntry (Entry -> Either Text Element) -> Entry -> Either Text Element
forall a b. (a -> b) -> a -> b
$ Entry
entry of
    Right Element
x  -> Element -> Either PandocError Element
forall a b. b -> Either a b
Right Element
x
    Left Text
msg -> PandocError -> Either PandocError Element
forall a b. a -> Either a b
Left (PandocError -> Either PandocError Element)
-> PandocError -> Either PandocError Element
forall a b. (a -> b) -> a -> b
$ Text -> Text -> PandocError
PandocXMLError (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Entry -> String
eRelativePath Entry
entry) Text
msg