Implement 'w' for Pages Box instances

src/PDF/Pages.hs

@@ -17,27 +17,30 @@ import Control.Applicative (Alternative, (<|>))
 import Control.Monad (foldM)
 import Control.Monad.Fail (MonadFail(..))
 import Control.Monad.Reader (ReaderT, runReaderT)
-import Control.Monad.State (StateT(..), evalStateT, gets, modify)
+import Control.Monad.State (StateT(..), evalStateT, execStateT, gets, modify)
 import Control.Monad.Trans (lift)
+import Data.ByteString.Lazy (toStrict)
 import Data.Id (Id)
 import Data.Map (Map)
 import qualified Data.Map as Map (empty, fromList, insert, lookup, toList)
-import Data.OrderedMap (OrderedMap, build)
-import PDF.Box (Box(..))
+import Data.OrderedMap (OrderedMap, build, mapi)
+import PDF.Box (Box(..), at, edit)
 import PDF.CMap (cMap)
 import PDF.Content (Content(..))
 import qualified PDF.Content as Content (parse)
 import PDF.Encoding (encoding)
+import PDF.EOL (Style(..))
 import PDF.Font (Font, FontSet)
-import PDF.Layer (Layer(..))
+import PDF.Layer (Layer(..), Objects(..))
 import PDF.Object (
       Dictionary, DirectObject(..), IndirectObjCoordinates(..)
     , Name(..), Object(..)
   ,)
 import PDF.Object.Navigation (
-      Clear(..), PDFContent, (//), (>./), (>//), getDictionary
+      Clear(..), (//), (>./), (>//), getDictionary
     , getKey, objectById, origin
   )
+import PDF.Output (render)
 import Prelude hiding (fail)
 import Text.Printf (printf)
 
@@ -113,6 +116,13 @@ pagesList =
     getReferences (Array kids) = kids >>= getReference
     getReferences _ = fail "Not a pages array"
 
+updatePage :: MonadFail m => Page -> StateT Layer m ()
+updatePage (Page {contents}) = sequence_ $ mapi updateContent contents
+  where
+    updateContent source content =
+      edit . at Objects . at source . at Clear $ setContent content
+    setContent content _ = return . toStrict $ render LF content
+
 data Pages = Pages
 newtype PageNumber = P Int
 data Contents = Contents
@@ -123,6 +133,8 @@ instance (Alternative m, MonadFail m) => Box m Pages Layer (Map Int Page) where
       numbered :: [Page] -> Map Int Page
       numbered = Map.fromList . zip [1..]
 
+  w Pages pages = execStateT $ mapM_ updatePage pages
+
 instance (Alternative m, MonadFail m) => Box m PageNumber Layer Page where
   r (P i) layer
     | i < 1 = fail "Pages start at 1"
@@ -131,8 +143,11 @@ instance (Alternative m, MonadFail m) => Box m PageNumber Layer Page where
       firstPage [] = fail "Page is out of bounds"
       firstPage (p:_) = loadPage p
 
+  w _ page = execStateT $ updatePage page
+
 instance Monad m => Box m Contents Page (OrderedMap (Id Object) Content) where
   r Contents = return . contents
+  w _ contents page = return $ page {contents}
 
 cacheFonts :: Monad m => StateT CachedFonts m a -> m a
 cacheFonts = flip evalStateT Map.empty