module Text.Xournal.Parse where
import Control.Applicative hiding (many)
import Data.Attoparsec
import Data.Attoparsec.Char8 ( char, decimal, double, skipSpace
, isHorizontalSpace)
import qualified Data.ByteString.Char8 as B hiding (map)
import qualified Data.Iteratee as Iter
import Data.Iteratee.Char
import qualified Data.Attoparsec.Iteratee as AI
import Data.Char
import Data.Xournal.Simple
import Text.Xournal.Parse.Zlib
import Data.Strict.Tuple
import Prelude hiding (takeWhile)
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
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 "<")
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 "/>")
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) )
parseFileName :: Parser B.ByteString
parseFileName = takeTill (inClass ['"'])
backgroundheader :: Parser B.ByteString
backgroundheader = string "<background"
backgroundclose :: Parser B.ByteString
backgroundclose = string "/>"
iter_xournal :: Iter.Iteratee 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