Implement Box instances from Document to Layers and EOLStyle

src/PDF.hs

@@ -1,10 +1,13 @@
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 module PDF (
       Document(..)
     , parseDocument
     , render
   ) where
 
+import Control.Monad.Fail (MonadFail(..))
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as BS (
     drop, findIndex, head, isPrefixOf, last, length, span, unpack
@@ -13,8 +16,9 @@ import Data.ByteString.Char8.Util (previous, subBS)
 import qualified Data.ByteString.Lazy as Lazy (ByteString)
 import qualified Data.Map as Map (lookup)
 import PDF.Body (populate)
+import PDF.Box (Box(..), edit)
 import qualified PDF.EOL as EOL (Style(..), charset, parser)
-import PDF.Layer (Layer)
+import PDF.Layer (Layer, unify)
 import PDF.Object (
       DirectObject(..), InputStructure(..), Name(..), Number(..)
     , Structure(..)
@@ -23,6 +27,7 @@ import PDF.Object (
 import qualified PDF.Output as Output (render, line)
 import PDF.Output (Output(..))
 import PDF.Parser (Parser, evalParser, string, takeAll)
+import Prelude hiding (fail)
 import Text.Printf (printf)
 
 data Document = Document {
@@ -36,6 +41,34 @@ instance Output Document where
       Output.line (printf "%%PDF-%s" pdfVersion)
     `mappend` output layers
 
+data EOLStyleK = EOLStyleK
+data AllLayers = AllLayers
+data UnifiedLayers = UnifiedLayers
+
+instance Monad m => Box m EOLStyleK Document EOL.Style where
+  r EOLStyleK = return . eolStyle
+  w EOLStyleK document eolStyle = return $ document {eolStyle}
+
+instance Monad m => Box m UnifiedLayers Document Layer where
+  r UnifiedLayers = return . unify . layers
+  w UnifiedLayers document layer = w AllLayers document [layer]
+
+instance Monad m => Box m AllLayers Document [Layer] where
+  r AllLayers = return . layers
+  w AllLayers document layers = return $ document {layers = layers}
+
+instance MonadFail m => Box m Int Document Layer where
+  r i = at i . layers
+    where
+      at _ [] = fail $ "Layer out of bounds " ++ show i
+      at 0 (x:_) = return x
+      at k (_:xs) = at (k+1) xs
+  w i document layer = edit AllLayers (setAt i) document
+    where
+      setAt _ [] = fail $ "Layer out of bounds " ++ show i
+      setAt 0 (_:xs) = return (layer:xs)
+      setAt k (x:xs) = (x:)<$>(setAt (k-1) xs)
+
 render :: Document -> Lazy.ByteString
 render document@(Document {eolStyle}) = Output.render eolStyle document