xournal-parser-0.5: src/Text/Xournal/Parse.hs
{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module : Text.Xournal.Parse
-- Copyright : (c) 2011, 2012 Ian-Woo Kim
--
-- License : BSD3
-- Maintainer : Ian-Woo Kim <ianwookim@gmail.com>
-- Stability : experimental
-- Portability : GHC
--
-----------------------------------------------------------------------------
module Text.Xournal.Parse
( module Text.Xournal.Parse.Conduit ) where
import Text.Xournal.Parse.Conduit
{-
-- from other packages by others
import Control.Applicative
import Data.Attoparsec
import Data.Attoparsec.Char8 ( char, decimal, double, skipSpace
, isHorizontalSpace)
import qualified Data.ByteString.Char8 as B hiding (map)
import Data.Char
import qualified Data.Conduit as C
import Data.Conduit.Attoparsec
import Data.Strict.Tuple
-- from other hoodle packages
import Data.Xournal.Simple
-- from this package
import Text.Xournal.Parse.Zlib
--
import Prelude hiding (takeWhile)
-- import qualified Data.Iteratee as Iter
-- import Data.Iteratee.Char
-- import qualified Data.Attoparsec.Iteratee as AI
-}
{-
-- |
skipSpaces :: Parser ()
skipSpaces = satisfy isHorizontalSpace *> skipWhile isHorizontalSpace
-- |
trim_starting_space :: Parser ()
trim_starting_space = do try endOfInput
<|> takeWhile (inClass " \n") *> return ()
-- |
langle :: Parser Char
langle = char '<'
-- |
rangle :: Parser Char
rangle = char '>'
-- |
xmlheader :: Parser B.ByteString
xmlheader = string "<?" *> takeTill (inClass "?>") <* string "?>"
-- |
headercontentWorker :: B.ByteString -> Parser B.ByteString
headercontentWorker bstr = do
h <- takeWhile1 (notInClass "?>")
((string "?>" >>= return . (bstr `B.append` h `B.append`))
<|> headercontentWorker (bstr `B.append` h))
-- |
headercontent :: Parser B.ByteString
headercontent = headercontentWorker B.empty
-- |
stroketagopen :: Parser Stroke -- B.ByteString
stroketagopen = do
trim
string "<stroke"
trim
string "tool="
char '"'
tool <- alphabet
char '"'
trim
string "color="
char '"'
color <- alphanumsharp
char '"'
trim
string "width="
char '"'
width <- double
char '"'
char '>'
return $ Stroke tool color width []
-- |
stroketagclose :: Parser B.ByteString
stroketagclose = string "</stroke>"
-- |
onestroke :: Parser Stroke
onestroke = do trim
strokeinit <- stroketagopen
coordlist <- many $ do trim_starting_space
x <- double
skipSpace
y <- double
skipSpace
return (x :!: y)
stroketagclose
return $ strokeinit { stroke_data = coordlist }
-- |
trim :: Parser ()
trim = trim_starting_space
-- |
parser_xournal :: Parser Xournal
parser_xournal = do trim
xmlheader <?> "xmlheader"
trim
xournal <?> "xournal"
-- |
xournal :: Parser Xournal
xournal = do trim
xournalheader <?> "xournalheader"
trim
t <- title <?> "title"
trim
(try (preview >> return ())
<|> return ())
pgs <- many1 (page <?> "page")
trim
xournalclose
return $ Xournal t pgs
-- |
page :: Parser Page
page = do trim
dim <- pageheader
trim
bkg <- background <?> "background"
trim
layers <- many1 layer
trim
pageclose
return $ Page dim bkg layers
-- |
layer :: Parser Layer
layer = do trim
layerheader
trim
strokes <- many onestroke
trim
layerclose
return $ Layer strokes
-- |
title :: Parser B.ByteString
title = do trim
titleheader
str <- takeTill (inClass "<") -- (many . satisfy . notInClass ) "<"
titleclose
return str
-- |
titleheader :: Parser B.ByteString
titleheader = string "<title>"
-- |
titleclose :: Parser B.ByteString
titleclose = string "</title>"
-- |
preview :: Parser ()
preview = do trim
previewheader
str <- takeTill (inClass "<")
previewclose
trim
-- |
previewheader :: Parser B.ByteString
previewheader = string "<preview>"
-- |
previewclose :: Parser B.ByteString
previewclose = string "</preview>"
-- |
xournalheader :: Parser B.ByteString
xournalheader = xournalheaderstart *> takeTill (inClass ">") <* xournalheaderend
-- |
xournalheaderstart :: Parser B.ByteString
xournalheaderstart = string "<xournal"
-- |
xournalheaderend :: Parser Char
xournalheaderend = char '>'
-- |
xournalclose :: Parser B.ByteString
xournalclose = string "</xournal>"
-- |
pageheader :: Parser Dimension
pageheader = do pageheaderstart
trim
string "width="
char '"'
w <- double
char '"'
trim
string "height="
char '"'
h <- double
char '"'
takeTill (inClass ">")
pageheaderend
return $ Dim w h
-- |
pageheaderstart :: Parser B.ByteString
pageheaderstart = string "<page"
-- |
pageheaderend :: Parser Char
pageheaderend = char '>'
-- |
pageclose :: Parser B.ByteString
pageclose = string "</page>"
-- |
layerheader :: Parser B.ByteString
layerheader = string "<layer>"
-- |
layerclose :: Parser B.ByteString
layerclose = string "</layer>"
-- |
background :: Parser Background
background = do
trim
backgroundheader
trim
string "type="
char '"'
typ <- alphabet
char '"'
case typ of
"solid" -> do
trim
string "color="
char '"'
col <- alphanumsharp
char '"'
trim
string "style="
trim
char '"'
sty <- alphabet
char '"'
trim
takeTill (inClass "/>") -- ( many . satisfy . notInClass ) "/>"
backgroundclose
return $ Background typ col sty
"pdf" -> do
trim <?> "trim0"
(mdomain,mfilename) <- (try $ do
string "domain="
char '"'
domain <- alphabet
char '"'
trim <?> "trim1"
string "filename="
trim <?> "trim2"
char '"'
filename <- parseFileName <?> "filename parse"
char '"'
return (Just domain, Just filename))
<|> return (Nothing,Nothing)
trim <?> "trim3"
string "pageno="
trim <?> "trim4"
char '"'
pnum <- decimal <?> "decimal"
char '"'
trim
takeTill (inClass "/>") <?> "here takeTill"
backgroundclose
return $ BackgroundPdf typ mdomain mfilename pnum
-- |
alphabet :: Parser B.ByteString
alphabet = takeWhile1 (\w -> (w >= 65 && w <= 90) || (w >= 97 && w <= 122))
-- |
alphanumsharp :: Parser B.ByteString
alphanumsharp = takeWhile1 (\w -> (w >= 65 && w <= 90)
|| (w >= 97 && w <= 122)
|| ( w >= 48 && w<= 57 )
|| ( w== 35) )
-- | need to be reimplemented
parseFileName :: Parser B.ByteString
parseFileName = takeTill (inClass ['"'])
-- takeWhilw1 (\w -> (w >= 65 && w <= 90)
-- || (w >= 97 && w <= 122)
-- || (w >= 48 && w <= 57)
-- || (w == 35)
-- |
backgroundheader :: Parser B.ByteString
backgroundheader = string "<background"
-- |
backgroundclose :: Parser B.ByteString
backgroundclose = string "/>"
-- |
iter_xournal :: Sink B.ByteString IO Xournal
iter_xournal = AI.parserToIteratee parser_xournal
-- |
read_xournal :: String -> IO Xournal
read_xournal str = Iter.fileDriver iter_xournal str
-- |
read_xojgz :: String -> IO Xournal
read_xojgz str = Iter.fileDriver (Iter.joinIM (ungzipXoj iter_xournal)) str
-- |
cat_xournalgz :: String -> IO ()
cat_xournalgz str = Iter.fileDriver
(Iter.joinIM (ungzipXoj printLinesUnterminated)) str
-- |
onlyresult (Done _ r) = r
-}