hoodle-types 0.2.2 → 0.3
raw patch · 7 files changed
+439/−59 lines, 7 filesdep +text
Dependencies added: text
Files
- hoodle-types.cabal +6/−4
- src/Data/Hoodle/BBox.hs +8/−10
- src/Data/Hoodle/Generic.hs +9/−3
- src/Data/Hoodle/Generic/Simple.hs +3/−2
- src/Data/Hoodle/Select.hs +15/−7
- src/Data/Hoodle/Simple.hs +69/−33
- src/Data/Hoodle/Simple/V0_2_2.hs +329/−0
hoodle-types.cabal view
@@ -1,5 +1,5 @@ Name: hoodle-types-Version: 0.2.2+Version: 0.3 Synopsis: Data types for programs for hoodle file format Description: Hoodle file format data type including generic interface License: BSD3@@ -22,11 +22,12 @@ Build-Depends: base == 4.*, bytestring >= 0.9, - mtl > 2, - strict > 0.3 , containers >= 0.4, - lens >= 2.5, cereal > 0.3, + lens >= 2.5,+ mtl > 2, + strict > 0.3, + text > 0.11, uuid >= 1.2.6 Exposed-Modules: Data.Hoodle.BBox@@ -37,6 +38,7 @@ Data.Hoodle.Select Data.Hoodle.Simple Data.Hoodle.Simple.V0_1_1+ Data.Hoodle.Simple.V0_2_2 Data.Hoodle.Util Data.Hoodle.Zipper
src/Data/Hoodle/BBox.hs view
@@ -17,16 +17,6 @@ , GetBBoxable (..) , MakeBBoxedable (..) , BBoxed (..)--- , StrokeBBox (..)--- , strkbbx_strk--- , strkbbx_bbx--- , mkStrokeBBox--- , ImageBBox (..)--- , imgbbx_img--- , imgbbx_bbx--- , mkImageBBox--- , SVGBBox (..)--- , mkSVGBBox , mkbbox , mkbboxF , bboxFromStroke@@ -108,7 +98,10 @@ instance MakeBBoxedable Identity Link where makeBBoxed lnk = return (BBoxed lnk (bboxFromLink lnk)) +instance MakeBBoxedable Identity Anchor where+ makeBBoxed anc = return (BBoxed anc (bboxFromAnchor anc)) + -- | mkbbox :: [Pair Double Double] -> BBox mkbbox lst = let xs = map fst lst @@ -155,6 +148,11 @@ bboxFromLink :: Link -> BBox bboxFromLink (Link _ _ _ _ _ _ (x,y) d) = moveBBoxULCornerTo (x,y) (dimToBBox d) bboxFromLink (LinkDocID _ _ _ _ _ _ (x,y) d) = moveBBoxULCornerTo (x,y) (dimToBBox d)+bboxFromLink (LinkAnchor _ _ _ _ _ (x,y) d) = moveBBoxULCornerTo (x,y) (dimToBBox d)++-- |+bboxFromAnchor :: Anchor -> BBox +bboxFromAnchor (Anchor _ _ (x,y) d) = moveBBoxULCornerTo (x,y) (dimToBBox d) -- | general transform BBox
src/Data/Hoodle/Generic.hs view
@@ -6,7 +6,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.Hoodle.Generic --- Copyright : (c) 2011, 2012 Ian-Woo Kim+-- Copyright : (c) 2011,2012,2014 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim <ianwookim@gmail.com>@@ -25,6 +25,7 @@ import Data.Functor import qualified Data.IntMap as IM import qualified Data.Sequence as Seq +import qualified Data.Text as T import Data.UUID.V4 -- from this package import Data.Hoodle.Simple@@ -37,6 +38,7 @@ , ghoodle_ttl :: ByteString , ghoodle_revisions :: [Revision] , ghoodle_embeddedpdf :: Maybe ByteString + , ghoodle_embeddedtext :: Maybe T.Text , ghoodle_pgs :: cntnr pg } -- | Generic page data having dimension, generic background@@ -62,7 +64,7 @@ -- | instance (Functor cntnr) => Functor (GHoodle cntnr) where- fmap f (GHoodle hid ttl revs pdf pgs) = GHoodle hid ttl revs pdf (fmap f pgs)+ fmap f (GHoodle hid ttl revs pdf txt pgs) = GHoodle hid ttl revs pdf txt (fmap f pgs) ------------------------------ -- lenses for Generic types --@@ -84,6 +86,10 @@ gembeddedpdf :: Simple Lens (GHoodle cntnr pg) (Maybe ByteString) gembeddedpdf = lens ghoodle_embeddedpdf (\f a -> f { ghoodle_embeddedpdf = a } ) +-- | +gembeddedtext :: Simple Lens (GHoodle cntnr pg) (Maybe T.Text)+gembeddedtext = lens ghoodle_embeddedtext (\f a -> f { ghoodle_embeddedtext = a } )+ -- | gpages :: Simple Lens (GHoodle cntnr pg) (cntnr pg) gpages = lens ghoodle_pgs (\f a -> f { ghoodle_pgs = a } )@@ -130,7 +136,7 @@ emptyGHoodle :: (Listable m) => IO (GHoodle m a) emptyGHoodle = do uuid <- nextRandom- return $ GHoodle ((pack.show) uuid) "" [] Nothing (fromList [])+ return $ GHoodle ((pack.show) uuid) "" [] Nothing Nothing (fromList []) -- | emptyGPage :: (Listable cntnr) => Dimension -> bkg -> GPage bkg cntnr a
src/Data/Hoodle/Generic/Simple.hs view
@@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.Hoodle.Generic.Simple --- Copyright : (c) 2011, 2012 Ian-Woo Kim+-- Copyright : (c) 2011, 2012, 2014 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim <ianwookim@gmail.com>@@ -49,6 +49,7 @@ <*> view title <*> view revisions <*> view embeddedPdf + <*> view embeddedText <*> map mkSPage . view pages -- | @@ -61,5 +62,5 @@ -- | shoodle2Hoodle :: SHoodle -> Hoodle-shoodle2Hoodle (GHoodle hid ttl revs pdf pgs) = Hoodle hid ttl revs pdf (map spage2Page pgs)+shoodle2Hoodle (GHoodle hid ttl revs pdf txt pgs) = Hoodle hid ttl revs pdf txt (map spage2Page pgs)
src/Data/Hoodle/Select.hs view
@@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.Hoodle.Select --- Copyright : (c) 2011, 2012 Ian-Woo Kim+-- Copyright : (c) 2011,2012,2014 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim <ianwookim@gmail.com>@@ -15,18 +15,20 @@ module Data.Hoodle.Select where -- from other packages-import Control.Applicative-import Control.Lens-import Data.ByteString +import Control.Applicative+import Control.Lens+import Data.ByteString+import qualified Data.Text as T ---import Data.Hoodle.Generic -import Data.Hoodle.Simple +import Data.Hoodle.Generic +import Data.Hoodle.Simple -- | data GSelect a b = GSelect { gselect_id :: ByteString , gselect_ttl :: ByteString , gselect_revisions :: [Revision]- , gselect_embeddedpdf :: Maybe ByteString + , gselect_embeddedpdf :: Maybe ByteString+ , gselect_embeddedtext :: Maybe T.Text , gselect_all :: a , gselect_selected :: b }@@ -47,6 +49,10 @@ gselEmbeddedPdf = lens gselect_embeddedpdf (\f a -> f {gselect_embeddedpdf = a}) -- |+gselEmbeddedText :: Simple Lens (GSelect a b) (Maybe T.Text)+gselEmbeddedText = lens gselect_embeddedtext (\f a -> f {gselect_embeddedtext = a})++-- | gselAll :: Simple Lens (GSelect a b) a gselAll = lens gselect_all (\f a -> f {gselect_all = a} ) @@ -60,6 +66,7 @@ <*> view gselTitle <*> view gselRevisions <*> view gselEmbeddedPdf + <*> view gselEmbeddedText <*> view gselAll @@ -68,5 +75,6 @@ <*> view gtitle <*> view grevisions <*> view gembeddedpdf+ <*> view gembeddedtext <*> view gpages <*> pure Nothing
src/Data/Hoodle/Simple.hs view
@@ -4,7 +4,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.Hoodle.Simple --- Copyright : (c) 2011-2013 Ian-Woo Kim+-- Copyright : (c) 2011-2014 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim <ianwookim@gmail.com>@@ -18,12 +18,11 @@ -- from other packages import Control.Applicative import Control.Lens --- import qualified Data.ByteString as S import Data.ByteString.Char8 hiding (map) import Data.UUID.V4 --- import Data.Label import qualified Data.Serialize as SE import Data.Strict.Tuple+import qualified Data.Text as T -- from this package import Data.Hoodle.Util -- @@ -37,6 +36,7 @@ | ItemImage Image | ItemSVG SVG | ItemLink Link+ | ItemAnchor Anchor deriving (Show,Eq,Ord) @@ -83,7 +83,23 @@ , link_render :: ByteString , link_pos :: (Double,Double) , link_dim :: !Dimension } + | LinkAnchor { link_id :: ByteString + , link_linkeddocid :: ByteString+ , link_location :: ByteString+ , link_anchorid :: ByteString+ , link_render :: ByteString+ , link_pos :: (Double,Double)+ , link_dim :: !Dimension+ }+ deriving (Show,Eq,Ord) ++data Anchor = Anchor { anchor_id :: ByteString + , anchor_render :: ByteString+ , anchor_pos :: (Double, Double)+ , anchor_dim :: !Dimension+ } + deriving (Show,Eq,Ord) -- | instance SE.Serialize Stroke where@@ -123,34 +139,52 @@ -- | instance SE.Serialize Link where- put Link {..} = SE.putWord8 0 - >> SE.put link_id- >> SE.put link_type- >> SE.put link_location- >> SE.put link_text- >> SE.put link_command - >> SE.put link_render- >> SE.put link_pos- >> SE.put link_dim- put LinkDocID {..} = SE.putWord8 1 - >> SE.put link_id- >> SE.put link_linkeddocid - >> SE.put link_location- >> SE.put link_text- >> SE.put link_command - >> SE.put link_render- >> SE.put link_pos- >> SE.put link_dim- + put Link {..} = SE.putWord8 0 + >> SE.put link_id+ >> SE.put link_type+ >> SE.put link_location+ >> SE.put link_text+ >> SE.put link_command + >> SE.put link_render+ >> SE.put link_pos+ >> SE.put link_dim+ put LinkDocID {..} = SE.putWord8 1 + >> SE.put link_id+ >> SE.put link_linkeddocid + >> SE.put link_location+ >> SE.put link_text+ >> SE.put link_command + >> SE.put link_render+ >> SE.put link_pos+ >> SE.put link_dim+ put LinkAnchor {..} = SE.putWord8 2+ >> SE.put link_id+ >> SE.put link_linkeddocid+ >> SE.put link_location+ >> SE.put link_anchorid+ >> SE.put link_render+ >> SE.put link_pos+ >> SE.put link_dim get = do tag <- SE.getWord8 case tag of - 0 -> Link <$> SE.get <*> SE.get <*> SE.get <*> SE.get <*> SE.get - <*> SE.get <*> SE.get <*> SE.get- 1 -> LinkDocID <$> SE.get <*> SE.get <*> SE.get <*> SE.get <*> SE.get - <*> SE.get <*> SE.get <*> SE.get+ 0 -> Link <$> SE.get <*> SE.get <*> SE.get <*> SE.get + <*> SE.get <*> SE.get <*> SE.get <*> SE.get+ 1 -> LinkDocID <$> SE.get <*> SE.get <*> SE.get <*> SE.get + <*> SE.get <*> SE.get <*> SE.get <*> SE.get+ 2 -> LinkAnchor <$> SE.get <*> SE.get <*> SE.get <*> SE.get+ <*> SE.get <*> SE.get <*> SE.get _ -> fail "err in Link parsing" ++instance SE.Serialize Anchor where+ put Anchor {..} = SE.put anchor_id+ >> SE.put anchor_render+ >> SE.put anchor_pos+ >> SE.put anchor_dim+ get = Anchor <$> SE.get <*> SE.get <*> SE.get <*> SE.get++ -- | instance SE.Serialize Item where put (ItemStroke str) = SE.putWord8 0 @@ -161,12 +195,15 @@ >> SE.put svg put (ItemLink lnk) = SE.putWord8 3 >> SE.put lnk + put (ItemAnchor anc) = SE.putWord8 4+ >> SE.put anc get = do tag <- SE.getWord8 case tag of 0 -> ItemStroke <$> SE.get 1 -> ItemImage <$> SE.get 2 -> ItemSVG <$> SE.get 3 -> ItemLink <$> SE.get+ 4 -> ItemAnchor <$> SE.get _ -> fail "err in Item parsing" -- | @@ -211,6 +248,7 @@ , hoodle_title :: !Title , hoodle_revisions :: [Revision] , hoodle_embeddedpdf :: Maybe ByteString+ , hoodle_embeddedtext :: Maybe T.Text , hoodle_pages :: ![Page] } deriving Show @@ -258,17 +296,15 @@ revmd5 :: Simple Lens Revision ByteString revmd5 = lens _revmd5 (\f a -> f { _revmd5 = a } ) -{- -- | -revtxt :: Simple Lens Revision ByteString-revtxt = lens _revtxt (\f a -> f { _revtxt = a } )--}---- | embeddedPdf :: Simple Lens Hoodle (Maybe ByteString) embeddedPdf = lens hoodle_embeddedpdf (\f a -> f { hoodle_embeddedpdf = a} ) -- | +embeddedText :: Simple Lens Hoodle (Maybe T.Text)+embeddedText = lens hoodle_embeddedtext (\f a -> f { hoodle_embeddedtext = a} )++-- | pages :: Simple Lens Hoodle [Page] pages = lens hoodle_pages (\f a -> f { hoodle_pages = a } ) @@ -298,7 +334,7 @@ emptyHoodle :: IO Hoodle emptyHoodle = do uuid <- nextRandom- return $ Hoodle ((pack.show) uuid) "" [] Nothing [] + return $ Hoodle ((pack.show) uuid) "" [] Nothing Nothing [] -- | emptyLayer :: Layer
+ src/Data/Hoodle/Simple/V0_2_2.hs view
@@ -0,0 +1,329 @@+{-# LANGUAGE BangPatterns, OverloadedStrings, TypeOperators, + TypeFamilies, FlexibleContexts, RecordWildCards #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Hoodle.Simple.V0_2_2 +-- Copyright : (c) 2011-2014 Ian-Woo Kim+--+-- License : BSD3+-- Maintainer : Ian-Woo Kim <ianwookim@gmail.com>+-- Stability : experimental+-- Portability : GHC+--+----------------------------------------------------------------------------- ++module Data.Hoodle.Simple.V0_2_2 where++-- from other packages+import Control.Applicative +import Control.Lens +import Data.ByteString.Char8 hiding (map)+import Data.UUID.V4 +import qualified Data.Serialize as SE+import Data.Strict.Tuple+-- from this package+import Data.Hoodle.Util+-- +import Prelude hiding (putStrLn,fst,snd,curry,uncurry)++-- | +type Title = ByteString++-- | wrapper of object embeddable in Layer+data Item = ItemStroke Stroke+ | ItemImage Image+ | ItemSVG SVG+ | ItemLink Link+ deriving (Show,Eq,Ord)+++-- | Pen stroke item +data Stroke = Stroke { stroke_tool :: !ByteString+ , stroke_color :: !ByteString+ , stroke_width :: !Double+ , stroke_data :: ![Pair Double Double]+ }+ | VWStroke { stroke_tool :: ByteString + , stroke_color :: ByteString + , stroke_vwdata :: [(Double,Double,Double)] + }+ deriving (Show,Eq,Ord)++-- | Image item +data Image = Image { img_src :: ByteString+ , img_pos :: (Double,Double)+ , img_dim :: !Dimension+ } + deriving (Show,Eq,Ord)++data SVG = SVG { svg_text :: Maybe ByteString+ , svg_command :: Maybe ByteString + , svg_render :: ByteString+ , svg_pos :: (Double,Double)+ , svg_dim :: !Dimension } + deriving (Show,Eq,Ord)+ ++data Link = Link { link_id :: ByteString + , link_type :: ByteString + , link_location :: ByteString+ , link_text :: Maybe ByteString+ , link_command :: Maybe ByteString + , link_render :: ByteString+ , link_pos :: (Double,Double)+ , link_dim :: !Dimension } + | LinkDocID { link_id :: ByteString+ , link_linkeddocid :: ByteString + , link_location :: ByteString + , link_text :: Maybe ByteString+ , link_command :: Maybe ByteString + , link_render :: ByteString+ , link_pos :: (Double,Double)+ , link_dim :: !Dimension } + deriving (Show,Eq,Ord) + +-- | +instance SE.Serialize Stroke where+ put Stroke{..} = SE.putWord8 0 + >> SE.put stroke_tool + >> SE.put stroke_color+ >> SE.put stroke_width+ >> SE.put stroke_data+ put VWStroke{..} = SE.putWord8 1 + >> SE.put stroke_tool + >> SE.put stroke_color+ >> SE.put stroke_vwdata+ get = do tag <- SE.getWord8 + case tag of + 0 -> Stroke <$> SE.get <*> SE.get <*> SE.get <*> SE.get+ 1 -> VWStroke <$> SE.get <*> SE.get <*> SE.get+ _ -> fail "err in Stroke parsing"+++-- | +instance SE.Serialize Image where+ put Image {..} = SE.put img_src+ >> SE.put img_pos+ >> SE.put img_dim+ get = Image <$> SE.get <*> SE.get <*> SE.get++-- | +instance SE.Serialize SVG where+ put SVG {..} = SE.put svg_text+ >> SE.put svg_command + >> SE.put svg_render+ >> SE.put svg_pos+ >> SE.put svg_dim+ get = SVG <$> SE.get <*> SE.get <*> SE.get <*> SE.get <*> SE.get+ + ++-- | +instance SE.Serialize Link where+ put Link {..} = SE.putWord8 0 + >> SE.put link_id+ >> SE.put link_type+ >> SE.put link_location+ >> SE.put link_text+ >> SE.put link_command + >> SE.put link_render+ >> SE.put link_pos+ >> SE.put link_dim+ put LinkDocID {..} = SE.putWord8 1 + >> SE.put link_id+ >> SE.put link_linkeddocid + >> SE.put link_location+ >> SE.put link_text+ >> SE.put link_command + >> SE.put link_render+ >> SE.put link_pos+ >> SE.put link_dim+ + get = do tag <- SE.getWord8 + case tag of + 0 -> Link <$> SE.get <*> SE.get <*> SE.get <*> SE.get <*> SE.get + <*> SE.get <*> SE.get <*> SE.get+ 1 -> LinkDocID <$> SE.get <*> SE.get <*> SE.get <*> SE.get <*> SE.get + <*> SE.get <*> SE.get <*> SE.get+ _ -> fail "err in Link parsing"+++-- | +instance SE.Serialize Item where+ put (ItemStroke str) = SE.putWord8 0 + >> SE.put str + put (ItemImage img) = SE.putWord8 1 + >> SE.put img+ put (ItemSVG svg) = SE.putWord8 2+ >> SE.put svg + put (ItemLink lnk) = SE.putWord8 3+ >> SE.put lnk + get = do tag <- SE.getWord8 + case tag of + 0 -> ItemStroke <$> SE.get+ 1 -> ItemImage <$> SE.get+ 2 -> ItemSVG <$> SE.get+ 3 -> ItemLink <$> SE.get+ _ -> fail "err in Item parsing"++-- | +instance (SE.Serialize a, SE.Serialize b) => SE.Serialize (Pair a b) where+ put (x :!: y) = SE.put x+ >> SE.put y+ get = (:!:) <$> SE.get <*> SE.get++ +-- | +data Dimension = Dim { dim_width :: !Double, dim_height :: !Double }+ deriving (Show,Eq,Ord)++-- | +instance SE.Serialize Dimension where + put (Dim w h) = SE.put w >> SE.put h + get = Dim <$> SE.get <*> SE.get++-- | +data Background = Background { bkg_type :: !ByteString + , bkg_color :: !ByteString + , bkg_style :: !ByteString + }+ | BackgroundPdf { bkg_type :: ByteString + , bkg_domain :: Maybe ByteString+ , bkg_filename :: Maybe ByteString+ , bkg_pageno :: Int+ }+ | BackgroundEmbedPdf { bkg_type :: ByteString+ , bkg_pageno :: Int } + deriving Show +-- | +data Revision = Revision { _revmd5 :: !ByteString + , _revtxt :: !ByteString + } + | RevisionInk { _revmd5 :: !ByteString+ , _revink :: [Stroke] } + deriving Show ++-- | +data Hoodle = Hoodle { hoodle_id :: ByteString+ , hoodle_title :: !Title+ , hoodle_revisions :: [Revision]+ , hoodle_embeddedpdf :: Maybe ByteString+ , hoodle_pages :: ![Page] }+ deriving Show ++-- | +data Page = Page { page_dim :: !Dimension+ , page_bkg :: !Background + , page_layers :: ![Layer] }+ deriving Show ++-- | +data Layer = Layer { layer_items :: ![Item] } + deriving Show ++-- | +getXYtuples :: Stroke -> [(Double,Double)]+getXYtuples (Stroke _t _c _w d) = map (\(x :!: y) -> (x,y)) d+getXYtuples (VWStroke _t _c d) = map ((,)<$>fst3<*>snd3) d +++----------------------------+-- Lenses+----------------------------++-- | +tool :: Simple Lens Stroke ByteString+tool = lens stroke_tool (\f a -> f { stroke_tool = a }) ++-- | +color :: Simple Lens Stroke ByteString +color = lens stroke_color (\f a -> f { stroke_color = a } )++-- |+hoodleID :: Simple Lens Hoodle ByteString +hoodleID = lens hoodle_id (\f a -> f { hoodle_id = a } )++-- | +title :: Simple Lens Hoodle Title+title = lens hoodle_title (\f a -> f { hoodle_title = a } )++-- | +revisions :: Simple Lens Hoodle [Revision]+revisions = lens hoodle_revisions (\f a -> f { hoodle_revisions = a } )++-- | +revmd5 :: Simple Lens Revision ByteString+revmd5 = lens _revmd5 (\f a -> f { _revmd5 = a } )++-- | +embeddedPdf :: Simple Lens Hoodle (Maybe ByteString)+embeddedPdf = lens hoodle_embeddedpdf (\f a -> f { hoodle_embeddedpdf = a} )++-- | +pages :: Simple Lens Hoodle [Page]+pages = lens hoodle_pages (\f a -> f { hoodle_pages = a } )++-- | +dimension :: Simple Lens Page Dimension +dimension = lens page_dim (\f a -> f { page_dim = a } )++-- | +background :: Simple Lens Page Background +background = lens page_bkg (\f a -> f { page_bkg = a } )++-- | +layers :: Simple Lens Page [Layer] +layers = lens page_layers (\f a -> f { page_layers = a } )++-- | +items :: Simple Lens Layer [Item]+items = lens layer_items (\f a -> f { layer_items = a } )+++--------------------------+-- empty objects+--------------------------++-- | +emptyHoodle :: IO Hoodle+emptyHoodle = do+ uuid <- nextRandom+ return $ Hoodle ((pack.show) uuid) "" [] Nothing [] ++-- | +emptyLayer :: Layer +emptyLayer = Layer { layer_items = [] } ++-- | +emptyStroke :: Stroke +emptyStroke = Stroke "pen" "black" 1.4 []++-- | +defaultBackground :: Background+defaultBackground = Background { bkg_type = "solid"+ , bkg_color = "white"+ , bkg_style = "lined" + }++-- | +defaultPage :: Page+defaultPage = Page { page_dim = Dim 612.0 792.0 + , page_bkg = defaultBackground+ , page_layers = [ emptyLayer ] + } ++-- | +defaultHoodle :: IO Hoodle +defaultHoodle = + (set title "untitled".set embeddedPdf Nothing . set pages [defaultPage])+ <$> emptyHoodle ++-- | +newPageFromOld :: Page -> Page+newPageFromOld page = + Page { page_dim = page_dim page + , page_bkg = page_bkg page + , page_layers = [emptyLayer] } + +