Found a quite practical way of writing things and handle Traversables

This commit is contained in:
Tissevert 2020-02-26 17:22:44 +01:00
parent 4fe8ab2252
commit 3d994862b4

View file

@ -12,9 +12,9 @@ import qualified Data.ByteString.Lazy.Char8 as Lazy (
fromStrict, intercalate, split, toStrict, writeFile fromStrict, intercalate, split, toStrict, writeFile
) )
import qualified Data.Map as Map (insert, lookup) import qualified Data.Map as Map (insert, lookup)
import PDF (AllLayers(..), Document(..), UnifiedLayers(..), parseDocument, render) import PDF (Layers(..), Document(..), UnifiedLayers(..), parseDocument, render)
import PDF.Box (I(..), (.@), edit, modifyAt) import PDF.Box (I(..), at, atAll, edit)
import PDF.Layer (AllObjects(..)) import PDF.Layer (Objects(..))
import PDF.Object (DirectObject(..), Object(..), Name(..), Number(..)) import PDF.Object (DirectObject(..), Object(..), Name(..), Number(..))
import PDF.TextRendering (TextRendering(..), update) import PDF.TextRendering (TextRendering(..), update)
import Prelude hiding (lines, unlines) import Prelude hiding (lines, unlines)
@ -44,17 +44,17 @@ revealObject obj@(Stream {header, streamContent}) =
revealObject obj = obj revealObject obj = obj
reveal :: Document -> Document reveal :: Document -> Document
reveal = execState $ do reveal = execState $
modifyAt (UnifiedLayers .@ AllObjects) (return . fmap revealObject) edit .at UnifiedLayers .atAll Objects $ return . revealObject
revealFirst :: Document -> Document revealFirst :: Document -> Document
revealFirst document = maybe document id $ execStateT (do revealFirst document = maybe document id $ execStateT (
modifyAt (AllLayers .@ I 0 .@ AllObjects) (return . fmap revealObject) edit .at Layers .at(I 0) .atAll Objects $ return . revealObject
) document ) document
deepReveal :: Document -> Document deepReveal :: Document -> Document
deepReveal = execState $ do deepReveal = execState $
modifyAt AllLayers (mapM . edit AllObjects $ return . fmap revealObject) edit .atAll Layers .atAll Objects $ return . revealObject
main :: IO () main :: IO ()
main = do main = do