c-struct 0.1.1.2 → 0.1.1.3

raw patch · 3 files changed

+81/−3 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• c-struct.cabal +3/−2
• src/Foreign/C/Struct.hs +10/−1
• src/Foreign/C/Struct/Ord.hs +68/−0

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4.+-- This file has been generated from package.yaml by hpack version 0.35.1. -- -- see: https://github.com/sol/hpack  name:           c-struct-version:        0.1.1.2+version:        0.1.1.3 synopsis:       To make a wrapper for struct of C language description:    Please see the README on GitHub at <https://github.com/YoshikuniJujo/c-struct#readme> category:       Foreign@@ -29,6 +29,7 @@   exposed-modules:       Foreign.C.Struct   other-modules:+      Foreign.C.Struct.Ord       Foreign.C.Struct.Parts       Paths_c_struct   hs-source-dirs:

@@ -41,6 +41,8 @@ 	intE, strP, pt, zp, ss, (..+), toLabel, lcfirst, 	bigTupleData, sbTupP, sbTupT, sbTupleE ) +import Foreign.C.Struct.Ord+ ---------------------------------------------------------------------------  -- * STRUCT@@ -264,7 +266,13 @@ mkInstanceOrd :: StrName -> [MemName] -> DecQ mkInstanceOrd sn ms = (,) <$> newName "s" <*> newName "t" >>= \(s, t) -> 	instanceD (cxt []) (conT ''Ord `appT` conT (mkName sn)) . (: [])-		. funD '(<=) . (: []) $ clause [varP s, varP t] (+		. funD '(<=) . (: []) $ clause [varP s, varP t]+			(normalB $ compareAllMember+				(varE . mkName . toLabel sn <$> ms)+				(varE s) (varE t)) []++{-+		( 			normalB $ varE 'foldr `appE` lamOrd s t `appE` 				conE 'True `appE` listE ln ) [] 	where ln = varE . mkName . toLabel sn <$> ms@@ -274,6 +282,7 @@ 	(,) <$> newName "x" <*> newName "v" >>= \(x, v) -> let xe = varE x in 		lamE [varP x, varP v] $ xe `appE` s .< xe `appE` t .|| 			xe `appE` s .== xe `appE` t .&& varE v+-}  -- Bounded 

@@ -0,0 +1,68 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Foreign.C.Struct.Ord where++import Language.Haskell.TH++compareAllMember :: [ExpQ] -> ExpQ -> ExpQ -> ExpQ+compareAllMember ms x y = compareAllFoo ((`appE` x) <$> ms) ((`appE` y) <$> ms)++compareAllFoo :: [ExpQ] -> [ExpQ] -> ExpQ+compareAllFoo xs ys = do+	cr <- newName "checkResult"+	letE [valD (varP cr) (normalB $ checkResultFoo' cr) []]+		(varE cr `appE` (compareList xs ys))++compareList :: [ExpQ] -> [ExpQ] -> ExpQ+compareList xs ys = listE $ zipWith compare' xs ys++compare' :: ExpQ -> ExpQ -> ExpQ+compare' x y = varE 'compare `appE` x `appE` y++checkResultFoo' :: Name -> ExpQ+checkResultFoo' fn = do+	x <- newName "x"+	xs <- newName "xs"+	lamCaseE $ checkResultFooLamCase x xs fn+	where+	checkResultFooLamCase x xs fn = [+		match (conP '[] []) (normalB $ conE 'True) [],+		match (infixP (varP x) '(:) (varP xs)) (normalB $ checkResultFooLamCaseCase x xs fn) [] ]+	checkResultFooLamCaseCase x xs fn = caseE (varE x) [+		match (conP 'LT []) (normalB $ conE 'True) [],+		match (conP 'GT []) (normalB $ conE 'False) [],+		match (conP 'EQ []) (normalB $ varE fn `appE` varE xs) [] ]++tx, ty, tz, tw :: ExpQ+[tx, ty, tz, tw] = varE . mkName <$> ["x", "y", "z", "w"]++{-+letFoo = [e| let x = 8 in x |]+-}++{-+some (a, b, c) (d, e, f) =+	[a `compare` d, b `compare` e, c `compare` f]++checkResult [] = True+checkResult (x : xs) = case x of+	LT -> True+	GT -> False+	EQ -> checkResult xs++compareAll x y = checkResult $ some x y++someFoo = [d|+	some (a, b, c) (d, e, f) =+		[compare a d, compare b e, compare c f] |]++checkResultFoo = head <$> [d|+	checkResult = \case+		[] -> True+		x : xs -> case x of+			LT -> True+			GT -> False+			EQ -> checkResult xs |]+-}