{-# 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 :: forall (m :: * -> *).
PandocMonad m =>
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 Failure
forall (m :: * -> *). PandocMonad m => MediaBag -> m Failure
P.setMediaBag MediaBag
mb
    Pandoc -> m Pandoc
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pandoc
doc
  Left PandocError
e -> PandocError -> m Pandoc
forall a. PandocError -> m a
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 <- (Failure -> Either PandocError Styles)
-> (Styles -> Either PandocError Styles)
-> Either Failure Styles
-> Either PandocError Styles
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
               (\Failure
_ -> 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 Failure Styles
-> Either Failure Styles -> Either Failure Styles
forall a b.
(Monoid a, Monoid b) =>
Either a b -> Either a b -> Either a b
chooseMax (Element -> Either Failure Styles
readStylesAt Element
stylesElem ) (Element -> Either Failure 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
  (Failure -> Either PandocError (Pandoc, MediaBag))
-> ((Pandoc, MediaBag) -> Either PandocError (Pandoc, MediaBag))
-> Either Failure (Pandoc, MediaBag)
-> Either PandocError (Pandoc, MediaBag)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\Failure
_ -> 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 Failure (Pandoc, MediaBag)
-> ReaderState -> Element -> Either Failure (Pandoc, MediaBag)
forall nsID extraState success.
NameSpaceID nsID =>
FallibleXMLConverter nsID extraState Failure success
-> extraState -> Element -> Fallible success
runConverter' FallibleXMLConverter
  Namespace ReaderState Failure (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