[arch-commits] Commit in haskell-xcb-types/trunk (PKGBUILD xcb-1.12.patch)

Felix Yan felixonmars at archlinux.org
Mon Jan 23 07:44:53 UTC 2017


    Date: Monday, January 23, 2017 @ 07:44:53
  Author: felixonmars
Revision: 208479

upgpkg: haskell-xcb-types 0.8.0-1

Modified:
  haskell-xcb-types/trunk/PKGBUILD
Deleted:
  haskell-xcb-types/trunk/xcb-1.12.patch

----------------+
 PKGBUILD       |   15 -
 xcb-1.12.patch |  445 -------------------------------------------------------
 2 files changed, 4 insertions(+), 456 deletions(-)

Modified: PKGBUILD
===================================================================
--- PKGBUILD	2017-01-23 07:44:45 UTC (rev 208478)
+++ PKGBUILD	2017-01-23 07:44:53 UTC (rev 208479)
@@ -4,23 +4,16 @@
 
 _hkgname=xcb-types
 pkgname=haskell-xcb-types
-pkgver=0.7.1
-pkgrel=6
+pkgver=0.8.0
+pkgrel=1
 pkgdesc="Parses XML files used by the XCB project"
 url="http://hackage.haskell.org/package/${_hkgname}"
 license=("custom:BSD3")
 arch=('i686' 'x86_64')
 depends=("ghc=8.0.1" 'haskell-mtl' 'haskell-xml')
-source=("http://hackage.haskell.org/packages/archive/${_hkgname}/${pkgver}/${_hkgname}-${pkgver}.tar.gz"
-        xcb-1.12.patch)
-sha256sums=('5927e720e4dee26b1bf8a24fb07e47e6a22f9d78fc87aab8d752f207c1566782'
-            '735b98510f4e2f21ae5ad3c5d54dd1a47666a98055637045e320fb9bb7032a81')
+source=("http://hackage.haskell.org/packages/archive/${_hkgname}/${pkgver}/${_hkgname}-${pkgver}.tar.gz")
+sha256sums=('6db5df1acf5c52cf18df0084ff325e665d37eba3eb8ca40ffc2b9a52b220d50b')
 
-prepare() {
-    cd ${_hkgname}-${pkgver}
-    patch -p1 -i ../xcb-1.12.patch
-}
-
 build() {
     cd "${srcdir}/${_hkgname}-${pkgver}"
     

Deleted: xcb-1.12.patch
===================================================================
--- xcb-1.12.patch	2017-01-23 07:44:45 UTC (rev 208478)
+++ xcb-1.12.patch	2017-01-23 07:44:53 UTC (rev 208479)
@@ -1,445 +0,0 @@
-From a86e578f0860670f3d43fa2d414e93a60aa72e2d Mon Sep 17 00:00:00 2001
-From: Tycho Andersen <tycho at tycho.ws>
-Date: Sun, 12 Jun 2016 19:49:16 -0600
-Subject: [PATCH] add support for new element "required_start_align"
-
-This is a little bit ugly and it breaks the API, but it's necessary since
-upstream has added this and xcb-types won't parse xcb-proto 1.12 as-is.
-
-Signed-off-by: Tycho Andersen <tycho at tycho.ws>
----
- Data/XCB/FromXML.hs | 84 ++++++++++++++++++++++++++++++++---------------------
- Data/XCB/Pretty.hs  | 41 +++++++++++++++-----------
- Data/XCB/Types.hs   | 22 ++++++++------
- 3 files changed, 88 insertions(+), 59 deletions(-)
-
-diff --git a/Data/XCB/FromXML.hs b/Data/XCB/FromXML.hs
-index 67ce9e1..af44a19 100644
---- a/Data/XCB/FromXML.hs
-+++ b/Data/XCB/FromXML.hs
-@@ -73,6 +73,16 @@ localName = snd `liftM` ask
- allModules :: Parse [XHeader]
- allModules = fst `liftM` ask
- 
-+-- Extract an Alignment from a list of Elements. This assumes that the
-+-- required_start_align is the first element if it exists at all.
-+extractAlignment :: (MonadPlus m, Functor m) => [Element] -> m (Maybe Alignment, [Element])
-+extractAlignment (el : xs) | el `named` "required_start_align" = do
-+                               align <- el `attr` "align" >>= readM
-+                               offset <- el `attr` "offset" >>= readM
-+                               return (Just (Alignment align offset), xs)
-+                           | otherwise = return (Nothing, el : xs)
-+extractAlignment xs = return (Nothing, xs)
-+
- -- a generic function for looking up something from
- -- a named XHeader.
- --
-@@ -108,23 +118,23 @@ findError :: Name -> [XDecl] -> Maybe ErrorDetails
- findError pname xs =
-       case List.find f xs of
-         Nothing -> Nothing
--        Just (XError name code elems) -> Just $ ErrorDetails name code elems
-+        Just (XError name code alignment elems) -> Just $ ErrorDetails name code alignment elems
-         _ -> error "impossible: fatal error in Data.XCB.FromXML.findError"
--    where  f (XError name _ _) | name == pname = True
-+    where  f (XError name _ _ _) | name == pname = True
-            f _ = False 
-                                        
- findEvent :: Name -> [XDecl] -> Maybe EventDetails
- findEvent pname xs = 
-       case List.find f xs of
-         Nothing -> Nothing
--        Just (XEvent name code elems noseq) ->
--            Just $ EventDetails name code elems noseq
-+        Just (XEvent name code alignment elems noseq) ->
-+            Just $ EventDetails name code alignment elems noseq
-         _ -> error "impossible: fatal error in Data.XCB.FromXML.findEvent"
--   where f (XEvent name _ _ _) | name == pname = True
-+   where f (XEvent name _ _ _ _) | name == pname = True
-          f _ = False 
- 
--data EventDetails = EventDetails Name Int [StructElem] (Maybe Bool)
--data ErrorDetails = ErrorDetails Name Int [StructElem]
-+data EventDetails = EventDetails Name Int (Maybe Alignment) [StructElem] (Maybe Bool)
-+data ErrorDetails = ErrorDetails Name Int (Maybe Alignment) [StructElem]
- 
- ---
- 
-@@ -194,25 +204,28 @@ xrequest el = do
-   code <- el `attr` "opcode" >>= readM
-   -- TODO - I don't think I like 'mapAlt' here.
-   -- I don't want to be silently dropping fields
--  fields <- mapAlt structField $ elChildren el
-+  (alignment, xs) <- extractAlignment $ elChildren el
-+  fields <- mapAlt structField $ xs
-   let reply = getReply el
--  return $ XRequest nm code fields reply
-+  return $ XRequest nm code alignment fields reply
- 
- getReply :: Element -> Maybe XReply
- getReply el = do
-   childElem <- unqual "reply" `findChild` el
--  fields <- mapM structField $ elChildren childElem
-+  (alignment, xs) <- extractAlignment $ elChildren childElem
-+  fields <- mapM structField xs
-   guard $ not $ null fields
--  return fields
-+  return $ GenXReply alignment fields
- 
- xevent :: Element -> Parse XDecl
- xevent el = do
-   name <- el `attr` "name"
-   number <- el `attr` "number" >>= readM
-   let noseq = ensureUpper `liftM` (el `attr` "no-sequence-number") >>= readM
--  fields <- mapM structField $ elChildren el
-+  (alignment, xs) <- extractAlignment (elChildren el)
-+  fields <- mapM structField $ xs
-   guard $ not $ null fields
--  return $ XEvent name number fields noseq
-+  return $ XEvent name number alignment fields noseq
- 
- xevcopy :: Element -> Parse XDecl
- xevcopy el = do
-@@ -222,12 +235,12 @@ xevcopy el = do
-   -- do we have a qualified ref?
-   let (mname,evname) = splitRef ref
-   details <- lookupEvent mname evname
--  return $ let EventDetails _ _ fields noseq =
-+  return $ let EventDetails _ _ alignment fields noseq =
-                  case details of
-                    Nothing ->
-                        error $ "Unresolved event: " ++ show mname ++ " " ++ ref
-                    Just x -> x  
--           in XEvent name number fields noseq
-+           in XEvent name number alignment fields noseq
- 
- -- we need to do string processing to distinguish qualified from
- -- unqualified types.
-@@ -258,8 +271,9 @@ xerror :: Element -> Parse XDecl
- xerror el = do
-   name <- el `attr` "name"
-   number <- el `attr` "number" >>= readM
--  fields <- mapM structField $ elChildren el
--  return $ XError name number fields
-+  (alignment, xs) <- extractAlignment $ elChildren el
-+  fields <- mapM structField $ xs
-+  return $ XError name number alignment fields
- 
- 
- xercopy :: Element -> Parse XDecl
-@@ -269,23 +283,25 @@ xercopy el = do
-   ref <- el `attr` "ref"
-   let (mname, ername) = splitRef ref
-   details <- lookupError mname ername
--  return $ XError name number $ case details of
-+  return $ uncurry (XError name number) $ case details of
-                Nothing -> error $ "Unresolved error: " ++ show mname ++ " " ++ ref
--               Just (ErrorDetails _ _ x) -> x
-+               Just (ErrorDetails _ _ alignment elems) -> (alignment, elems)
- 
- xstruct :: Element -> Parse XDecl
- xstruct el = do
-   name <- el `attr` "name"
--  fields <- mapAlt structField $ elChildren el
-+  (alignment, xs) <- extractAlignment $ elChildren el
-+  fields <- mapAlt structField $ xs
-   guard $ not $ null fields
--  return $ XStruct name fields
-+  return $ XStruct name alignment fields
- 
- xunion :: Element -> Parse XDecl
- xunion el = do
-   name <- el `attr` "name"
--  fields <- mapAlt structField $ elChildren el
-+  (alignment, xs) <- extractAlignment $ elChildren el
-+  fields <- mapAlt structField $ xs
-   guard $ not $ null fields
--  return $ XUnion name fields
-+  return $ XUnion name alignment fields
- 
- xidtype :: Element -> Parse XDecl
- xidtype el = liftM XidType $ el `attr` "name"
-@@ -340,8 +356,9 @@ structField el
-         nm <- el `attr` "name"
-         (exprEl,caseEls) <- unconsChildren el
-         expr <- expression exprEl
--        cases <- mapM bitCase caseEls
--        return $ Switch nm expr cases
-+        (alignment, xs) <- extractAlignment $ caseEls
-+        cases <- mapM bitCase xs
-+        return $ Switch nm expr alignment cases
- 
-     | el `named` "exprfield" = do
-         typ <- liftM mkType $ el `attr` "type"
-@@ -371,15 +388,16 @@ structField el
-  ++ show name
- 
- bitCase :: (MonadPlus m, Functor m) => Element -> m BitCase
--bitCase el | el `named` "bitcase" = do
--               let mName = el `attr` "name"
--               (exprEl, fieldEls) <- unconsChildren el
--               expr <- expression exprEl
--               fields <- mapM structField fieldEls
--               return $ BitCase mName expr fields
-+bitCase el | el `named` "bitcase" || el `named` "case" = do
-+              let mName = el `attr` "name"
-+              (exprEl, fieldEls) <- unconsChildren el
-+              expr <- expression exprEl
-+              (alignment, xs) <- extractAlignment $ fieldEls
-+              fields <- mapM structField xs
-+              return $ BitCase mName expr alignment fields
-            | otherwise =
--               let name = elName el
--               in error $ "Invalid bitCase: " ++ show name
-+              let name = elName el
-+              in error $ "Invalid bitCase: " ++ show name
- 
- expression :: (MonadPlus m, Functor m) => Element -> m XExpression
- expression el | el `named` "fieldref"
-diff --git a/Data/XCB/Pretty.hs b/Data/XCB/Pretty.hs
-index 9c7859c..156d154 100644
---- a/Data/XCB/Pretty.hs
-+++ b/Data/XCB/Pretty.hs
-@@ -104,9 +104,9 @@ instance Pretty a => Pretty (GenStructElem a) where
-     toDoc (ExprField nm typ expr)
-         = parens (text nm <+> text "::" <+> toDoc typ)
-           <+> toDoc expr
--    toDoc (Switch name expr cases)
-+    toDoc (Switch name expr alignment cases)
-         = vcat
--           [ text "switch" <> parens (toDoc expr) <> brackets (text name)
-+           [ text "switch" <> parens (toDoc expr) <> toDoc alignment <> brackets (text name)
-            , braces (vcat (map toDoc cases))
-            ]
-     toDoc (Doc brief fields see)
-@@ -144,10 +144,12 @@ instance Pretty a => Pretty (GenStructElem a) where
-                       ,text lname
-                       ]
- 
-+
- instance Pretty a => Pretty (GenBitCase a) where
--    toDoc (BitCase name expr fields)
-+    toDoc (BitCase name expr alignment fields)
-         = vcat
-            [ bitCaseHeader name expr
-+           , toDoc alignment
-            , braces (vcat (map toDoc fields))
-            ]
- 
-@@ -157,28 +159,33 @@ bitCaseHeader Nothing expr =
- bitCaseHeader (Just name) expr =
-     text "bitcase" <> parens (toDoc expr) <> brackets (text name)
- 
-+instance Pretty Alignment where
-+    toDoc (Alignment align offset) = text "alignment" <+>
-+                                       text "align=" <+> toDoc align <+>
-+                                       text "offset=" <+> toDoc offset
-+
- instance Pretty a => Pretty (GenXDecl a) where
--    toDoc (XStruct nm elems) =
--        hang (text "Struct:" <+> text nm) 2 $ vcat $ map toDoc elems
-+    toDoc (XStruct nm alignment elems) =
-+        hang (text "Struct:" <+> text nm <+> toDoc alignment) 2 $ vcat $ map toDoc elems
-     toDoc (XTypeDef nm typ) = hsep [text "TypeDef:"
-                                     ,text nm
-                                     ,text "as"
-                                     ,toDoc typ
-                                     ]
--    toDoc (XEvent nm n elems (Just True)) =
--        hang (text "Event:" <+> text nm <> char ',' <> toDoc n <+>
-+    toDoc (XEvent nm n alignment elems (Just True)) =
-+        hang (text "Event:" <+> text nm <> char ',' <> toDoc n <+> toDoc alignment <+>
-              parens (text "No sequence number")) 2 $
-              vcat $ map toDoc elems
--    toDoc (XEvent nm n elems _) =
--        hang (text "Event:" <+> text nm <> char ',' <> toDoc n) 2 $
-+    toDoc (XEvent nm n alignment elems _) =
-+        hang (text "Event:" <+> text nm <> char ',' <> toDoc n <+> toDoc alignment) 2 $
-              vcat $ map toDoc elems
--    toDoc (XRequest nm n elems mrep) = 
--        (hang (text "Request:" <+> text nm <> char ',' <> toDoc n) 2 $
-+    toDoc (XRequest nm n alignment elems mrep) = 
-+        (hang (text "Request:" <+> text nm <> char ',' <> toDoc n <+> toDoc alignment) 2 $
-              vcat $ map toDoc elems)
-          $$ case mrep of
-              Nothing -> empty
--             Just reply ->
--                 hang (text "Reply:" <+> text nm <> char ',' <> toDoc n) 2 $
-+             Just (GenXReply repAlignment reply) ->
-+                 hang (text "Reply:" <+> text nm <> char ',' <> toDoc n <+> toDoc repAlignment) 2 $
-                       vcat $ map toDoc reply
-     toDoc (XidType nm) = text "XID:" <+> text nm
-     toDoc (XidUnion nm elems) = 
-@@ -186,11 +193,11 @@ instance Pretty a => Pretty (GenXDecl a) where
-              vcat $ map toDoc elems
-     toDoc (XEnum nm elems) =
-         hang (text "Enum:" <+> text nm) 2 $ vcat $ map toDoc elems
--    toDoc (XUnion nm elems) = 
--        hang (text "Union:" <+> text nm) 2 $ vcat $ map toDoc elems
-+    toDoc (XUnion nm alignment elems) = 
-+        hang (text "Union:" <+> text nm <+> toDoc alignment) 2 $ vcat $ map toDoc elems
-     toDoc (XImport nm) = text "Import:" <+> text nm
--    toDoc (XError nm _n elems) =
--        hang (text "Error:" <+> text nm) 2 $ vcat $ map toDoc elems
-+    toDoc (XError nm _n alignment elems) =
-+        hang (text "Error:" <+> text nm <+> toDoc alignment) 2 $ vcat $ map toDoc elems
- 
- instance Pretty a => Pretty (GenXHeader a) where
-     toDoc xhd = text (xheader_header xhd) $$
-diff --git a/Data/XCB/Types.hs b/Data/XCB/Types.hs
-index f4d2d7a..1b4fce3 100644
---- a/Data/XCB/Types.hs
-+++ b/Data/XCB/Types.hs
-@@ -30,7 +30,7 @@ module Data.XCB.Types
-     , GenXDecl ( .. )
-     , GenStructElem ( .. )
-     , GenBitCase ( .. )
--    , GenXReply
-+    , GenXReply ( .. )
-     , GenXidUnionElem ( .. )
-     , EnumElem ( .. )
-     , Expression ( .. )
-@@ -44,6 +44,7 @@ module Data.XCB.Types
-     , MaskName
-     , ListName
-     , MaskPadding
-+    , Alignment ( .. )
-     ) where
- 
- import Data.Map
-@@ -78,16 +79,16 @@ type XEnumElem = EnumElem Type
- -- |The different types of declarations which can be made in one of the
- -- XML files.
- data GenXDecl typ
--    = XStruct  Name [GenStructElem typ]
-+    = XStruct  Name (Maybe Alignment) [GenStructElem typ]
-     | XTypeDef Name typ
--    | XEvent Name Int [GenStructElem typ] (Maybe Bool)  -- ^ The boolean indicates if the event includes a sequence number.
--    | XRequest Name Int [GenStructElem typ] (Maybe (GenXReply typ))
-+    | XEvent Name Int (Maybe Alignment) [GenStructElem typ] (Maybe Bool)  -- ^ The boolean indicates if the event includes a sequence number.
-+    | XRequest Name Int (Maybe Alignment) [GenStructElem typ] (Maybe (GenXReply typ))
-     | XidType  Name
-     | XidUnion  Name [GenXidUnionElem typ]
-     | XEnum Name [EnumElem typ]
--    | XUnion Name [GenStructElem typ]
-+    | XUnion Name (Maybe Alignment) [GenStructElem typ]
-     | XImport Name
--    | XError Name Int [GenStructElem typ]
-+    | XError Name Int (Maybe Alignment) [GenStructElem typ]
-  deriving (Show, Functor)
- 
- data GenStructElem typ
-@@ -96,20 +97,21 @@ data GenStructElem typ
-     | SField Name typ (Maybe (EnumVals typ)) (Maybe (MaskVals typ))
-     | ExprField Name typ (Expression typ)
-     | ValueParam typ Name (Maybe MaskPadding) ListName
--    | Switch Name (Expression typ) [GenBitCase typ]
-+    | Switch Name (Expression typ) (Maybe Alignment) [GenBitCase typ]
-     | Doc (Maybe String) (Map Name String) [(String, String)]
-     | Fd String
-  deriving (Show, Functor)
- 
- data GenBitCase typ
--    = BitCase (Maybe Name) (Expression typ) [GenStructElem typ]
-+    = BitCase (Maybe Name) (Expression typ) (Maybe Alignment) [GenStructElem typ]
-  deriving (Show, Functor)
- 
- type EnumVals typ = typ
- type MaskVals typ = typ
- 
- type Name = String
--type GenXReply typ = [GenStructElem typ]
-+data GenXReply typ = GenXReply (Maybe Alignment) [GenStructElem typ]
-+ deriving (Show, Functor)
- type Ref = String
- type MaskName = Name
- type ListName = Name
-@@ -150,3 +152,5 @@ data Binop = Add
- 
- data Unop = Complement
-  deriving (Show)
-+
-+data Alignment = Alignment Int Int deriving (Show)
-From 0991f1d61b92371e9af51ab0fa3699d7c32e2b65 Mon Sep 17 00:00:00 2001
-From: Tycho Andersen <tycho at tycho.ws>
-Date: Sat, 6 Aug 2016 11:38:09 -0600
-Subject: [PATCH] add new expression element "paramref"
-
-Signed-off-by: Tycho Andersen <tycho at tycho.ws>
----
- Data/XCB/FromXML.hs | 2 ++
- Data/XCB/Pretty.hs  | 1 +
- Data/XCB/Types.hs   | 1 +
- 3 files changed, 4 insertions(+)
-
-diff --git a/Data/XCB/FromXML.hs b/Data/XCB/FromXML.hs
-index af44a19..951c302 100644
---- a/Data/XCB/FromXML.hs
-+++ b/Data/XCB/FromXML.hs
-@@ -428,6 +428,8 @@ expression el | el `named` "fieldref"
-               | el `named` "sumof" = do
-                     ref <- el `attr` "ref"
-                     return $ SumOf ref
-+              | el `named` "paramref"
-+                    =  return $ ParamRef $ strContent el
-               | otherwise =
-                   let nm = elName el
-                   in error $ "Unknown epression " ++ show nm ++ " in Data.XCB.FromXML.expression"
-diff --git a/Data/XCB/Pretty.hs b/Data/XCB/Pretty.hs
-index 156d154..1f2b473 100644
---- a/Data/XCB/Pretty.hs
-+++ b/Data/XCB/Pretty.hs
-@@ -90,6 +90,7 @@ instance Pretty a => Pretty (Expression a) where
-                         ]
-     toDoc (Unop op expr)
-         = parens $ toDoc op <> toDoc expr
-+    toDoc (ParamRef n) = toDoc n
- 
- instance Pretty a => Pretty (GenStructElem a) where
-     toDoc (Pad n) = braces $ toDoc n <+> text "bytes"
-diff --git a/Data/XCB/Types.hs b/Data/XCB/Types.hs
-index 1b4fce3..8ec9ea3 100644
---- a/Data/XCB/Types.hs
-+++ b/Data/XCB/Types.hs
-@@ -139,6 +139,7 @@ data Expression typ
-     | SumOf Name -- ^Note sure. The argument should be a reference to a list
-     | Op Binop (Expression typ) (Expression typ) -- ^A binary opeation
-     | Unop Unop (Expression typ) -- ^A unary operation
-+    | ParamRef Name -- ^I think this is the name of an argument passed to the request. See fffbd04d63 in xcb-proto.
-  deriving (Show, Functor)
- 
- -- |Supported Binary operations.
-From 239afedc8678494684e8a81d4ffb6d7ccb3a052e Mon Sep 17 00:00:00 2001
-From: Tycho Andersen <tycho at tycho.ws>
-Date: Sun, 7 Aug 2016 09:40:12 -0600
-Subject: [PATCH] Alignment's "offset" is optional
-
-Signed-off-by: Tycho Andersen <tycho at tycho.ws>
----
- Data/XCB/FromXML.hs | 2 +-
- Data/XCB/Types.hs   | 2 +-
- 2 files changed, 2 insertions(+), 2 deletions(-)
-
-diff --git a/Data/XCB/FromXML.hs b/Data/XCB/FromXML.hs
-index 951c302..ed6e59c 100644
---- a/Data/XCB/FromXML.hs
-+++ b/Data/XCB/FromXML.hs
-@@ -78,7 +78,7 @@ allModules = fst `liftM` ask
- extractAlignment :: (MonadPlus m, Functor m) => [Element] -> m (Maybe Alignment, [Element])
- extractAlignment (el : xs) | el `named` "required_start_align" = do
-                                align <- el `attr` "align" >>= readM
--                               offset <- el `attr` "offset" >>= readM
-+                               let offset = el `attr` "offset" >>= readM
-                                return (Just (Alignment align offset), xs)
-                            | otherwise = return (Nothing, el : xs)
- extractAlignment xs = return (Nothing, xs)
-diff --git a/Data/XCB/Types.hs b/Data/XCB/Types.hs
-index 8ec9ea3..b31542e 100644
---- a/Data/XCB/Types.hs
-+++ b/Data/XCB/Types.hs
-@@ -154,4 +154,4 @@ data Binop = Add
- data Unop = Complement
-  deriving (Show)
- 
--data Alignment = Alignment Int Int deriving (Show)
-+data Alignment = Alignment Int (Maybe Int) deriving (Show)



More information about the arch-commits mailing list