diff --git a/hoodle-parser.cabal b/hoodle-parser.cabal --- a/hoodle-parser.cabal +++ b/hoodle-parser.cabal @@ -1,5 +1,5 @@ Name: hoodle-parser -Version: 0.2.2 +Version: 0.3 Synopsis: Hoodle file parser Description: Text parser for hoodle xml file Homepage: http://ianwookim.org/hoodle @@ -26,7 +26,7 @@ bytestring >= 0.9, containers >= 0.4, strict >= 0.3, - hoodle-types >= 0.2.2, + hoodle-types >= 0.3, xournal-types >= 0.5.0.2, text >= 0.11, lens >= 2.5, @@ -36,8 +36,9 @@ Text.Hoodle.Migrate.V0_1_1_to_V0_2 Text.Hoodle.Parse.Attoparsec Text.Hoodle.Parse.Attoparsec.V0_1_1 + Text.Hoodle.Parse.Attoparsec.V0_2_2 Text.Hoodle.Parse.Zlib - + Text.Hoodlet.Parse.Attoparsec diff --git a/src/Text/Hoodle/Parse/Attoparsec.hs b/src/Text/Hoodle/Parse/Attoparsec.hs --- a/src/Text/Hoodle/Parse/Attoparsec.hs +++ b/src/Text/Hoodle/Parse/Attoparsec.hs @@ -1,9 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE MultiWayIf #-} ----------------------------------------------------------------------------- -- | -- Module : Text.Hoodle.Parse.Attoparsec --- Copyright : (c) 2011-2013 Ian-Woo Kim +-- Copyright : (c) 2011-2014 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim @@ -19,10 +20,12 @@ import Control.Applicative import Data.Attoparsec import Data.Attoparsec.Char8 ( char, decimal, double, skipSpace - , isHorizontalSpace, anyChar) + , isHorizontalSpace, anyChar) import qualified Data.ByteString.Char8 as B hiding (map) import Data.Char import Data.Strict.Tuple +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE -- from hoodle-platform import qualified Data.Hoodle.Simple as H -- @@ -87,7 +90,6 @@ char '"' trim string "width=" - -- width <- double width <- strokewidth char '>' return $ XmlStroke tool color width [] @@ -127,7 +129,7 @@ -- | -onestroke :: Parser H.Stroke --- H.Item +onestroke :: Parser H.Stroke onestroke = do xstrk <- xmlstroke let r = case xstrk_width xstrk of @@ -138,7 +140,6 @@ VarWidth ws -> let xyz = mkXYZ (xstrk_xydata xstrk) ws in (H.VWStroke <$> xstrk_tool <*> xstrk_color <*> pure xyz) xstrk - -- (return . H.ItemStroke) r return r -- | @@ -203,25 +204,31 @@ textCDATA :: Parser B.ByteString textCDATA = do string "" - str <- string " manyTill anyChar (try (string "]]>")) + bstr <- getCDATA + -- str <- string " manyTill anyChar (try (string "]]>")) string "" - return (B.pack str) + return bstr -- (B.pack str) commandCDATA :: Parser B.ByteString commandCDATA = do string "" - str <- string " manyTill anyChar (try (string "]]>")) + bstr <- getCDATA + -- str <- string " manyTill anyChar (try (string "]]>")) string "" - return (B.pack str) + return bstr -- (B.pack str) renderCDATA :: Parser B.ByteString renderCDATA = do - string "" - str <- string " manyTill anyChar (try (string "]]>")) - string "" - return (B.pack str) + string "" + bstr <- getCDATA + -- str <- string " manyTill anyChar (try (string "]]>")) + string "" + return bstr -- (B.pack str) +getCDATA :: Parser B.ByteString +getCDATA = string " manyTill anyChar (try (string "]]>")) >>= return . B.pack + svg_obj :: Parser H.Item svg_obj = do (xy,dim) <- svg_header trim @@ -239,7 +246,12 @@ -link_header :: Parser (B.ByteString,B.ByteString,Maybe B.ByteString,B.ByteString,(Double,Double),H.Dimension) +link_header :: Parser ( B.ByteString + , B.ByteString + , Maybe B.ByteString + , B.ByteString + , Maybe B.ByteString + , (Double,Double),H.Dimension) link_header = do trim string " (string "type=\"" *> manyTill anyChar (try (char '"'))) trim - mlid <- case typ of - "simple" -> return Nothing - "linkdocid" -> Just<$>(string "linkedid=\"" *> takeTill (inClass "\"")<* char '"') - _ -> fail "unknown link type" - trim - loc <- B.pack <$> (string "location=\"" *> manyTill anyChar (try (char '"'))) - trim + mlid <- if | typ == "simple" -> return Nothing + | typ == "linkdocid" || typ == "anchor" -> + Just <$> (string "linkedid=\"" + *> takeTill (inClass "\"") + <* char '"') + | otherwise -> fail "unknown link type" + trim + loc <- if | typ == "simple" || typ == "linkdocid" || typ == "anchor" -> + (string "location=\"" + *> takeTill (inClass "\"") + <* char '"') + | otherwise -> fail "unknown link type" + trim + maid <- if | typ == "anchor" -> + Just <$> (string "anchorid=\"" + *> takeTill (inClass "\"") + <* char '"') + | typ == "simple" || typ == "linkdocid" -> return Nothing + | otherwise -> fail "unknown link type" + trim posx <- string "x=\"" *> double <* char '"' trim posy <- string "y=\"" *> double <* char '"' @@ -264,15 +289,14 @@ height <- string "height=\"" *> double <* char '"' trim string ">" - return (i,typ,mlid,loc,(posx,posy),H.Dim width height) + return (i,typ,mlid,loc,maid,(posx,posy),H.Dim width height) link_footer :: Parser () link_footer = string "" >> return () - link :: Parser H.Item link = do - (i,typ,mlid,loc,xy,dim) <- link_header + (i,typ,mlid,loc,maid,xy,dim) <- link_header trim (mt,mc) <- (try (do t <- textCDATA trim @@ -284,13 +308,42 @@ bstr <- renderCDATA trim link_footer - return . H.ItemLink $ - flip ($) mlid $ maybe (H.Link i typ loc mt mc bstr xy dim) - (\lid -> H.LinkDocID i lid loc mt mc bstr xy dim) - - - + let lnk | typ == "simple" = H.Link i typ loc mt mc bstr xy dim + | typ == "linkdocid" = + maybe (error "no linkedid or location for linkdocid") + (\lid -> H.LinkDocID i lid loc mt mc bstr xy dim) + mlid + | typ == "anchor" = + maybe (error "no linkedid for anchor") + (\(lid,aid) -> H.LinkAnchor i lid loc aid bstr xy dim) + ( mlid >>= \lid -> maid >>= \aid -> return (lid,aid)) + | otherwise = error "link type is not recognized" + (return . H.ItemLink) lnk +anchor :: Parser H.Item +anchor = do + trim + string " (string "id=\"" *> manyTill anyChar (try (char '"'))) + trim + posx <- string "x=\"" *> double <* char '"' + trim + posy <- string "y=\"" *> double <* char '"' + trim + width <- string "width=\"" *> double <* char '"' + trim + height <- string "height=\"" *> double <* char '"' + trim + (try (string "/>" >> + return (H.ItemAnchor (H.Anchor i "" (posx,posy) (H.Dim width height)))) + <|> (do string ">" + trim + bstr <- renderCDATA + trim + string "" >> return () + return . H.ItemAnchor $ (H.Anchor i bstr (posx,posy) (H.Dim width height)))) + -- | trim :: Parser () trim = trim_starting_space @@ -318,10 +371,12 @@ skipSpace pdf <- (try (Just <$> embeddedpdf) <|> return Nothing ) + txt <- (try (Just <$> embeddedtext) + <|> return Nothing ) pgs <- many1 (page "page") trim hoodleclose - return $ H.Hoodle hid t revs pdf pgs + return $ H.Hoodle hid t revs pdf txt pgs page :: Parser H.Page page = do trim @@ -339,7 +394,7 @@ layer = do trim layerheader "layer" trim - itms <- many (try (H.ItemStroke <$> onestroke) <|> try img <|> try svg_obj <|> link) + itms <- many (try (H.ItemStroke <$> onestroke) <|> try img <|> try svg_obj <|> try link <|> anchor) trim layerclose return $ H.Layer itms @@ -348,7 +403,7 @@ title :: Parser B.ByteString title = do trim titleheader - str <- takeTill (inClass "<") -- (many . satisfy . notInClass ) "<" + str <- takeTill (inClass "<") titleclose return str @@ -378,10 +433,7 @@ skipSpace string "" return (H.RevisionInk (B.pack md5str) strks))) - - - embeddedpdf :: Parser (B.ByteString) embeddedpdf = do string "" return (B.pack str) +embeddedtext :: Parser (T.Text) +embeddedtext = do string "" + bstr <- getCDATA + string "" + return (TE.decodeUtf8 bstr) hoodleheader :: Parser (B.ByteString,B.ByteString) hoodleheader = do hoodleheaderstart @@ -399,7 +456,7 @@ trim hid <- hoodleid trim - char '>' -- takeTill (inClass ">") <* hoodleheaderend + char '>' return (v,hid) hoodleheaderstart :: Parser B.ByteString @@ -504,11 +561,11 @@ trim "trim0" string "pageno=" char '"' - pnum <- decimal "embedpdf decimal" -- str <- manyTill anyChar (try (char '"')) + pnum <- decimal "embedpdf decimal" char '"' trim backgroundclose - return $ H.BackgroundEmbedPdf typ pnum -- (B.pack str) + return $ H.BackgroundEmbedPdf typ pnum _ -> fail "in parsing background" diff --git a/src/Text/Hoodle/Parse/Attoparsec/V0_2_2.hs b/src/Text/Hoodle/Parse/Attoparsec/V0_2_2.hs new file mode 100644 --- /dev/null +++ b/src/Text/Hoodle/Parse/Attoparsec/V0_2_2.hs @@ -0,0 +1,535 @@ +{-# LANGUAGE OverloadedStrings #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Text.Hoodle.Parse.Attoparsec.V0_2_2 +-- Copyright : (c) 2011-2014 Ian-Woo Kim +-- +-- License : BSD3 +-- Maintainer : Ian-Woo Kim +-- Stability : experimental +-- Portability : GHC +-- +-- attoparsec implementation of hoodle parser v0.2.2 +-- +----------------------------------------------------------------------------- + +module Text.Hoodle.Parse.Attoparsec.V0_2_2 where + +import Control.Applicative +import Data.Attoparsec +import Data.Attoparsec.Char8 ( char, decimal, double, skipSpace + , isHorizontalSpace, anyChar) +import qualified Data.ByteString.Char8 as B hiding (map) +import Data.Char +import Data.Strict.Tuple +-- from hoodle-platform +import qualified Data.Hoodle.Simple.V0_2_2 as H +-- +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 + +-- | +data StrokeWidth = SingleWidth Double | VarWidth [Double] + + +-- | +data XmlStroke = XmlStroke { xstrk_tool :: B.ByteString + , xstrk_color :: B.ByteString + , xstrk_width :: StrokeWidth + , xstrk_xydata :: [Pair Double Double] } + +-- | +xmlstroketagopen :: Parser XmlStroke +xmlstroketagopen = do + trim + string "" >> return () + + +-- | +xmlstroke :: Parser XmlStroke +xmlstroke = do + trim + strokeinit <- xmlstroketagopen + coordlist <- many $ do trim_starting_space + x <- double + skipSpace + y <- double + skipSpace + return (x :!: y) + xmlstroketagclose + return $ strokeinit { xstrk_xydata = coordlist } + + +-- | +onestroke :: Parser H.Stroke +onestroke = do + xstrk <- xmlstroke + let r = case xstrk_width xstrk of + SingleWidth w -> (H.Stroke <$> xstrk_tool + <*> xstrk_color + <*> pure w + <*> xstrk_xydata ) xstrk + VarWidth ws -> let xyz = mkXYZ (xstrk_xydata xstrk) ws + in (H.VWStroke <$> xstrk_tool <*> xstrk_color + <*> pure xyz) xstrk + return r + +-- | +mkXYZ :: [Pair Double Double] -> [Double] -> [(Double,Double,Double)] +mkXYZ = zipWith f where f (x :!: y) z = (x,y,z) + +-- | +img :: Parser H.Item +img = do trim + string "" + (return . H.ItemImage) (H.Image fsrc (posx,posy) (H.Dim width height)) + + +svg_header :: Parser ((Double,Double),H.Dimension) +svg_header = do trim + string "" + return ((posx,posy),H.Dim width height) + +svg_footer :: Parser () +svg_footer = string "" >> return () + +textCDATA :: Parser B.ByteString +textCDATA = do + string "" + str <- string " manyTill anyChar (try (string "]]>")) + string "" + return (B.pack str) + +commandCDATA :: Parser B.ByteString +commandCDATA = do + string "" + str <- string " manyTill anyChar (try (string "]]>")) + string "" + return (B.pack str) + +renderCDATA :: Parser B.ByteString +renderCDATA = do + string "" + str <- string " manyTill anyChar (try (string "]]>")) + string "" + return (B.pack str) + + +svg_obj :: Parser H.Item +svg_obj = do (xy,dim) <- svg_header + trim + (mt,mc) <- (try (do t <- textCDATA + trim + c <- commandCDATA + return (Just t, Just c)) + <|> try (textCDATA >>= \t -> return (Just t, Nothing)) + <|> return (Nothing,Nothing)) + trim + bstr <- renderCDATA + trim + svg_footer + (return . H.ItemSVG) (H.SVG mt mc bstr xy dim) + + + +link_header :: Parser (B.ByteString,B.ByteString,Maybe B.ByteString,B.ByteString,(Double,Double),H.Dimension) +link_header = do + trim + string " (string "id=\"" *> manyTill anyChar (try (char '"'))) + trim + typ <- B.pack <$> (string "type=\"" *> manyTill anyChar (try (char '"'))) + trim + mlid <- case typ of + "simple" -> return Nothing + "linkdocid" -> Just<$>(string "linkedid=\"" *> takeTill (inClass "\"")<* char '"') + _ -> fail "unknown link type" + trim + loc <- B.pack <$> (string "location=\"" *> manyTill anyChar (try (char '"'))) + trim + posx <- string "x=\"" *> double <* char '"' + trim + posy <- string "y=\"" *> double <* char '"' + trim + width <- string "width=\"" *> double <* char '"' + trim + height <- string "height=\"" *> double <* char '"' + trim + string ">" + return (i,typ,mlid,loc,(posx,posy),H.Dim width height) + +link_footer :: Parser () +link_footer = string "" >> return () + + +link :: Parser H.Item +link = do + (i,typ,mlid,loc,xy,dim) <- link_header + trim + (mt,mc) <- (try (do t <- textCDATA + trim + c <- commandCDATA + return (Just t, Just c)) + <|> try (textCDATA >>= \t -> return (Just t, Nothing)) + <|> return (Nothing,Nothing)) + trim + bstr <- renderCDATA + trim + link_footer + return . H.ItemLink $ + flip ($) mlid $ maybe (H.Link i typ loc mt mc bstr xy dim) + (\lid -> H.LinkDocID i lid loc mt mc bstr xy dim) + + + + +-- | +trim :: Parser () +trim = trim_starting_space + +-- | +checkHoodleVersion :: Parser B.ByteString +checkHoodleVersion = do trim + xmlheader + trim + hoodleheaderstart + trim + hoodleversion + + +-- | +hoodle :: Parser H.Hoodle +hoodle = do trim + xmlheader "xmlheader" + trim + (_v,hid) <- hoodleheader "hoodleheader" + trim + t <- title "title" + trim + revs <- many (revision "revision") + skipSpace + pdf <- (try (Just <$> embeddedpdf) + <|> return Nothing ) + pgs <- many1 (page "page") + trim + hoodleclose + return $ H.Hoodle hid t revs pdf pgs + +page :: Parser H.Page +page = do trim + dim <- pageheader + trim + bkg <- background "background" + trim + layers <- many1 layer + trim + pageclose + return $ H.Page dim bkg layers + + +layer :: Parser H.Layer +layer = do trim + layerheader "layer" + trim + itms <- many (try (H.ItemStroke <$> onestroke) <|> try img <|> try svg_obj <|> link) + trim + layerclose + return $ H.Layer itms + + +title :: Parser B.ByteString +title = do trim + titleheader + str <- takeTill (inClass "<") + titleclose + return str + +titleheader :: Parser B.ByteString +titleheader = string "" + +titleclose :: Parser B.ByteString +titleclose = string "" + +revision :: Parser H.Revision +revision = do skipSpace + string "" + return (H.Revision (B.pack md5str) (B.pack txtstr))) + <|> (do string "type=\"ink\"" + skipSpace + char '>' + skipSpace + strks <- many1 onestroke + skipSpace + string "" + return (H.RevisionInk (B.pack md5str) strks))) + + + + +embeddedpdf :: Parser (B.ByteString) +embeddedpdf = do string "" + return (B.pack str) + + +hoodleheader :: Parser (B.ByteString,B.ByteString) +hoodleheader = do hoodleheaderstart + trim + v <- hoodleversion + trim + hid <- hoodleid + trim + char '>' + return (v,hid) + +hoodleheaderstart :: Parser B.ByteString +hoodleheaderstart = string " takeTill (inClass "\"") <* char '"' + +hoodleid :: Parser B.ByteString +hoodleid = string "id=\"" *> takeTill (inClass "\"") <* char '"' + +hoodleheaderend :: Parser Char +hoodleheaderend = char '>' + +hoodleclose :: Parser B.ByteString +hoodleclose = string "" + +pageheader :: Parser H.Dimension +pageheader = do pageheaderstart + trim + string "width=" + char '"' + w <- double + char '"' + trim + string "height=" + char '"' + h <- double + char '"' + takeTill (inClass ">") + pageheaderend + return $ H.Dim w h + +pageheaderstart :: Parser B.ByteString +pageheaderstart = string "' + +pageclose :: Parser B.ByteString +pageclose = string "" + +layerheader :: Parser B.ByteString +layerheader = string "" + +layerclose :: Parser B.ByteString +layerclose = string "" + +background :: Parser H.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 $ H.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 $ H.BackgroundPdf typ mdomain mfilename pnum + "embedpdf" -> do + trim "trim0" + string "pageno=" + char '"' + pnum <- decimal "embedpdf decimal" + char '"' + trim + backgroundclose + return $ H.BackgroundEmbedPdf typ pnum + _ -> fail "in parsing background" + + +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 ['"']) + + +-- | +backgroundheader :: Parser B.ByteString +backgroundheader = string "" + diff --git a/src/Text/Hoodlet/Parse/Attoparsec.hs b/src/Text/Hoodlet/Parse/Attoparsec.hs new file mode 100644 --- /dev/null +++ b/src/Text/Hoodlet/Parse/Attoparsec.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE OverloadedStrings #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Text.Hoodlet.Parse.Attoparsec +-- Copyright : (c) 2014 Ian-Woo Kim +-- +-- License : BSD3 +-- Maintainer : Ian-Woo Kim +-- Stability : experimental +-- Portability : GHC +-- +-- attoparsec implementation of hoodle parser +-- +----------------------------------------------------------------------------- + +module Text.Hoodlet.Parse.Attoparsec where + +import Control.Applicative +import Data.Attoparsec +import Data.Attoparsec.Char8 +import qualified Data.ByteString.Char8 as B +-- +import qualified Data.Hoodle.Simple as H +-- +import Text.Hoodle.Parse.Attoparsec + + + +-- | +hoodlet :: Parser H.Item +hoodlet = do trim + xmlheader "xmlheader" + trim + hoodletheader "hoodletheader" + trim + itm <- try (H.ItemStroke <$> onestroke) <|> try img <|> try svg_obj <|> link + trim + string "" + return itm + +hoodletheader :: Parser B.ByteString +hoodletheader = do string "' + return v +