xournal-parser (empty) → 0.2
raw patch · 8 files changed
+565/−0 lines, 8 filesdep +attoparsecdep +attoparsec-iterateedep +basesetup-changed
Dependencies added: attoparsec, attoparsec-iteratee, base, bytestring, containers, enumerator, iteratee, iteratee-compress, mtl, strict, transformers, xml-enumerator
Files
- LICENSE +25/−0
- Setup.lhs +10/−0
- src/Text/Xournal/Parse.hs +267/−0
- src/Text/Xournal/Parse/Enumerator.hs +21/−0
- src/Text/Xournal/Parse/Zlib.hs +13/−0
- src/Text/Xournal/Predefined.hs +91/−0
- src/Text/Xournal/Type.hs +99/−0
- xournal-parser.cabal +39/−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+> -- }
+ src/Text/Xournal/Parse.hs view
@@ -0,0 +1,267 @@+{-# LANGUAGE OverloadedStrings #-}++module Text.Xournal.Parse where++import Control.Applicative hiding (many)+++import Data.Attoparsec+import Data.Attoparsec.Char8 (char, 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 Text.Xournal.Type+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 ()+++-- <|> (many . satisfy . 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+ trim+ xournal+ ++xournal :: Parser Xournal +xournal = do trim + xournalheader+ trim+ t <- title+ trim+ (try (preview >> return ())+ <|> return ()) + pgs <- many1 page+ trim+ xournalclose + return $ Xournal t pgs + +page :: Parser Page +page = do trim + dim <- pageheader+ trim + bkg <- 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 '"'+ 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 + +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) ) ++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 +++-- printIter :: Iter.Iteratee B.ByteString IO () +-- printIter = ++++ +onlyresult (Done _ r) = r +
+ src/Text/Xournal/Parse/Enumerator.hs view
@@ -0,0 +1,21 @@+module Text.Xournal.Parse.Enumerator where++import Text.XML.Enumerator.Parse+import qualified Data.ByteString as S+import Data.Enumerator+import qualified Data.Enumerator as E+import Control.Monad.IO.Class+++parseXojFile :: FilePath -> IO ()+parseXojFile fn = do + x <- S.readFile fn+ run_ $ enumList 1 [x] $$ joinI $ parseBytes decodeEntities $$ iterPrint+ where+ iterPrint = do+ x <- E.head+ case x of+ Nothing -> return ()+ Just y -> liftIO (print y) >> iterPrint++
+ src/Text/Xournal/Parse/Zlib.hs view
@@ -0,0 +1,13 @@+module Text.Xournal.Parse.Zlib where++import Control.Monad.IO.Class+import Data.Iteratee.ZLib +import Data.Iteratee+import Data.ByteString+-- import Codec.Zlib.Enum+-- import Data.Enumerator+-- import Data.ByteString ++ungzipXoj :: MonadIO m => Enumerator ByteString m a+ungzipXoj = enumInflate GZip defaultDecompressParams +
+ src/Text/Xournal/Predefined.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}++module Text.Xournal.Predefined where++import qualified Data.Map as M+import qualified Data.ByteString.Char8 as B++import Text.Printf ++hexToRGBA :: Integer -> (Double,Double,Double,Double) +hexToRGBA n = + let r = n `div` (256*256*256)+ g = (n-r*256*256*256) `div` (256*256)+ b = (n-r*256*256*256-g*256*256) `div` 256 + a = n-r*256*256*256-g*256*256-b*256 + in (fromIntegral r/255.0,fromIntegral g/255.0,fromIntegral b/255.0,fromIntegral a/255.0)++rgbaToHEX :: (Double,Double,Double,Double) -> String+rgbaToHEX (r,g,b,a) = + let i :: Integer = round (255*a) + round (256*255*b) + round (256*256*255*g) + round (256*256*256*255*r) + in printf "#%08x" i++predefined_pencolor :: M.Map B.ByteString (Double,Double,Double,Double)+predefined_pencolor = + M.fromList [ ("black" , hexToRGBA 0x000000ff)+ , ("blue" , hexToRGBA 0x3333ccff)+ , ("red" , hexToRGBA 0xff0000ff)+ , ("green" , hexToRGBA 0x008000ff)+ , ("gray" , hexToRGBA 0x808080ff)+ , ("lightblue" , hexToRGBA 0x00c0ffff)+ , ("lightgreen", hexToRGBA 0x00ff00ff)+ , ("magenta" , hexToRGBA 0xff00ffff)+ , ("orange" , hexToRGBA 0xff8000ff)+ , ("yellow" , hexToRGBA 0xffff00ff)+ , ("white" , hexToRGBA 0xffffffff) ] ++{-+getPenColor :: B.ByteString -> Maybe (Double,Double,Double,Double) +getPenColor b | (not . B.null) b = + case B.head b of + '#' -> B.tail b +-}++predefined_bkgcolor :: M.Map B.ByteString (Double,Double,Double,Double)+predefined_bkgcolor = + M.fromList [ ("" , hexToRGBA 0xffffffff) + , ("blue" , hexToRGBA 0xa0e8ffff)+ , ("pink" , hexToRGBA 0xffc0d4ff)+ , ("green" , hexToRGBA 0x80ffc0ff)+ , ("orange", hexToRGBA 0xffc080ff)+ , ("yellow", hexToRGBA 0xffff80ff)+ , ("white" , hexToRGBA 0xffffffff) ]++predefined_veryfine :: Double+predefined_veryfine = 0.42 ++predefined_fine :: Double+predefined_fine = 0.85++predefined_medium :: Double+predefined_medium = 1.41++predefined_thick :: Double+predefined_thick = 2.26++predefined_verythick :: Double +predefined_verythick = 5.67++predefined_RULING_MARGIN_COLOR :: (Double,Double,Double,Double)+predefined_RULING_MARGIN_COLOR = hexToRGBA 0xff0080ff++predefined_RULING_COLOR :: (Double,Double,Double,Double)+predefined_RULING_COLOR = hexToRGBA 0x40a0ffff++predefined_RULING_THICKNESS :: Double+predefined_RULING_THICKNESS = 0.5++predefined_RULING_LEFTMARGIN :: Double+predefined_RULING_LEFTMARGIN = 72.0++predefined_RULING_TOPMARGIN :: Double+predefined_RULING_TOPMARGIN = 80.0++predefined_RULING_SPACING :: Double+predefined_RULING_SPACING = 24.0++predefined_RULING_BOTTOMMARGIN :: Double +predefined_RULING_BOTTOMMARGIN = predefined_RULING_SPACING++predefined_RULING_GRAPHSPACING :: Double+predefined_RULING_GRAPHSPACING = 14.17
+ src/Text/Xournal/Type.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE BangPatterns, OverloadedStrings, + TypeFamilies, FlexibleContexts #-}++module Text.Xournal.Type where++import qualified Data.ByteString as S+import Data.Strict.Tuple++import Prelude hiding (fst,snd,curry,uncurry)++class IStroke a where+ strokeTool :: a -> S.ByteString + strokeColor :: a -> S.ByteString+ strokeWidth :: a -> Double + strokeData :: a -> [Pair Double Double]++class (IStroke (TStroke a)) => ILayer a where+ type TStroke a :: * + layerStrokes :: a -> [TStroke a]++class (ILayer (TLayer a)) => IPage a where + type TLayer a :: * + pageDim :: a -> Dimension+ pageBkg :: a -> Background + pageLayers :: a -> [TLayer a] ++class (IPage (TPage a)) => IXournal a where+ type TPage a :: *+ xournalPages :: a -> [TPage a]++type Title = S.ByteString++data Stroke = Stroke { stroke_tool :: !S.ByteString+ , stroke_color :: !S.ByteString+ , stroke_width :: !Double+ , stroke_data :: ![Pair Double Double]+ }+ deriving Show++data Dimension = Dim { dim_width :: !Double, dim_height :: !Double }+ deriving Show++data Background = Background { bkg_type :: !S.ByteString + , bkg_color :: !S.ByteString + , bkg_style :: !S.ByteString + }+ deriving Show ++data Xournal = Xournal { xoj_title :: !Title, xoj_pages :: ![Page] }+ deriving Show ++data Page = Page { page_dim :: !Dimension+ , page_bkg :: !Background + , page_layers :: ![Layer] }+ deriving Show ++data Layer = Layer { layer_strokes :: ![Stroke] } + deriving Show ++emptyXournal :: Xournal+emptyXournal = Xournal "" [] ++defaultBackground :: Background+defaultBackground = Background { bkg_type = "solid"+ , bkg_color = "white"+ , bkg_style = "lined" + }++defaultLayer :: Layer+defaultLayer = Layer { layer_strokes = [] } ++defaultPage :: Page+defaultPage = Page { page_dim = Dim 612.0 792.0 + , page_bkg = defaultBackground+ , page_layers = [ defaultLayer ] + } ++defaultXournal :: Xournal +defaultXournal = Xournal "untitled" [ defaultPage ] ++instance IStroke Stroke where+ strokeTool = stroke_tool+ strokeColor = stroke_color+ strokeWidth = stroke_width+ strokeData = stroke_data+ +instance ILayer Layer where+ type TStroke Layer = Stroke+ layerStrokes = layer_strokes ++instance IPage Page where+ type TLayer Page = Layer + pageDim = page_dim + pageBkg = page_bkg + pageLayers = page_layers++instance IXournal Xournal where+ type TPage Xournal = Page + xournalPages = xoj_pages
+ xournal-parser.cabal view
@@ -0,0 +1,39 @@+Name: xournal-parser+Version: 0.2+Synopsis: Xournal file parser+Description: Define Xournal type and parser for xournal xml file+License: BSD3+License-file: LICENSE+Author: Ian-Woo Kim+Maintainer: Ian-Woo Kim <ianwookim@gmail.com>+Build-Type: Simple+Cabal-Version: >= 1.8++Library+ hs-source-dirs: src+ ghc-options: -Wall -O2 -threaded -funbox-strict-fields -fno-warn-unused-do-bind+ ghc-prof-options: -caf-all -auto-all+ Build-Depends: base == 4.*, + mtl == 2.*, + transformers == 0.2.*, + attoparsec == 0.9.*, + attoparsec-iteratee == 0.3.*, + iteratee >= 0.7 && < 0.9, + bytestring == 0.9.*, + containers == 0.4.*, + xml-enumerator < 0.4, + enumerator >= 0.4.13 && < 0.5, + strict == 0.3.*, + iteratee-compress == 0.2.1.*+ Exposed-Modules: + Text.Xournal.Type+ Text.Xournal.Parse+ Text.Xournal.Predefined+ Text.Xournal.Parse.Enumerator+ Text.Xournal.Parse.Zlib+++++ +