Permalink
Browse files

0.0.1

  • Loading branch information...
0 parents commit 78ddf9b8d91d6c3de40e338bd385418f768f0cdc @bmillwood committed Apr 13, 2012
Showing with 252 additions and 0 deletions.
  1. +2 −0 ChangeLog
  2. +30 −0 LICENSE
  3. +107 −0 NotCPP/OrphanEvasion.hs
  4. +51 −0 NotCPP/ScopeLookup.hs
  5. +11 −0 README
  6. +3 −0 Setup.hs
  7. +48 −0 notcpp.cabal
@@ -0,0 +1,2 @@
+0.0.1:
+* Initial release
30 LICENSE
@@ -0,0 +1,30 @@
+Copyright Ben Millwood 2012
+
+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 Ben Millwood 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,107 @@
+{-# LANGUAGE EmptyDataDecls, TemplateHaskell #-}
+-- |
+-- The orphan instance problem is well-known in Haskell. This module
+-- by no means purports to solve the problem, but provides a workaround
+-- that may be significantly less awful than the status quo in some
+-- cases.
+--
+-- Say I think that the 'Name' type should have an 'IsString' instance.
+-- But I don't control either the class or the type, so if I define the
+-- instance, and then the template-haskell package defines one, my code
+-- is going to break.
+--
+-- 'safeInstance' can help me to solve this problem:
+--
+-- > safeInstance ''IsString [t| Name |] [d|
+-- > fromString = mkName |]
+--
+-- This will declare an instance only if one doesn't already exist.
+-- Now anyone importing your module is guaranteed to get an instance
+-- one way or the other.
+--
+-- This module is still highly experimental. I suspect that some things
+-- like recursion still won't work, because of how the names are
+-- mangled. Let me know how you get on!
+module NotCPP.OrphanEvasion (
+ MultiParams,
+ safeInstance,
+ safeInstance',
+ ) where
+
+import Control.Applicative
+
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax
+
+-- | An empty type used only to signify a multiparameter typeclass in
+-- 'safeInstance'.
+data MultiParams a
+
+-- | Given @(forall ts. Cxt => t)@, return @(Cxt, [t])@.
+-- Given @(forall ts. Cxt => 'MultiParams' (t1, t2, t3))@, return
+-- @(Cxt, [t1, t2, t3])@.
+--
+-- This is used in 'safeInstance' to allow types to be specified more
+-- easily with TH typequotes.
+fromTuple :: Type -> (Cxt, [Type])
+fromTuple ty = unTuple <$> case ty of
+ ForallT _ cxt ty' -> (cxt, ty')
+ _ -> ([], ty)
+ where
+ unTuple :: Type -> [Type]
+ unTuple (AppT (ConT n) ta)
+ | n == ''MultiParams = case unrollAppT ta of
+ (TupleT{}, ts) -> ts
+ _ -> [ty]
+ unTuple t = [t]
+
+-- | A helper function to unwind type application.
+-- Given @TyCon t1 t2 t3@, returns @(TyCon, [t1,t2,t3])@
+unrollAppT :: Type -> (Type, [Type])
+unrollAppT = go []
+ where
+ go acc (AppT tc ta) = go (ta : acc) tc
+ go acc ty = (ty, reverse acc)
+
+-- | Left inverse to 'unrollAppT', equal to @'foldl' 'AppT'@
+rollAppT :: Type -> [Type] -> Type
+rollAppT = foldl AppT
+
+-- | @'safeInstance'' className cxt types methods@ produces an instance
+-- of the given class if and only if one doesn't already exist.
+--
+-- See 'safeInstance' for a simple way to construct the 'Cxt' and
+-- @['Type']@ parameters.
+safeInstance' :: Name -> Cxt -> [Type] -> Q [Dec] -> Q [Dec]
+safeInstance' cl cxt tys inst = do
+ b <- isInstance cl tys
+ if b
+ then return []
+ else do
+ ds <- map fixInst <$> inst
+ return [InstanceD cxt (rollAppT (ConT cl) tys) ds]
+ where
+ fixInst (FunD n cls) = FunD (fixName n) cls
+ fixInst (ValD (VarP n) rhs wh) = ValD (VarP (fixName n)) rhs wh
+ fixInst d = d
+ fixName (Name n _) = Name n NameS
+
+-- | 'safeInstance' is a more convenient version of 'safeInstance''
+-- that takes the context and type from a @'Q' 'Type'@ with the intention
+-- that it be supplied using a type-quote.
+--
+-- To define an instance @Show a => Show (Wrapper a)@, you'd use:
+--
+-- > safeInstance ''Show [t| Show a => Wrapper a |]
+-- > [d| show _ = "stuff" |]
+--
+-- To define an instance of a multi-param type class, use the
+-- 'MultiParams' type constructor with a tuple:
+--
+-- > safeInstance ''MonadState
+-- > [t| MonadState s m => MultiParams (s, MaybeT m) |]
+-- > [d| put = ... |]
+safeInstance :: Name -> Q Type -> Q [Dec] -> Q [Dec]
+safeInstance n qty inst = do
+ (cxt, tys) <- fromTuple <$> qty
+ safeInstance' n cxt tys inst
@@ -0,0 +1,51 @@
+{-# LANGUAGE TemplateHaskell #-}
+-- |
+-- This module exports 'scopeLookup', which will find a variable or
+-- value constructor for you and present it for your use. E.g. at some
+-- point in the history of the acid-state package, 'openAcidState' was
+-- renamed 'openLocalState'; for compatibility with both, you could
+-- use:
+--
+-- > openState :: IO (AcidState st)
+-- > openState = case $(scopeLookup "openLocalState") of
+-- > Just open -> open defaultState
+-- > Nothing -> case $(scopeLookup "openAcidState") of
+-- > Just open -> open defaultState
+-- > Nothing -> error
+-- > "openState: runtime name resolution has its drawbacks :/"
+--
+module NotCPP.ScopeLookup (
+ scopeLookup,
+ maybeReify,
+ ) where
+
+import Control.Applicative ((<$>))
+
+import Language.Haskell.TH
+
+-- | Produces a spliceable expression which expands to 'Just val' if
+-- the given string refers to a value 'val' in scope, or 'Nothing'
+-- otherwise.
+scopeLookup :: String -> Q Exp
+scopeLookup s = recover [| Nothing |] $ do
+ Just n <- lookupValueName s
+ Just exp <- infoToExp <$> reify n
+ [| Just $(return exp) |]
+
+-- | A useful variant of 'reify' that returns 'Nothing' instead of
+-- halting compilation when an error occurs (e.g. because the given
+-- name was not in scope).
+maybeReify :: Name -> Q (Maybe Info)
+maybeReify = recoverMaybe . reify
+
+-- | Turns a possibly-failing 'Q' action into one returning a 'Maybe'
+-- value.
+recoverMaybe :: Q a -> Q (Maybe a)
+recoverMaybe q = recover (return Nothing) (Just <$> q)
+
+-- | Returns 'Just (VarE n)' if the info relates to a value called 'n',
+-- or 'Nothing' if it relates to a different sort of thing.
+infoToExp :: Info -> Maybe Exp
+infoToExp (VarI n _ _ _) = Just (VarE n)
+infoToExp (DataConI n _ _ _) = Just (ConE n)
+infoToExp _ = Nothing
11 README
@@ -0,0 +1,11 @@
+This package is as much about getting people to think about ways to
+avoid using the C preprocessor, which isn't really suited to Haskell and
+never has been, as it is about genuinely providing a set of functions
+that people will use in production code.
+
+That is to say, it isn't very good.
+
+Areas of future development:
+- compatibility with older GHCs
+- catering for missing constructors we can't match against and the like
+- quasiquoters to make using the thing less painful
@@ -0,0 +1,3 @@
+module Main (main) where
+import Distribution.Simple (defaultMain)
+main = defaultMain
@@ -0,0 +1,48 @@
+Cabal-Version: >= 1.6
+
+Name: notcpp
+Version: 0.0.1
+Category: Template Haskell
+Synopsis: Avoiding the C preprocessor via cunning use of Template Haskell
+
+Description:
+ notcpp is a library that attempts to provide an alternative to
+ using CPP as a mechanism for conditional compilation. It provides
+ facilities for determining if specific names or class instances
+ exist and responding accordingly.
+ .
+ When a value or class instance appears between minor releases of a
+ third-party package, a common way of dealing with the problem is to
+ use CPP to conditionally use one block of code or another. The
+ trouble with CPP is it's hard to statically analyse: tools based on
+ haskell-src-exts will outright refuse to parse it, for example. It
+ turns out Template Haskell will do the same job in some cases.
+
+Author: Ben Millwood <haskell@benmachine.co.uk>
+Maintainer: Ben Millwood <haskell@benmachine.co.uk>
+Bug-reports: https://github.com/benmachine/notcpp/issues
+Copyright: 2012 Ben Millwood
+License: BSD3
+License-file: LICENSE
+
+Build-type: Simple
+Tested-with: GHC == 7.4.1
+
+Source-repository head
+ Type: git
+ Location: git://github.com/benmachine/notcpp
+
+Library
+ Exposed-modules:
+ NotCPP.ScopeLookup
+ NotCPP.OrphanEvasion
+
+ Build-depends:
+ base < 5,
+ template-haskell == 2.7.*
+
+ Extensions:
+ TemplateHaskell
+
+ GHC-Options: -W
+ Hs-source-dirs: .

0 comments on commit 78ddf9b

Please sign in to comment.