lift-generics (empty) → 0.1

raw patch · 9 files changed

+454/−0 lines, 9 filesdep +basedep +base-compatdep +generic-derivingsetup-changed

Dependencies added: base, base-compat, generic-deriving, ghc-prim, hspec, lift-generics, template-haskell

Files

• CHANGELOG.md +2/−0
• LICENSE +30/−0
• README.md +20/−0
• Setup.hs +2/−0
• lift-generics.cabal +64/−0
• src/Language/Haskell/TH/Lift/Generics.hs +221/−0
• tests/LiftGenericsSpec.hs +37/−0
• tests/Spec.hs +1/−0
• tests/Types.hs +77/−0

@@ -0,0 +1,2 @@+## 0.1+* Initial commit

@@ -0,0 +1,30 @@+Copyright (c) 2015, Ryan Scott++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * 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.++    * Neither the name of Ryan Scott nor the names of other+      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,20 @@+# `lift-generics`++[![Haskell Programming Language](https://img.shields.io/badge/language-Haskell-blue.svg)][Haskell.org]+[![BSD3 License](http://img.shields.io/badge/license-BSD3-brightgreen.svg)][tl;dr Legal: BSD3]+[![Build](https://img.shields.io/travis/RyanGlScott/lift-generics.svg)](https://travis-ci.org/RyanGlScott/lift-generics)++[Haskell.org]:+  http://www.haskell.org+  "The Haskell Programming Language"+[tl;dr Legal: BSD3]:+  https://tldrlegal.com/license/bsd-3-clause-license-%28revised%29+  "BSD 3-Clause License (Revised)"++This package provides a `GHC.Generics`-based `genericLiftWithPkg` function (intended for GHC 7.10 and earlier), as well as a `genericLift` function (only available on GHC 8.0 and later), both of which can be used for providing a `Language.Haskell.TH.Syntax.lift` implementation. See the documentation in the `Language.Haskell.TH.Lift.Generics` module to get started.++Credit goes to Matthew Pickering for [suggesting this idea](https://ghc.haskell.org/trac/ghc/ticket/1830#comment:12).++Note that due to API limitations, `GHC.Generics` wasn't powerful enough to come up with the entirety of a `lift` implementation prior to GHC 8.0. For this reason, `genericLiftWithPkg` requires you to produce the package name yourself, which proves to be no small feat (see the documentation for more info).++Luckily, you don't have to jump through as many hoops on GHC 8.0 and later: simply use the `genericLift` function, and life is good.

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

@@ -0,0 +1,64 @@+name:                lift-generics+version:             0.1+synopsis:            GHC.Generics-based Language.Haskell.TH.Syntax.lift implementation+description:         This package provides a "GHC.Generics"-based @genericLiftWithPkg@+                     function (intended for GHC 7.10 and earlier), as well as a+                     @genericLift@ function (only available on GHC 8.0 and later),+                     both of which can be used for providing a+                     @Language.Haskell.TH.Syntax.lift@ implementation. See the+                     documentation in the "Language.Haskell.TH.Lift.Generics" module+                     to get started.+                     .+                     Credit goes to Matthew Pickering for+                     <https://ghc.haskell.org/trac/ghc/ticket/1830#comment:12 suggesting this idea>.+                     .+                     Note that due to API limitations, "GHC.Generics" wasn't powerful+                     enough to come up with the entirety of a `lift` implementation prior+                     to GHC 8.0. For this reason, @genericLiftWithPkg@ requires you to+                     produce the package name yourself, which proves to be no small feat+                     (see the documentation for more info).+                     .+                     Luckily, you don't have to jump through as many hoops on GHC 8.0 and+                     later: simply use the @genericLift@ function, and life is good.+homepage:            https://github.com/RyanGlScott/lift-generics+bug-reports:         https://github.com/RyanGlScott/lift-generics/issues+license:             BSD3+license-file:        LICENSE+author:              Ryan Scott+maintainer:          Ryan Scott <ryan.gl.scott@gmail.com>+stability:           Experimental+copyright:           (C) 2015 Ryan Scott+category:            Language+build-type:          Simple+extra-source-files:  CHANGELOG.md, README.md+cabal-version:       >=1.10++source-repository head+  type:                git+  location:            https://github.com/RyanGlScott/lift-generics++library+  exposed-modules:     Language.Haskell.TH.Lift.Generics+  build-depends:       base             >= 4.3 && < 5+                     , generic-deriving >= 1.9 && < 2+                     , ghc-prim+                     , template-haskell >= 2.4 && < 2.12+  hs-source-dirs:      src+  default-language:    Haskell2010+  ghc-options:         -Wall++test-suite spec+  type:                exitcode-stdio-1.0+  main-is:             Spec.hs+  other-modules:       LiftGenericsSpec+                       Types+                       Paths_lift_generics+  build-depends:       base             >= 4.3   && < 5+                     , base-compat      >= 0.8.2 && < 1+                     , generic-deriving >= 1.9   && < 2+                     , hspec            >= 2     && < 3+                     , lift-generics    == 0.1+                     , template-haskell >= 2.4   && < 2.12+  hs-source-dirs:      tests+  default-language:    Haskell2010+  ghc-options:         -Wall -threaded -rtsopts

@@ -0,0 +1,221 @@+{-# LANGUAGE CPP                  #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE MagicHash            #-}+{-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE TypeSynonymInstances #-}++{-|+Module:      Language.Haskell.TH.Lift.Generics+Copyright:   (C) 2015 Ryan Scott+License:     BSD-style (see the file LICENSE)+Maintainer:  Ryan Scott++"GHC.Generics"-based approach to implementing `lift`.+-}+module Language.Haskell.TH.Lift.Generics (+      genericLiftWithPkg+#if __GLASGOW_HASKELL__ >= 711+    , genericLift+#endif+    , GLift(..)+    , GLiftDatatype(..)+    , GLiftArgs(..)+    -- * 'Lift' reexport+    , Lift(..)+    ) where++#if MIN_VERSION_template_haskell(2,8,0)+import Data.Char (ord)+import Data.Word (Word8)+#endif++import Generics.Deriving++import GHC.Base (unpackCString#)+import GHC.Exts++import Language.Haskell.TH.Lib+import Language.Haskell.TH.Syntax++#undef CURRENT_PACKAGE_KEY+-- | "GHC.Generics"-based 'lift' implementation.+--+-- API limitations of early versions of GHC (7.10 and earlier) require the user+-- to produce the package name themselves. This isn't as easy to come up with as+-- it sounds, because GHC 7.10 uses a hashed package ID for a name. To make things+-- worse, if you produce the wrong package name, you might get bizarre compilation+-- errors!+--+-- There's no need to fear, though—the code sample below shows an example of how to+-- properly use 'genericLiftWithPkg' without shooting yourself in the foot:+--+-- @+-- {-# LANGUAGE CPP, DeriveGeneric #-}+-- -- part of package foobar+-- module Foo where+--+-- import GHC.Generics+-- import Language.Haskell.Lift.Generics+--+-- #ifndef CURRENT_PACKAGE_KEY+-- import Data.Version (showVersion)+-- import Paths_foobar (version)+-- #endif+--+-- pkgName :: String+-- #ifdef CURRENT_PACKAGE_KEY+-- pkgName = CURRENT_PACKAGE_KEY+-- #else+-- pkgName = "foobar-" ++ showVersion version+-- #endif+--+-- data Foo = Foo Int Char String+--   deriving Generic+--+-- instance Lift Foo where+--   lift = genericLiftWithPkg pkgName+-- @+--+-- As you can see, this trick only works if (1) the current package key is known+-- (i.e., the 'Lift' instance is defined in the same package as the datatype), or+-- (2) you're dealing with a package that has a fixed package name (e.g., @base@,+-- @ghc-prim@, @template-haskell@, etc.).+--+-- Once the @Lift Foo@ instance is defined, you can splice @Foo@ values directly+-- into Haskell source code:+--+-- @+-- {-# LANGUAGE TemplateHaskell #-}+-- module Bar where+--+-- import Foo+-- import Language.Haskell.TH.Syntax+--+-- foo :: Foo+-- foo = $(lift (Foo 1 'a' "baz"))+-- @+genericLiftWithPkg :: (Generic a, GLift (Rep a)) => String -> a -> Q Exp+genericLiftWithPkg pkg = glift pkg . from++#if __GLASGOW_HASKELL__ >= 711+-- | "GHC.Generics"-based 'lift' implementation. Only available on GHC 8.0 and later+-- due to API limitations of earlier GHC versions.+--+-- Unlike 'genericLiftWithPkg', this function does all of the work for you:+--+-- @+-- {-# LANGUAGE DeriveGeneric #-}+-- module Foo where+--+-- import GHC.Generics+-- import Language.Haskell.Lift.Generics+--+-- data Foo = Foo Int Char String+--   deriving Generic+--+-- instance Lift Foo where+--   lift = genericLift+-- @+--+-- Now you can splice @Foo@ values directly into Haskell source code:+--+-- @+-- {-# LANGUAGE TemplateHaskell #-}+-- module Bar where+--+-- import Foo+-- import Language.Haskell.TH.Syntax+--+-- foo :: Foo+-- foo = $(lift (Foo 1 'a' "baz"))+-- @+genericLift :: (Generic a, GLift (Rep a)) => a -> Q Exp+genericLift = glift "" . from+#endif++-- | Class of generic representation types which can be converted to Template+-- Haskell expressions. You shouldn't need to use this typeclass directly; it is+-- only exported for educational purposes.+class GLift f where+    glift :: String -- ^ The package name (not used on GHC 8.0 and later)+          -> f a    -- ^ The generic value+          -> Q Exp  -- ^ The resulting Template Haskell expression++instance (Datatype d, GLiftDatatype f) => GLift (D1 d f) where+    glift _pkg d@(M1 x) = gliftWith pName mName x+      where+        pName, mName :: String+#if __GLASGOW_HASKELL__ >= 711+        pName = packageName d+#else+        pName = _pkg+#endif+        mName = moduleName d++-- | Class of generic representation types which can be converted to Template+-- Haskell expressions, given a package and module name. You shouldn't need to use+-- this typeclass directly; it is only exported for educational purposes.+class GLiftDatatype f where+    gliftWith :: String -- ^ The package name+              -> String -- ^ The module name+              -> f a    -- ^ The generic value+              -> Q Exp  -- ^ The resulting Template Haskell expression++instance (Constructor c, GLiftArgs f) => GLiftDatatype (C1 c f) where+    gliftWith pName mName c@(M1 x) =+      appsE (conE (mkNameG_d pName mName cName) : gliftArgs x)+      where+        cName :: String+        cName = conName c++instance (GLiftDatatype f, GLiftDatatype g) => GLiftDatatype (f :+: g) where+    gliftWith pName mName (L1 l) = gliftWith pName mName l+    gliftWith pName mName (R1 r) = gliftWith pName mName r++-- | Class of generic representation types which can be converted to a list of+-- Template Haskell expressions (which represent a constructors' arguments). You+-- shouldn't need to use this typeclass directly; it is only exported for educational+-- purposes.+class GLiftArgs f where+    gliftArgs :: f a -> [Q Exp]++instance GLiftArgs U1 where+    gliftArgs U1 = []++instance Lift c => GLiftArgs (K1 i c) where+    gliftArgs (K1 x) = [lift x]++instance GLiftArgs f => GLiftArgs (S1 s f) where+    gliftArgs (M1 x) = gliftArgs x++instance (GLiftArgs f, GLiftArgs g) => GLiftArgs (f :*: g) where+    gliftArgs (f :*: g) = gliftArgs f ++ gliftArgs g++instance GLiftArgs UAddr where+    gliftArgs (UAddr a) = [litE (stringPrimL (word8ify (unpackCString# a)))]+      where+#if MIN_VERSION_template_haskell(2,8,0)+        word8ify :: String -> [Word8]+        word8ify = map (fromIntegral . ord)+#else+        word8ify :: String -> String+        word8ify = id+#endif++#if MIN_VERSION_template_haskell(2,11,0)+instance GLiftArgs UChar where+    gliftArgs (UChar c) = [litE (charPrimL (C# c))]+#endif++instance GLiftArgs UDouble where+    gliftArgs (UDouble d) = [litE (doublePrimL (toRational (D# d)))]++instance GLiftArgs UFloat where+    gliftArgs (UFloat f) = [litE (floatPrimL (toRational (F# f)))]++instance GLiftArgs UInt where+    gliftArgs (UInt i) = [litE (intPrimL (toInteger (I# i)))]++instance GLiftArgs UWord where+    gliftArgs (UWord w) = [litE (wordPrimL (toInteger (W# w)))]

@@ -0,0 +1,37 @@+{-# LANGUAGE TemplateHaskell #-}++{-|+Module:      LiftGenericsSpec+Copyright:   (C) 2015 Ryan Scott+License:     BSD-style (see the file LICENSE)+Maintainer:  Ryan Scott++@hspec@ tests for `lift-generics`.+-}+module LiftGenericsSpec (main, spec) where++import Language.Haskell.TH.Syntax (lift)+import Test.Hspec (Spec, hspec, describe, it, parallel, shouldBe)+import Types (Unit(..), p, s, u)++main :: IO ()+main = hspec spec++description :: String+description = "should equal its lifted counterpart"++spec :: Spec+-- spec = return ()+spec = parallel $ do+    describe "Unit" $+        it description $+            Unit `shouldBe` $(lift Unit)+    describe "Product" $+        it description $+            p `shouldBe` $(lift p)+    describe "Sum" $+        it description $+            s `shouldBe` $(lift s)+    describe "Unboxed" $+        it description $+            u `shouldBe` $(lift u)

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

@@ -0,0 +1,77 @@+{-# LANGUAGE CPP             #-}+{-# LANGUAGE MagicHash       #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies    #-}++{-|+Module:      Types+Copyright:   (C) 2015 Ryan Scott+License:     BSD-style (see the file LICENSE)+Maintainer:  Ryan Scott++Data types for testing `lift-generics`' capabilities.+-}+module Types (Unit(..), Product(..), Sum(..), p, s, u) where++import Generics.Deriving.TH (deriveAll)++import GHC.Exts++import Language.Haskell.TH.Lift.Generics (genericLiftWithPkg)+import Language.Haskell.TH.Syntax (Lift(..))++import Prelude ()+import Prelude.Compat++data Unit = Unit+  deriving (Eq, Ord, Show)+data Product a b c d = Product a b c d+  deriving (Eq, Ord, Show)+data Sum a b = Inl a | Inr b+  deriving (Eq, Ord, Show)+data Unboxed a+   = Unboxed a+#if MIN_VERSION_template_haskell(2,11,0)+             Char#+#endif+             Double#+             Float#+             Int#+             Word#+  deriving (Eq, Ord, Show)++p :: Product Char Int Bool String+p = Product 'a' 1 True "b"++s :: Sum Char Int+s = Inl 'c'++u :: Unboxed Int+u = Unboxed 1+#if MIN_VERSION_template_haskell(2,11,0)+            '1'#+#endif+            1.0##+            1.0#+            1#+            1##++pkgKey :: String+pkgKey = "main"++instance Lift Unit where+    lift = genericLiftWithPkg pkgKey++instance (Lift a, Lift b, Lift c, Lift d) => Lift (Product a b c d) where+    lift = genericLiftWithPkg pkgKey++instance (Lift a, Lift b) => Lift (Sum a b) where+    lift = genericLiftWithPkg pkgKey++instance Lift a => Lift (Unboxed a) where+    lift = genericLiftWithPkg pkgKey++$(deriveAll ''Unit)+$(deriveAll ''Product)+$(deriveAll ''Sum)+$(deriveAll ''Unboxed)