hoodle-parser (empty) → 0.1
raw patch · 6 files changed
+558/−0 lines, 6 filesdep +attoparsecdep +attoparsec-conduitdep +basesetup-changed
Dependencies added: attoparsec, attoparsec-conduit, base, bytestring, conduit, containers, hoodle-types, lens, mtl, strict, text, transformers, xournal-types, zlib-conduit
Files
- LICENSE +25/−0
- Setup.lhs +10/−0
- hoodle-parser.cabal +48/−0
- src/Text/Hoodle/Parse/Attoparsec.hs +392/−0
- src/Text/Hoodle/Parse/Zlib.hs +26/−0
- src/Text/Hoodle/Translate/FromXournal.hs +57/−0
+ LICENSE view
@@ -0,0 +1,25 @@+The following license covers this documentation, and the source code, except+where otherwise indicated.++Copyright 2011-2011, Ian-Woo Kim. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO+EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.lhs view
@@ -0,0 +1,10 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> import Distribution.PackageDescription+> --import System.Process+> main = defaultMain+> --main = defaultMainWithHooks testUserHooks+> --testUserHooks = simpleUserHooks { +> -- preConf = \_ _ -> runCommand "cd rootcode; make; cd .." >>return emptyHookedBuildInfo+> -- }
+ hoodle-parser.cabal view
@@ -0,0 +1,48 @@+Name: hoodle-parser+Version: 0.1+Synopsis: Hoodle file parser+Description: Text parser for hoodle xml file+Homepage: http://ianwookim.org/hoodle+License: BSD3+License-file: LICENSE+Author: Ian-Woo Kim+Maintainer: Ian-Woo Kim <ianwookim@gmail.com>+Category: Text+Build-Type: Simple+Cabal-Version: >= 1.8+Source-repository head+ type: git+ location: http://www.github.com/wavewave/hoodle-parser+++Library+ hs-source-dirs: src+ ghc-options: -Wall -funbox-strict-fields -fno-warn-unused-do-bind+ ghc-prof-options: -caf-all -auto-all+ Build-Depends: base == 4.*, + mtl == 2.*, + transformers == 0.3.*, + attoparsec == 0.10.*, + bytestring == 0.9.*, + containers == 0.4.*, + -- xml-conduit == 1.0.*,+ conduit == 0.5.*,+ strict == 0.3.*, + attoparsec-conduit == 0.5.*,+ hoodle-types >= 0.0.999 && < 0.2, + xournal-types >= 0.4.999 && < 0.6,+ -- xml-types == 0.3.*, + text == 0.11.*,+ lens >= 2.4 && < 2.7, + zlib-conduit == 0.5.*+ Exposed-Modules: + -- Text.Hoodle.Parse+ Text.Hoodle.Parse.Attoparsec+ -- Text.Hoodle.Parse.Conduit -- for the time being + Text.Hoodle.Parse.Zlib+ Text.Hoodle.Translate.FromXournal++++ +
+ src/Text/Hoodle/Parse/Attoparsec.hs view
@@ -0,0 +1,392 @@+{-# LANGUAGE OverloadedStrings #-}++-----------------------------------------------------------------------------+-- |+-- Module : Text.Hoodle.Parse.Attoparsec+-- Copyright : (c) 2011, 2012 Ian-Woo Kim+--+-- License : BSD3+-- Maintainer : Ian-Woo Kim <ianwookim@gmail.com>+-- Stability : experimental+-- Portability : GHC+--+-- attoparsec implementation of hoodle parser+-- +-----------------------------------------------------------------------------++module Text.Hoodle.Parse.Attoparsec where++import Control.Applicative +import Data.Attoparsec+import Data.Attoparsec.Char8 ( char, decimal, double, skipSpace+ , isHorizontalSpace)+-- import qualified Data.Attoparsec.Iteratee as AI+import qualified Data.ByteString.Char8 as B hiding (map) +import Data.Char +-- import qualified Data.Iteratee as Iter+-- import Data.Iteratee.Char+import Data.Strict.Tuple+-- from hoodle-platform +import qualified Data.Hoodle.Simple 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 "<stroke"+ trim + string "tool="+ char '"'+ tool <- alphabet + char '"'+ trim + string "color="+ char '"'+ color <- alphanumsharp + char '"'+ trim + string "width="+ -- width <- double + width <- strokewidth + char '>' + return $ XmlStroke tool color width [] ++strokewidth :: Parser StrokeWidth +strokewidth = do + char '"'+ wlst <- many $ do trim_starting_space+ w <- double+ skipSpace + return w+ char '"'+ let msw | length wlst == 1 = return (SingleWidth (head wlst)) + | length wlst == 0 = fail "no width"+ | otherwise = return (VarWidth wlst)+ msw++ +-- | +xmlstroketagclose :: Parser ()+xmlstroketagclose = string "</stroke>" >> 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.Item +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 . H.ItemStroke) 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 "<img"+ trim + string "src=\""+ fsrc <- parseFileName + char '"'+ trim + string "x=\""+ posx <- double + char '"'+ trim+ string "y=\""+ posy <- double+ char '"'+ trim + string "width=\""+ width <- double+ char '"'+ trim + string "height=\""+ height <- double+ char '"'+ trim + string "/>"+ (return . H.ItemImage) (H.Image fsrc (posx,posy) (H.Dim width height))+ + ++-- | +trim :: Parser ()+trim = trim_starting_space++ +-- | +hoodle :: Parser H.Hoodle +hoodle = do trim+ xmlheader <?> "xmlheader"+ trim+ hoodleheader <?> "hoodleheader"+ trim+ t <- title <?> "title"+ trim+ (try (preview >> return ())+ <|> return ()) + pgs <- many1 (page <?> "page")+ trim+ hoodleclose + return $ H.Hoodle t 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+ trim+ -- s1 <- onestroke + -- s2 <- img+ -- let strokes = [s1,s2]+ itms <- many (try onestroke <|> img)+ trim+ layerclose + return $ H.Layer itms+++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>"++hoodleheader :: Parser B.ByteString+hoodleheader = hoodleheaderstart *> takeTill (inClass ">") <* hoodleheaderend++hoodleheaderstart :: Parser B.ByteString +hoodleheaderstart = string "<hoodle"++hoodleheaderend :: Parser Char+hoodleheaderend = char '>'++hoodleclose :: Parser B.ByteString+hoodleclose = string "</hoodle>"++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 "<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 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 + _ -> 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 ['"'])+ -- 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_hoodle :: Iter.Iteratee B.ByteString IO Hoodle+iter_hoodle = AI.parserToIteratee parser_hoodle ++read_hoodle :: String -> IO Hoodle +read_hoodle str = Iter.fileDriver iter_hoodle str ++read_xojgz :: String -> IO Hoodle +read_xojgz str = Iter.fileDriver (Iter.joinIM (ungzipXoj iter_hoodle)) str+++cat_hoodlegz :: String -> IO () +cat_hoodlegz str = Iter.fileDriver + (Iter.joinIM (ungzipXoj printLinesUnterminated)) str ++onlyresult (Done _ r) = r +-}+
+ src/Text/Hoodle/Parse/Zlib.hs view
@@ -0,0 +1,26 @@+-----------------------------------------------------------------------------+-- |+-- Module : Text.Hoodle.Parse.Zlib +-- Copyright : (c) 2011, 2012 Ian-Woo Kim+--+-- License : BSD3+-- Maintainer : Ian-Woo Kim <ianwookim@gmail.com>+-- Stability : experimental+-- Portability : GHC+--+-----------------------------------------------------------------------------++module Text.Hoodle.Parse.Zlib where++-- from other packages+import qualified Data.ByteString.Lazy as LB+import System.IO++-- | check if gzip or not++checkIfBinary :: FilePath -> IO Bool +checkIfBinary fname = + withFile fname ReadMode $ \h -> do+ b <- return . LB.any ( == 0 ) . LB.take 100 =<< LB.hGetContents h + b `seq` return b +
+ src/Text/Hoodle/Translate/FromXournal.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE RecordWildCards #-}++-----------------------------------------------------------------------------+-- |+-- Module : Text.Hoodle.Builder +-- Copyright : (c) 2011, 2012 Ian-Woo Kim+--+-- License : BSD3+-- Maintainer : Ian-Woo Kim <ianwookim@gmail.com>+-- Stability : experimental+-- Portability : GHC+--+-----------------------------------------------------------------------------++module Text.Hoodle.Translate.FromXournal +( mkHoodleFromXournal +) where++import qualified Data.Xournal.Simple as X +import qualified Data.Hoodle.Simple as H++-- | +mkHoodleFromXournal :: X.Xournal -> H.Hoodle +mkHoodleFromXournal X.Xournal {..} = + H.Hoodle xoj_title (map x2h4Page xoj_pages) + +-- | +x2h4Page :: X.Page -> H.Page+x2h4Page X.Page {..} = H.Page + (x2h4dim page_dim) + (x2h4bkg page_bkg) + (map x2h4layer page_layers)+ +-- | +x2h4dim :: X.Dimension -> H.Dimension+x2h4dim X.Dim {..} = H.Dim dim_width dim_height ++-- | +x2h4bkg :: X.Background -> H.Background +x2h4bkg X.Background {..} = H.Background bkg_type bkg_color bkg_style+x2h4bkg X.BackgroundPdf {..} = + H.BackgroundPdf bkg_type bkg_domain bkg_filename bkg_pageno+++-- | +x2h4layer :: X.Layer -> H.Layer +x2h4layer X.Layer {..} = H.Layer (map x2h4stroke layer_strokes)++-- | +x2h4stroke :: X.Stroke -> H.Item -- H.Stroke +x2h4stroke X.Stroke {..} = + H.ItemStroke (H.Stroke stroke_tool stroke_color stroke_width stroke_data)+x2h4stroke X.VWStroke {..} = + H.ItemStroke (H.VWStroke stroke_tool stroke_color stroke_vwdata)+ + +