meta-misc (empty) → 0.1.0.2

raw patch · 4 files changed

+120/−0 lines, 4 filesdep +basedep +loch-thdep +template-haskellsetup-changed

Dependencies added: base, loch-th, template-haskell

Files

• LICENSE +28/−0
• Setup.hs +2/−0
• meta-misc.cabal +37/−0
• src/Language/Haskell/Util/Cons.hs +53/−0

@@ -0,0 +1,28 @@+Copyright (c) 2010, Byron James Johnson+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice,+   this list of conditions and the following disclaimer.++2. 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.++3. Neither the name of the author nor the names of its contributors may be+   used to endorse or promote products derived from this software without+   specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "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 OWNER OR CONTRIBUTORS 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.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,37 @@+name:          meta-misc+-- Don't forget to bump the tag too.+version:       0.1.0.2+cabal-version: >= 1.10+build-type:    Simple+license:       BSD3+license-file:  LICENSE+copyright:     Copyright (C) 2011 Byron James Johnson+author:        Byron James Johnson+maintainer:    ByronJohnsonFP@gmail.com+category:      Language, Generics, Data, Utility+tested-with:   GHC == 7.8.2+synopsis:      Utility library providing miscellaneous meta-programming utilities.+description:+  Utility library providing miscellaneous meta-programming utilities.++library+  default-language:  Haskell2010+  hs-source-dirs:    src+  ghc-options:       -Wall+  build-depends:+    base             >= 4   && < 5+   ,template-haskell >= 2.5 && < 3+   ,loch-th          >= 0.1 && < 1+  exposed-modules:+    Language.Haskell.Util.Cons+  other-extensions:+    TemplateHaskell++source-repository head+    type:     git+    location: git@github.com:bairyn/meta-misc.git++source-repository this+    type:     git+    location: git@github.com:bairyn/meta-misc.git+    tag:      v0.1.0.2

@@ -0,0 +1,53 @@+{-# LANGUAGE TemplateHaskell #-}++module Language.Haskell.Util.Cons+	( decons+	) where++import Data.List+import Debug.Trace.LocationTH+import Language.Haskell.TH+import Text.Printf++-- | Generate a deconstructor that takes as input a value and returns 'Maybe'+-- the deconstructed value.+--+-- This functions as a Data Constructor inverter.  If the number of+-- parameters of a constructor is not equal to 1, 'Maybe' a tuple is returned.--  The result of this function is defined only when +--+-- Example:+--+-- @+-- $(decons 'Right) (Right "foo") :: Maybe String+-- $(decons '(:)) "bar" :: Maybe (Char, String)+-- @+decons :: Name -> Q Exp+decons n_cons = do+    n_x <- newName "x"+    info <- reify n_cons+    let typeOfCons =+            case info of+                (DataConI _ t _ _)  ->+                    t+                _                   ->+                    $failure $ printf "the referent of the name '%s' is invalid; it should be a data constructor ('DataConI')" (nameBase n_cons)+    --flip seq (return ()) $ typeOfCons  -- TODO: jj+    let numParams :: Type -> Integer+        numParams (ForallT _ _ t) = numParams t+        numParams (VarT _)        = 0+        numParams (ConT _)        = 0+        numParams (TupleT _)      = 0+        numParams (ArrowT)        = 0+        numParams (ListT)         = 0+        numParams (AppT ArrowT _) = 1+        numParams (AppT a b)      = numParams a + numParams b+        numParams (SigT t _)      = numParams t+    names <- sequence . flip genericReplicate (newName "a") $ numParams typeOfCons+    return $+        LamE [VarP n_x] $                                                  -- \x ->+            CaseE (VarE n_x) $                                             --     case x of+                [ flip (Match (ConP n_cons $ map VarP names)) [] $         --         (Cons a b …) ->+                    NormalB . AppE (ConE 'Just) . TupE . map VarE $ names  --             Just (a, b, …)+                , flip (Match WildP) [] $                                  --         _            ->+                    NormalB $ ConE 'Nothing                                --             Nothing+                ]