tuple-th 0.2.3 → 0.2.4
raw patch · 3 files changed
+82/−19 lines, 3 files
Files
- TupleTH.hs +72/−18
- tests/Test.hs +9/−0
- tuple-th.cabal +1/−1
TupleTH.hs view
@@ -15,7 +15,8 @@ -- * Construction safeTupleFromList, tupleFromList, constTuple, -- * Deconstruction- proj, elemTuple, tupleToList, sumTuple,+ proj, proj', elemTuple, tupleToList, sumTuple,+ findSuccessiveElementsSatisfying, -- ** Right folds foldrTuple, foldrTuple', foldr1Tuple, foldr1Tuple', @@ -32,15 +33,15 @@ htuple, ) where -import Language.Haskell.TH-import Data.Maybe-import Data.Functor-import Data.List+import Control.Applicative ( Applicative((<*>), pure) )+import Control.Exception ( assert ) import Control.Monad-import Control.Applicative-import Control.Exception-import qualified Data.Set as Set+import Data.Functor((<$>))+import Data.Maybe(fromMaybe) import Data.Set(member)+import Language.Haskell.TH+import qualified Data.Set as Set+import Data.List -- | Makes a homogenous tuple type of the given size and element type @@ -51,9 +52,9 @@ withxs :: Int -> (PatQ -> [ExpQ] -> Q b) -> Q b-withxs = withNames "x"+withxs = withNames "_x" withys :: Int -> (PatQ -> [ExpQ] -> Q b) -> Q b-withys = withNames "y"+withys = withNames "_y" newNames :: String -> Int -> Q [Name] newNames stem n = sequence [newName (stem++show i) | i <- [ 1::Int .. n ]] @@ -120,7 +121,7 @@ -> Int -- ^ 0-based index of component to retrieve -> ExpQ proj n i = do- x <- newName "x"+ x <- newName "_x" lam1E (tupP (replicate i wildP ++ [ varP x ] ++ replicate (n-i-1) wildP)) (varE x) -- | Type of the generated expression: @@ -132,7 +133,7 @@ -- | Takes the folding function (but not the seed element) as a quoted expression. See 'mapTuple'' for how this can be useful. foldrTuple' :: Int -> ExpQ -> ExpQ foldrTuple' n c = do- z <- newName "z"+ z <- newName "_z" withxs n (\xsp xes -> lamE [varP z, xsp] (foldr (appE2 c) (varE z) xes)) -- | Type of the generated expression: @@ -157,7 +158,7 @@ -- | Takes the folding function (but not the seed element) as a quoted expression. See 'mapTuple'' for how this can be useful. foldlTuple' :: Int -> ExpQ -> ExpQ foldlTuple' n c = do- z <- newName "z"+ z <- newName "_z" withxs n (\xsp xes -> lamE [varP z, xsp] (foldl (appE2 c) (varE z) xes)) -- | Type of the generated expression: @@ -204,6 +205,7 @@ lamE [xsp] (tupE [f `appE` x | x <- xes ])) +-- | Simple 'match' smatch :: PatQ -> ExpQ -> MatchQ smatch p e = match p (normalB e) [] @@ -212,10 +214,10 @@ -- > [a] -> Maybe (a, ..) safeTupleFromList :: Int -> Q Exp safeTupleFromList n = do- xns <- newNames "x" n+ xns <- newNames "_x" n let xps = varP <$> xns xes = varE <$> xns- xs <- newName "xs" + xs <- newName "_xs" lam1E (varP xs) (caseE (varE xs) [ smatch (listP xps) (conE 'Just `appE` (tupE xes)) , smatch wildP (conE 'Nothing)@@ -265,7 +267,7 @@ -- > Eq a => a -> (a, ..) -> Bool elemTuple :: Int -> Q Exp elemTuple n = do- z <- newName "z"+ z <- newName "_z" lam1E (varP z) (anyTuple' n [| (== $(varE z)) |]) @@ -389,7 +391,7 @@ -- | Generates a function which takes a 'Num' @i@ and a homogenous tuple of size @n@ and deletes the @i@-th (0-based) element of the tuple. deleteAtTuple :: Int -> Q Exp deleteAtTuple n = do- i <- newName "i"+ i <- newName "_i" lam1E (varP i) $ withxs n (\xsp xes -> @@ -425,6 +427,12 @@ dropTuple :: Int -> Int -> Q Exp dropTuple n i = reindexTuple n [i..n-1] ++cond :: [Q (Guard, Exp)] -> ExpQ -> ExpQ+cond branches otherwiseE =+ caseE [|()|] [match wildP (guardedB (branches ++ [normalGE [|otherwise|] otherwiseE])) []]++-- | @safeDeleteTuple n@ generates a function analogous to 'delete' that takes an element and an @n@-tuple and maybe returns an @n-1@-tuple (if and only if the element was found). safeDeleteTuple :: Int -> Q Exp safeDeleteTuple n = do e <- newName "_deletee" @@ -445,4 +453,50 @@ last_ge = normalGE [|otherwise|] [|Nothing|] in- caseE [|()|] [match wildP (guardedB (ges ++ [last_ge])) []]))+ cond ges [|Nothing|]))++++-- | Like 'proj', but takes the index argument as the first argument at runtime and returns a @Maybe@.+--+-- >>> :t $(proj' 3)+-- $(proj' 3) :: Num a => (a1, a1, a1) -> a -> Maybe a1+--+proj' :: Int -> Q Exp+proj' n = do+ i <- newName "_i"+ withxs n (\xsp xes ->+ lamE [varP i,xsp]+ (caseE (varE i)+ ([ smatch (litP . integerL . fromIntegral $ j) [| Just $(xes !! j) |]+ | j <- [0..n-1] ]++ ++ [smatch wildP [|Nothing|]])))+++++-- | Generates a function that takes a binary relation and a tuple @xs@, and returns 'Just' the first index @i@ such that the relation holds for @x_i@, @x_{i+1}@, or 'Nothing'.+--+-- >>> :t $(findSuccessiveElementsSatisfying 4)+-- $(findSuccessiveElementsSatisfying 4)+-- :: (t -> t -> Bool) -> (t, t, t, t) -> Maybe Int+findSuccessiveElementsSatisfying :: Int -> Q Exp+findSuccessiveElementsSatisfying n = do+ r <- newName "_r"+ withxs n (\xsp xes ->+ lamE [varP r, xsp]+ (cond+ [ normalGE [| $(varE r) $(x0) $(x1) |] + [| Just ($(litE . integerL $ i) :: Int) |]++ |+ (i,x0,x1) <- zip3 [0..] xes (drop 1 xes) ]+ [|Nothing|]))+ ++++ ++
tests/Test.hs view
@@ -6,6 +6,7 @@ import Test.QuickCheck.All import Data.Char import Test.QuickCheck.Property+import Data.Maybe prop_foldrTuple :: (Int, Int, Int) -> Bool prop_foldrTuple t@(x::Int,y,z) = $(foldrTuple 3) (:) [] t == [x,y,z]@@ -60,6 +61,14 @@ prop_deleteAtTuple_oob1 = expectFailure (deleteAtTuple3 (-1) (1,2,3) `seq` True) prop_deleteAtTuple_oob2 :: Property prop_deleteAtTuple_oob2 = expectFailure (deleteAtTuple3 3 (1,2,3) `seq` True)+++prop_proj' :: (Int,Int,Int) -> Property+prop_proj' xs@(x,y,z) = + let + xs' = $(mapTuple 5) (\i -> $(proj' 3) i xs) (-1::Int,0,1,2,3)+ in+ property (xs' == (Nothing,Just x,Just y,Just z,Nothing)) main :: IO Bool
tuple-th.cabal view
@@ -1,5 +1,5 @@ Name: tuple-th-Version: 0.2.3+Version: 0.2.4 Synopsis: Generate (non-recursive) utility functions for tuples of statically known size Description: Template Haskell functions for generating functions similar to those in Data.List for tuples of statically known size. License: BSD3