module Hoodle.ModelAction.File where
import Control.Applicative
import Control.Lens (view,set)
import Data.Attoparsec.ByteString.Char8
import Data.ByteString.Base64
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Lazy.Char8 as L
import Data.Maybe
import Data.Monoid ((<>))
import Data.Time.Clock
import qualified Data.Traversable as T
import Graphics.GD.ByteString
import qualified Graphics.UI.Gtk.Poppler.Document as Poppler
import qualified Graphics.UI.Gtk.Poppler.Page as PopplerPage
import System.Directory (canonicalizePath)
import System.FilePath (takeExtension)
import System.IO (hClose, hFileSize, openFile, IOMode(..))
import System.Process
import Data.Hoodle.Simple
import Graphics.Hoodle.Render.Background
import Graphics.Hoodle.Render.Type.Hoodle
import Text.Hoodle.Builder (builder)
import qualified Text.Hoodle.Parse.Attoparsec as PA
import qualified Text.Hoodle.Migrate.V0_2_2_to_V0_3 as MV
import qualified Text.Hoodle.Migrate.V0_3_to_HEAD as MVHEAD
import Hoodle.Type.HoodleState
import Hoodle.Util
checkVersionAndMigrate :: C.ByteString -> IO (Either String Hoodle)
checkVersionAndMigrate bstr = do
case parseOnly PA.checkHoodleVersion bstr of
Left str -> error str
Right v -> do
if ( v <= "0.2.2" )
then T.traverse MVHEAD.hoodle2Hoodle =<< (MV.migrate bstr)
else return (parseOnly PA.hoodle bstr)
findFirstPDFFile :: [Page] -> Maybe C.ByteString
findFirstPDFFile xs = let ys = mapMaybe f xs
in listToMaybe ys
where f :: Page -> Maybe C.ByteString
f p = case page_bkg p of
BackgroundPdf _ _ fi _ -> fi
_ -> Nothing
findAllPDFPages :: [Page] -> [Int]
findAllPDFPages = catMaybes . map f
where f p = case page_bkg p of
BackgroundPdf _ _ _ n -> Just n
_ -> Nothing
replacePDFPages :: [Page] -> [Page]
replacePDFPages xs = map f xs
where f p = let bkg = page_bkg p
in case bkg of
BackgroundPdf typ _ _ pdfn -> p { page_bkg = BackgroundEmbedPdf typ pdfn }
_ -> p
embedPDFInHoodle :: Hoodle -> IO Hoodle
embedPDFInHoodle hdl = putStrLn "embedPDFInHoodle is now bugful. I do not do anything here " >> return hdl
makeEmbeddedPdfSrcString :: C.ByteString -> C.ByteString
makeEmbeddedPdfSrcString = ("data:application/x-pdf;base64," <>) . encode
makeNewHoodleWithPDF :: Bool
-> FilePath
-> IO (Maybe Hoodle)
makeNewHoodleWithPDF doesembed ofp = do
ocanonicalfp <- canonicalizePath ofp
let ofname = C.pack ocanonicalfp
let sizelimit = 10000000
siz <- do
h <- openFile ofp ReadMode
s <- hFileSize h
hClose h
return s
(nfp,nfname) <- if (siz > sizelimit)
then do putStrLn $ "size is " ++ show siz ++ ", which is larger than " ++ show sizelimit
nfp' <- mkTmpFile "pdf"
let nfname' = C.pack nfp'
readProcess "gs" [ "-q", "-dNOPAUSE", "-dBATCH", "-dSAFER"
, "-sDEVICE=pdfwrite", "-dCompatibilityLevel=1.3"
, "-dPDFSETTINGS=/screen", "-dEmbedAllFonts=true"
, "-dSubsetFonts=true", "-dColorImageDownsampleType=/Bicubic"
, "-dColorImageResolution=72", "-dGrayImageDownsampleType=/Bicubic"
, "-dGrayImageResolution=72", "-dMonoImageDownsampleType=/Bicubic"
, "-dMonoImageResolution=72", "-sOutputFile="++nfp'
, ofp ] ""
return (nfp',nfname')
else return (ocanonicalfp,ofname)
mdoc <- popplerGetDocFromFile nfname
case mdoc of
Nothing -> do
putStrLn $ "no such file " ++ nfp
return Nothing
Just doc -> do
n <- Poppler.documentGetNPages doc
let createPageAct i = do
pg <- Poppler.documentGetPage doc (i1)
(w,h) <- PopplerPage.pageGetSize pg
let dim = Dim w h
return (createPage doesembed dim nfname i)
pgs <- mapM createPageAct [1..n]
hdl <- set title nfname . set pages pgs <$> emptyHoodle
nhdl <- if doesembed
then do
bstr <- C.readFile nfp
let ebdsrc = makeEmbeddedPdfSrcString bstr
return (set embeddedPdf (Just ebdsrc) hdl)
else return hdl
return (Just nhdl)
createPage :: Bool
-> Dimension
-> C.ByteString
-> Int
-> Page
createPage doesembed dim fn n =
let bkg
| not doesembed && n == 1
= BackgroundPdf "pdf" (Just "absolute") (Just fn ) n
| not doesembed && n /= 1
= BackgroundPdf "pdf" Nothing Nothing n
| otherwise
= BackgroundEmbedPdf "embedpdf" n
in Page dim bkg [emptyLayer]
saveHoodle :: UnitHoodle -> IO UnitHoodle
saveHoodle uhdl = do
let hdl = (rHoodle2Hoodle . getHoodle) uhdl
case view (hoodleFileControl.hoodleFileName) uhdl of
LocalDir Nothing -> return uhdl
LocalDir (Just filename) -> action hdl filename
TempDir filename -> action hdl filename
where
action hdl filename = do
L.writeFile filename . builder $ hdl
ctime <- getCurrentTime
return (set isSaved True . set (hoodleFileControl.lastSavedTime) (Just ctime) $ uhdl)
makeNewItemImage :: Bool
-> FilePath
-> IO Item
makeNewItemImage isembedded filename =
if isembedded
then let fileext = takeExtension filename
imgaction
| fileext == ".PNG" || fileext == ".png" = loadpng
| fileext == ".JPG" || fileext == ".jpg" = loadjpg
| otherwise = loadsrc
in imgaction
else loadsrc
where loadsrc = (return . ItemImage) (Image (C.pack filename) (100,100) (Dim 300 300))
loadpng = do
img <- loadPngFile filename
(w,h) <- imageSize img
let dim | w < 612 && h < 792 = Dim (fromIntegral w) (fromIntegral h)
| w < 765 && h < 990 = Dim (fromIntegral w * 72 / 90)
(fromIntegral h * 72 / 90)
| w >= h = Dim 300 (fromIntegral h*300/fromIntegral w)
| otherwise = Dim (fromIntegral w*300/fromIntegral h) 300
bstr <- C.readFile filename
let b64str = encode bstr
ebdsrc = "data:image/png;base64," <> b64str
return . ItemImage $ Image ebdsrc (50,100) dim
loadjpg = do
img <- loadJpegFile filename
(w,h) <- imageSize img
let dim | w < 612 && h < 792 = Dim (fromIntegral w) (fromIntegral h)
| w < 765 && h < 990 = Dim (fromIntegral w * 72 / 90)
(fromIntegral h * 72 / 90)
| w >= h = Dim 300 (fromIntegral h*300/fromIntegral w)
| otherwise = Dim (fromIntegral w*300/fromIntegral h) 300
bstr <- savePngByteString img
let b64str = encode bstr
ebdsrc = "data:image/png;base64," <> b64str
return . ItemImage $ Image ebdsrc (50,100) dim