reflection-2.1.4/0000755000000000000000000000000013316537060012042 5ustar0000000000000000reflection-2.1.4/CHANGELOG.markdown0000644000000000000000000000601213316537060015074 0ustar0000000000000000# 2.1.4 [2018.07.02] * Allow building with GHC 8.6. # 2.1.3 [2018.01.18] * Add `Semigroup` instance for `ReflectedMonoid`. # 2.1.2 * Support cross-compilation and unregistered GHC builds. # 2.1.1.1 * Fixed typos in the documentation. # 2.1.1 * Fixed support for GHC 7.0 # 2.1 * Added `ReifiedMonoid` and `ReifiedApplicative`. # 2 * Added `reifyNat` and `reifySymbol` for GHC 7.8+, capable of reflecting into the `KnownNat` and `KnownSymbol` classes respectively for use with other APIs. * Back-ported `reifyTypeable` from `lens`. This enables us to perform a (less efficient) form of `Typeable` reflection. # 1.5.2 * Renamed the flag for disabling the use of `template-haskell`, to `-f-template-haskell` for consistency with my other packages. # 1.5.1.2 * Builds warning-free on GHC 7.10. * Added a dynamic FromJSON example. # 1.5.1.1 * Updated the link to the paper. * More examples. # 1.5.1 * We no longer export Show (Q a) for GHC >= 7.4. This was causing random hangs when users tried to somehow run declaration splices from the REPL. * We no longer depend on tagged for GHC >= 7.8, since `Proxy` is now in `base`. # 1.5 * Added a flag to disable `template-haskell` support for GHC stage1 platforms. * Added instances of `Reifies` for `GHC.TypeLits` # 1.4 * Changed the behavior of the $(1) template haskell splices for Exp to use a Proxy rather than value-level numbers. This is more consistent with the role of this libraary and the other could always be generated via sa splice anyways. # 1.3.1 * Added a workaround for changes in the behavior of the internal 'Magic' datatype under the current GHC PolyKinds implementation. # 1.3 * Merged some functionality from Data.Analytics.Reflection. Notably the ability to use type nats to reflect numbers, and to splice numbers directly. This reduces orphan instances somewhat. # 1.2 * Added `Given` and give. # 1.1.7 * Fixed an issue caused by changes in GHC 7.7's typechecker by using explicit `ScopedTypeVariables`. # 1.1.6: * Relaxed an unnecessary strictness annotation in the fast implementation # 1.1.5 * Both implementations now work on Hugs; the fast implementation ascends from the ranks of completely unportable black magic to being merely /mostly/ unportable black magic. # From 0.5 to 1.1: * Much faster implementation available that is about 50 /times/ faster than 0.9 and which runs purely on black magic. This version is now used by default. To turn it off install with the `slow` flag. If you encounter a problem with the implementation, please contact the author. * Removed `ReifiedNum`, `reflectNum`, and `reifyIntegral`; `reify` and `reflect` are about 3 orders of magnitude faster than the special case combinators were. # 0.5 * Generalized the type signatures in reflect to allow you to pass any type with kind `* -> *` wrapped around the desired type as the phantom type argument rather than just a `Proxy`. # 0.4 * Converted from `Data.Tagged` to using `Data.Proxy` for reflection. This reduces the need for helper functions and scoped type variables in user code. reflection-2.1.4/reflection.cabal0000644000000000000000000000667113316537060015172 0ustar0000000000000000name: reflection version: 2.1.4 license: BSD3 license-file: LICENSE author: Edward A. Kmett, Elliott Hird, Oleg Kiselyov and Chung-chieh Shan maintainer: Edward A. Kmett stability: experimental homepage: http://github.com/ekmett/reflection bug-reports: http://github.com/ekmett/reflection/issues category: Data, Reflection, Dependent Types synopsis: Reifies arbitrary terms into types that can be reflected back into terms copyright: 2009-2013 Edward A. Kmett, 2012 Elliott Hird, 2004 Oleg Kiselyov and Chung-chieh Shan build-type: Simple cabal-version: >= 1.10 description: This package addresses the /configuration problem/ which is propagating configurations that are available at run-time, allowing multiple configurations to coexist without resorting to mutable global variables or 'System.IO.Unsafe.unsafePerformIO'. . That package is an implementation of the ideas presented in the paper \"Functional Pearl: Implicit Configurations\" by Oleg Kiselyov and Chung-chieh Shan (). However, the API has been streamlined to improve performance. . Austin Seipp's tutorial provides a summary of the approach taken by this library, along with more motivating examples. tested-with: GHC == 7.0.4 , GHC == 7.2.2 , GHC == 7.4.2 , GHC == 7.6.3 , GHC == 7.8.4 , GHC == 7.10.3 , GHC == 8.0.2 , GHC == 8.2.2 , GHC == 8.4.3 , GHC == 8.6.1 extra-source-files: examples/reflection-examples.cabal examples/LICENSE examples/*.hs CHANGELOG.markdown README.markdown slow/Data/Reflection.hs fast/Data/Reflection.hs .travis.yml flag slow description: If you enable this flag, we use a more portable much much slower implementation. Moreover, the 'Given' API is broken, so this is currently an unsupported configuration. If you feel the need to turn on this flag for any reason, please email the maintainer! default: False manual: False flag template-haskell description: You can disable the use of the `template-haskell` package using `-f-template-haskell`. . Disabling this is an unsupported configuration, but it may be useful for accelerating builds in sandboxes for expert users. default: True manual: True source-repository head type: git location: git://github.com/ekmett/reflection.git library ghc-options: -Wall if impl(ghc >= 7.2) default-extensions: Trustworthy build-depends: base >= 2 && < 5 if impl(ghc < 7.8) build-depends: tagged >= 0.4.4 && < 1 if !impl(ghc >= 8.0) build-depends: semigroups >= 0.11 && < 0.19 default-language: Haskell98 if flag(template-haskell) && impl(ghc) if !impl(ghc >= 8.0) other-extensions: TemplateHaskell -- else -- other-extensions: TemplateHaskellQuotes -- Hackage doesn't know this extension yet build-depends: template-haskell if !flag(slow) && (impl(ghc) || impl(hugs)) hs-source-dirs: fast else other-extensions: ScopedTypeVariables, FlexibleInstances hs-source-dirs: slow other-extensions: MultiParamTypeClasses, FunctionalDependencies, Rank2Types, CPP exposed-modules: Data.Reflection reflection-2.1.4/README.markdown0000644000000000000000000000132013316537060014537 0ustar0000000000000000reflection ========== [![Hackage](https://img.shields.io/hackage/v/reflection.svg)](https://hackage.haskell.org/package/reflection) [![Build Status](https://secure.travis-ci.org/ekmett/reflection.png?branch=master)](http://travis-ci.org/ekmett/reflection) This package provides an implementation of the ideas presented in [Functional Pearl: Implicit Configurations](http://okmij.org/ftp/Haskell/tr-15-04.pdf) by Oleg Kiselyov and Chung-Chieh Shan. However, the API has been implemented in a much more efficient manner. Contact Information ------------------- Contributions and bug reports are welcome! Please feel free to contact me through github or on the #haskell IRC channel on irc.freenode.net. -Edward Kmett reflection-2.1.4/Setup.lhs0000644000000000000000000000016513316537060013654 0ustar0000000000000000#!/usr/bin/runhaskell > module Main (main) where > import Distribution.Simple > main :: IO () > main = defaultMain reflection-2.1.4/.travis.yml0000644000000000000000000001657113316537060014165 0ustar0000000000000000# This Travis job script has been generated by a script via # # runghc make_travis_yml_2.hs '-o' '.travis.yml' '--ghc-head' '--jobs=2' '--irc-channel=irc.freenode.org#haskell-lens' '--no-no-tests-no-bench' '--no-install-dependencies' 'cabal.project' # # For more information, see https://github.com/hvr/multi-ghc-travis # language: c sudo: false git: submodules: false # whether to recursively clone submodules notifications: irc: channels: - "irc.freenode.org#haskell-lens" skip_join: true template: - "\x0313reflection\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}" cache: directories: - $HOME/.cabal/packages - $HOME/.cabal/store before_cache: - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log # remove files that are regenerated by 'cabal update' - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.* - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx - rm -rfv $HOME/.cabal/packages/head.hackage matrix: include: - compiler: "ghc-8.6.1" env: GHCHEAD=true addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.6.1], sources: [hvr-ghc]}} - compiler: "ghc-8.4.3" # env: TEST=--disable-tests BENCH=--disable-benchmarks addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.4.3], sources: [hvr-ghc]}} - compiler: "ghc-8.2.2" # env: TEST=--disable-tests BENCH=--disable-benchmarks addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.2.2], sources: [hvr-ghc]}} - compiler: "ghc-8.0.2" # env: TEST=--disable-tests BENCH=--disable-benchmarks addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.0.2], sources: [hvr-ghc]}} - compiler: "ghc-7.10.3" # env: TEST=--disable-tests BENCH=--disable-benchmarks addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.10.3], sources: [hvr-ghc]}} - compiler: "ghc-7.8.4" # env: TEST=--disable-tests BENCH=--disable-benchmarks addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.8.4], sources: [hvr-ghc]}} - compiler: "ghc-7.6.3" # env: TEST=--disable-tests BENCH=--disable-benchmarks addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.6.3], sources: [hvr-ghc]}} - compiler: "ghc-7.4.2" # env: TEST=--disable-tests BENCH=--disable-benchmarks addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.4.2], sources: [hvr-ghc]}} - compiler: "ghc-7.2.2" # env: TEST=--disable-tests BENCH=--disable-benchmarks addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.2.2], sources: [hvr-ghc]}} - compiler: "ghc-7.0.4" # env: TEST=--disable-tests BENCH=--disable-benchmarks addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.0.4], sources: [hvr-ghc]}} - compiler: "ghc-head" env: GHCHEAD=true addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-head], sources: [hvr-ghc]}} allow_failures: - compiler: "ghc-head" - compiler: "ghc-7.0.4" - compiler: "ghc-7.2.2" - compiler: "ghc-8.6.1" before_install: - HC=${CC} - HCPKG=${HC/ghc/ghc-pkg} - unset CC - ROOTDIR=$(pwd) - mkdir -p $HOME/.local/bin - "PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$HOME/local/bin:$PATH" - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') )) - echo $HCNUMVER install: - cabal --version - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" - BENCH=${BENCH---enable-benchmarks} - TEST=${TEST---enable-tests} - HADDOCK=${HADDOCK-true} - UNCONSTRAINED=${UNCONSTRAINED-true} - NOINSTALLEDCONSTRAINTS=${NOINSTALLEDCONSTRAINTS-false} - GHCHEAD=${GHCHEAD-false} - travis_retry cabal update -v - "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config" - rm -fv cabal.project cabal.project.local - "sed -i.bak 's/^-- jobs:.*/jobs: 2/' ${HOME}/.cabal/config" # Overlay Hackage Package Index for GHC HEAD: https://github.com/hvr/head.hackage - | if $GHCHEAD; then sed -i 's/-- allow-newer: .*/allow-newer: *:base/' ${HOME}/.cabal/config for pkg in $($HCPKG list --simple-output); do pkg=$(echo $pkg | sed 's/-[^-]*$//'); sed -i "s/allow-newer: /allow-newer: *:$pkg, /" ${HOME}/.cabal/config; done echo 'repository head.hackage' >> ${HOME}/.cabal/config echo ' url: http://head.hackage.haskell.org/' >> ${HOME}/.cabal/config echo ' secure: True' >> ${HOME}/.cabal/config echo ' root-keys: 07c59cb65787dedfaef5bd5f987ceb5f7e5ebf88b904bbd4c5cbdeb2ff71b740' >> ${HOME}/.cabal/config echo ' 2e8555dde16ebd8df076f1a8ef13b8f14c66bad8eafefd7d9e37d0ed711821fb' >> ${HOME}/.cabal/config echo ' 8f79fd2389ab2967354407ec852cbe73f2e8635793ac446d09461ffb99527f6e' >> ${HOME}/.cabal/config echo ' key-threshold: 3' >> ${HOME}/.cabal.config grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$' cabal new-update head.hackage -v fi - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$' - "printf 'packages: \".\"\\n' > cabal.project" - touch cabal.project.local - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi" - cat cabal.project || true - cat cabal.project.local || true - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi - rm -f cabal.project.freeze - rm -rf .ghc.environment.* "."/dist - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) # Here starts the actual work to be performed for the package under test; # any command which exits with a non-zero exit code causes the build to fail. script: # test that source-distributions can be generated - (cd "." && cabal sdist) - mv "."/dist/reflection-*.tar.gz ${DISTDIR}/ - cd ${DISTDIR} || false - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \; - "printf 'packages: reflection-*/*.cabal\\n' > cabal.project" - touch cabal.project.local - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi" - cat cabal.project || true - cat cabal.project.local || true # build & run tests, build benchmarks - cabal new-build -w ${HC} ${TEST} ${BENCH} all # cabal check - (cd reflection-* && cabal check) # haddock - rm -rf ./dist-newstyle - if $HADDOCK; then cabal new-haddock -w ${HC} ${TEST} ${BENCH} all; else echo "Skipping haddock generation";fi # Build without installed constraints for packages in global-db - if $UNCONSTRAINED; then rm -f cabal.project.local; echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks all; else echo "Not building without installed constraints"; fi # REGENDATA ["-o",".travis.yml","--ghc-head","--jobs=2","--irc-channel=irc.freenode.org#haskell-lens","--no-no-tests-no-bench","--no-install-dependencies","cabal.project"] # EOF reflection-2.1.4/LICENSE0000644000000000000000000000305313316537060013050 0ustar0000000000000000Copyright (c) 2009-2013 Edward Kmett Copyright (c) 2004 Oleg Kiselyov and Chung-chieh Shan 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 Edward Kmett 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. reflection-2.1.4/fast/0000755000000000000000000000000013316537060012777 5ustar0000000000000000reflection-2.1.4/fast/Data/0000755000000000000000000000000013316537060013650 5ustar0000000000000000reflection-2.1.4/fast/Data/Reflection.hs0000644000000000000000000005501213316537060016301 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE ScopedTypeVariables #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeOperators #-} #define USE_TYPE_LITS 1 #endif #ifdef MIN_VERSION_template_haskell # if __GLASGOW_HASKELL__ >= 800 -- TH-subset that works with stage1 & unregisterised GHCs {-# LANGUAGE TemplateHaskellQuotes #-} # else {-# LANGUAGE TemplateHaskell #-} # endif #endif {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-cse #-} {-# OPTIONS_GHC -fno-full-laziness #-} {-# OPTIONS_GHC -fno-float-in #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-unused-binds #-} #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif ---------------------------------------------------------------------------- -- | -- Module : Data.Reflection -- Copyright : 2009-2015 Edward Kmett, -- 2012 Elliott Hird, -- 2004 Oleg Kiselyov and Chung-chieh Shan -- License : BSD3 -- -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- -- Reifies arbitrary terms at the type level. Based on the Functional -- Pearl: Implicit Configurations paper by Oleg Kiselyov and -- Chung-chieh Shan. -- -- -- -- The approach from the paper was modified to work with Data.Proxy -- and to cheat by using knowledge of GHC's internal representations -- by Edward Kmett and Elliott Hird. -- -- Usage comes down to two combinators, 'reify' and 'reflect'. -- -- >>> reify 6 (\p -> reflect p + reflect p) -- 12 -- -- The argument passed along by reify is just a @data 'Proxy' t = -- Proxy@, so all of the information needed to reconstruct your value -- has been moved to the type level. This enables it to be used when -- constructing instances (see @examples/Monoid.hs@). -- -- In addition, a simpler API is offered for working with singleton -- values such as a system configuration, etc. ------------------------------------------------------------------------------- module Data.Reflection ( -- * Reflection Reifies(..) , reify #if __GLASGOW_HASKELL__ >= 708 , reifyNat , reifySymbol #endif , reifyTypeable -- * Given , Given(..) , give #ifdef MIN_VERSION_template_haskell -- * Template Haskell reflection , int, nat #endif -- * Useful compile time naturals , Z, D, SD, PD -- * Reified Monoids , ReifiedMonoid(..) , ReflectedMonoid(..) , reifyMonoid , foldMapBy , foldBy -- * Reified Applicatives , ReifiedApplicative(..) , ReflectedApplicative(..) , reifyApplicative , traverseBy , sequenceBy ) where import Control.Applicative #ifdef MIN_VERSION_template_haskell import Control.Monad #endif import Data.Bits #if __GLASGOW_HASKELL__ < 710 import Data.Foldable #endif import Data.Semigroup as Sem import Data.Proxy #if __GLASGOW_HASKELL__ < 710 import Data.Traversable #endif import Data.Typeable import Data.Word import Foreign.Ptr import Foreign.StablePtr #if (__GLASGOW_HASKELL__ >= 707) || (defined(MIN_VERSION_template_haskell) && USE_TYPE_LITS) import GHC.TypeLits #endif #ifdef __HUGS__ import Hugs.IOExts #endif #ifdef MIN_VERSION_template_haskell import Language.Haskell.TH hiding (reify) #endif import System.IO.Unsafe #ifndef __HUGS__ import Unsafe.Coerce #endif #ifdef HLINT {-# ANN module "HLint: ignore Avoid lambda" #-} #endif ------------------------------------------------------------------------------ -- Reifies ------------------------------------------------------------------------------ class Reifies s a | s -> a where -- | Recover a value inside a 'reify' context, given a proxy for its -- reified type. reflect :: proxy s -> a newtype Magic a r = Magic (forall (s :: *). Reifies s a => Proxy s -> r) -- | Reify a value at the type level, to be recovered with 'reflect'. reify :: forall a r. a -> (forall (s :: *). Reifies s a => Proxy s -> r) -> r reify a k = unsafeCoerce (Magic k :: Magic a r) (const a) Proxy {-# INLINE reify #-} #if __GLASGOW_HASKELL__ >= 707 instance KnownNat n => Reifies n Integer where reflect = natVal instance KnownSymbol n => Reifies n String where reflect = symbolVal #endif #if __GLASGOW_HASKELL__ >= 708 -------------------------------------------------------------------------------- -- KnownNat -------------------------------------------------------------------------------- newtype MagicNat r = MagicNat (forall (n :: Nat). KnownNat n => Proxy n -> r) -- | This upgraded version of 'reify' can be used to generate a 'KnownNat' suitable for use with other APIs. -- -- /Available only on GHC 7.8+/ -- -- >>> reifyNat 4 natVal -- 4 -- -- >>> reifyNat 4 reflect -- 4 reifyNat :: forall r. Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r reifyNat n k = unsafeCoerce (MagicNat k :: MagicNat r) n Proxy -------------------------------------------------------------------------------- -- KnownSymbol -------------------------------------------------------------------------------- newtype MagicSymbol r = MagicSymbol (forall (n :: Symbol). KnownSymbol n => Proxy n -> r) -- | This upgraded version of 'reify' can be used to generate a 'KnownSymbol' suitable for use with other APIs. -- -- /Available only on GHC 7.8+/ -- -- >>> reifySymbol "hello" symbolVal -- "hello" -- -- >>> reifySymbol "hello" reflect -- "hello" reifySymbol :: forall r. String -> (forall (n :: Symbol). KnownSymbol n => Proxy n -> r) -> r reifySymbol n k = unsafeCoerce (MagicSymbol k :: MagicSymbol r) n Proxy #endif ------------------------------------------------------------------------------ -- Given ------------------------------------------------------------------------------ -- | This is a version of 'Reifies' that allows for only a single value. -- -- This is easier to work with than 'Reifies' and permits extended defaulting, -- but it only offers a single reflected value of a given type at a time. class Given a where -- | Recover the value of a given type previously encoded with 'give'. given :: a newtype Gift a r = Gift (Given a => r) -- | Reify a value into an instance to be recovered with 'given'. -- -- You should /only/ 'give' a single value for each type. If multiple instances -- are in scope, then the behavior is implementation defined. give :: forall a r. a -> (Given a => r) -> r give a k = unsafeCoerce (Gift k :: Gift a r) a {-# INLINE give #-} -------------------------------------------------------------------------------- -- Explicit Numeric Reflection -------------------------------------------------------------------------------- -- | 0 data Z -- | 2/n/ data D (n :: *) -- | 2/n/ + 1 data SD (n :: *) -- | 2/n/ - 1 data PD (n :: *) instance Reifies Z Int where reflect _ = 0 {-# INLINE reflect #-} retagD :: (Proxy n -> a) -> proxy (D n) -> a retagD f _ = f Proxy {-# INLINE retagD #-} retagSD :: (Proxy n -> a) -> proxy (SD n) -> a retagSD f _ = f Proxy {-# INLINE retagSD #-} retagPD :: (Proxy n -> a) -> proxy (PD n) -> a retagPD f _ = f Proxy {-# INLINE retagPD #-} instance Reifies n Int => Reifies (D n) Int where reflect = (\n -> n + n) `fmap` retagD reflect {-# INLINE reflect #-} instance Reifies n Int => Reifies (SD n) Int where reflect = (\n -> n + n + 1) `fmap` retagSD reflect {-# INLINE reflect #-} instance Reifies n Int => Reifies (PD n) Int where reflect = (\n -> n + n - 1) `fmap` retagPD reflect {-# INLINE reflect #-} #ifdef MIN_VERSION_template_haskell -- | This can be used to generate a template haskell splice for a type level version of a given 'int'. -- -- This does not use GHC TypeLits, instead it generates a numeric type by hand similar to the ones used -- in the \"Functional Pearl: Implicit Configurations\" paper by Oleg Kiselyov and Chung-Chieh Shan. -- -- @instance Num (Q Exp)@ provided in this package allows writing @$(3)@ -- instead of @$(int 3)@. Sometimes the two will produce the same -- representation (if compiled without the @-DUSE_TYPE_LITS@ preprocessor -- directive). int :: Int -> TypeQ int n = case quotRem n 2 of (0, 0) -> conT ''Z (q,-1) -> conT ''PD `appT` int q (q, 0) -> conT ''D `appT` int q (q, 1) -> conT ''SD `appT` int q _ -> error "ghc is bad at math" -- | This is a restricted version of 'int' that can only generate natural numbers. Attempting to generate -- a negative number results in a compile time error. Also the resulting sequence will consist entirely of -- Z, D, and SD constructors representing the number in zeroless binary. nat :: Int -> TypeQ nat n | n >= 0 = int n | otherwise = error "nat: negative" #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 704 instance Show (Q a) where show _ = "Q" instance Eq (Q a) where _ == _ = False #endif instance Num a => Num (Q a) where (+) = liftM2 (+) (*) = liftM2 (*) (-) = liftM2 (-) negate = fmap negate abs = fmap abs signum = fmap signum fromInteger = return . fromInteger instance Fractional a => Fractional (Q a) where (/) = liftM2 (/) recip = fmap recip fromRational = return . fromRational -- | This permits the use of $(5) as a type splice. instance Num Type where #ifdef USE_TYPE_LITS LitT (NumTyLit a) + LitT (NumTyLit b) = LitT (NumTyLit (a+b)) a + b = AppT (AppT (VarT ''(+)) a) b LitT (NumTyLit a) * LitT (NumTyLit b) = LitT (NumTyLit (a*b)) (*) a b = AppT (AppT (VarT ''(GHC.TypeLits.*)) a) b #if MIN_VERSION_base(4,8,0) a - b = AppT (AppT (VarT ''(-)) a) b #else (-) = error "Type.(-): undefined" #endif fromInteger = LitT . NumTyLit #else (+) = error "Type.(+): undefined" (*) = error "Type.(*): undefined" (-) = error "Type.(-): undefined" fromInteger n = case quotRem n 2 of (0, 0) -> ConT ''Z (q,-1) -> ConT ''PD `AppT` fromInteger q (q, 0) -> ConT ''D `AppT` fromInteger q (q, 1) -> ConT ''SD `AppT` fromInteger q _ -> error "ghc is bad at math" #endif abs = error "Type.abs" signum = error "Type.signum" onProxyType1 :: (Type -> Type) -> (Exp -> Exp) onProxyType1 f (SigE _ ta@(AppT (ConT proxyName) (VarT _))) | proxyName == ''Proxy = ConE 'Proxy `SigE` (ConT ''Proxy `AppT` f ta) onProxyType1 f a = LamE [SigP WildP na] body `AppE` a where body = ConE 'Proxy `SigE` (ConT ''Proxy `AppT` f na) na = VarT (mkName "na") onProxyType2 :: Name -> (Type -> Type -> Type) -> (Exp -> Exp -> Exp) onProxyType2 _fName f (SigE _ (AppT (ConT proxyName) ta)) (SigE _ (AppT (ConT proxyName') tb)) | proxyName == ''Proxy, proxyName' == ''Proxy = ConE 'Proxy `SigE` (ConT ''Proxy `AppT` f ta tb) -- the above case should only match for things like $(2 + 2) onProxyType2 fName _f a b = VarE fName `AppE` a `AppE` b -- | This permits the use of $(5) as an expression splice, -- which stands for @Proxy :: Proxy $(5)@ instance Num Exp where (+) = onProxyType2 'addProxy (+) (*) = onProxyType2 'mulProxy (*) (-) = onProxyType2 'subProxy (-) negate = onProxyType1 negate abs = onProxyType1 abs signum = onProxyType1 signum fromInteger n = ConE 'Proxy `SigE` (ConT ''Proxy `AppT` fromInteger n) #ifdef USE_TYPE_LITS addProxy :: Proxy a -> Proxy b -> Proxy (a + b) addProxy _ _ = Proxy mulProxy :: Proxy a -> Proxy b -> Proxy (a * b) mulProxy _ _ = Proxy #if MIN_VERSION_base(4,8,0) subProxy :: Proxy a -> Proxy b -> Proxy (a - b) subProxy _ _ = Proxy #else subProxy :: Proxy a -> Proxy b -> Proxy c subProxy _ _ = error "Exp.(-): undefined" #endif -- fromInteger = LitT . NumTyLit #else addProxy :: Proxy a -> Proxy b -> Proxy c addProxy _ _ = error "Exp.(+): undefined" mulProxy :: Proxy a -> Proxy b -> Proxy c mulProxy _ _ = error "Exp.(*): undefined" subProxy :: Proxy a -> Proxy b -> Proxy c subProxy _ _ = error "Exp.(-): undefined" #endif #endif -------------------------------------------------------------------------------- -- * Typeable Reflection -------------------------------------------------------------------------------- class Typeable s => B s where reflectByte :: proxy s -> IntPtr #define BYTES(GO) \ GO(T0,0) GO(T1,1) GO(T2,2) GO(T3,3) GO(T4,4) GO(T5,5) GO(T6,6) GO(T7,7) GO(T8,8) GO(T9,9) GO(T10,10) GO(T11,11) \ GO(T12,12) GO(T13,13) GO(T14,14) GO(T15,15) GO(T16,16) GO(T17,17) GO(T18,18) GO(T19,19) GO(T20,20) GO(T21,21) GO(T22,22) \ GO(T23,23) GO(T24,24) GO(T25,25) GO(T26,26) GO(T27,27) GO(T28,28) GO(T29,29) GO(T30,30) GO(T31,31) GO(T32,32) GO(T33,33) \ GO(T34,34) GO(T35,35) GO(T36,36) GO(T37,37) GO(T38,38) GO(T39,39) GO(T40,40) GO(T41,41) GO(T42,42) GO(T43,43) GO(T44,44) \ GO(T45,45) GO(T46,46) GO(T47,47) GO(T48,48) GO(T49,49) GO(T50,50) GO(T51,51) GO(T52,52) GO(T53,53) GO(T54,54) GO(T55,55) \ GO(T56,56) GO(T57,57) GO(T58,58) GO(T59,59) GO(T60,60) GO(T61,61) GO(T62,62) GO(T63,63) GO(T64,64) GO(T65,65) GO(T66,66) \ GO(T67,67) GO(T68,68) GO(T69,69) GO(T70,70) GO(T71,71) GO(T72,72) GO(T73,73) GO(T74,74) GO(T75,75) GO(T76,76) GO(T77,77) \ GO(T78,78) GO(T79,79) GO(T80,80) GO(T81,81) GO(T82,82) GO(T83,83) GO(T84,84) GO(T85,85) GO(T86,86) GO(T87,87) GO(T88,88) \ GO(T89,89) GO(T90,90) GO(T91,91) GO(T92,92) GO(T93,93) GO(T94,94) GO(T95,95) GO(T96,96) GO(T97,97) GO(T98,98) GO(T99,99) \ GO(T100,100) GO(T101,101) GO(T102,102) GO(T103,103) GO(T104,104) GO(T105,105) GO(T106,106) GO(T107,107) GO(T108,108) \ GO(T109,109) GO(T110,110) GO(T111,111) GO(T112,112) GO(T113,113) GO(T114,114) GO(T115,115) GO(T116,116) GO(T117,117) \ GO(T118,118) GO(T119,119) GO(T120,120) GO(T121,121) GO(T122,122) GO(T123,123) GO(T124,124) GO(T125,125) GO(T126,126) \ GO(T127,127) GO(T128,128) GO(T129,129) GO(T130,130) GO(T131,131) GO(T132,132) GO(T133,133) GO(T134,134) GO(T135,135) \ GO(T136,136) GO(T137,137) GO(T138,138) GO(T139,139) GO(T140,140) GO(T141,141) GO(T142,142) GO(T143,143) GO(T144,144) \ GO(T145,145) GO(T146,146) GO(T147,147) GO(T148,148) GO(T149,149) GO(T150,150) GO(T151,151) GO(T152,152) GO(T153,153) \ GO(T154,154) GO(T155,155) GO(T156,156) GO(T157,157) GO(T158,158) GO(T159,159) GO(T160,160) GO(T161,161) GO(T162,162) \ GO(T163,163) GO(T164,164) GO(T165,165) GO(T166,166) GO(T167,167) GO(T168,168) GO(T169,169) GO(T170,170) GO(T171,171) \ GO(T172,172) GO(T173,173) GO(T174,174) GO(T175,175) GO(T176,176) GO(T177,177) GO(T178,178) GO(T179,179) GO(T180,180) \ GO(T181,181) GO(T182,182) GO(T183,183) GO(T184,184) GO(T185,185) GO(T186,186) GO(T187,187) GO(T188,188) GO(T189,189) \ GO(T190,190) GO(T191,191) GO(T192,192) GO(T193,193) GO(T194,194) GO(T195,195) GO(T196,196) GO(T197,197) GO(T198,198) \ GO(T199,199) GO(T200,200) GO(T201,201) GO(T202,202) GO(T203,203) GO(T204,204) GO(T205,205) GO(T206,206) GO(T207,207) \ GO(T208,208) GO(T209,209) GO(T210,210) GO(T211,211) GO(T212,212) GO(T213,213) GO(T214,214) GO(T215,215) GO(T216,216) \ GO(T217,217) GO(T218,218) GO(T219,219) GO(T220,220) GO(T221,221) GO(T222,222) GO(T223,223) GO(T224,224) GO(T225,225) \ GO(T226,226) GO(T227,227) GO(T228,228) GO(T229,229) GO(T230,230) GO(T231,231) GO(T232,232) GO(T233,233) GO(T234,234) \ GO(T235,235) GO(T236,236) GO(T237,237) GO(T238,238) GO(T239,239) GO(T240,240) GO(T241,241) GO(T242,242) GO(T243,243) \ GO(T244,244) GO(T245,245) GO(T246,246) GO(T247,247) GO(T248,248) GO(T249,249) GO(T250,250) GO(T251,251) GO(T252,252) \ GO(T253,253) GO(T254,254) GO(T255,255) #define GO(Tn,n) \ newtype Tn = Tn Tn deriving Typeable; \ instance B Tn where { \ reflectByte _ = n \ }; BYTES(GO) #undef GO impossible :: a impossible = error "Data.Reflection.reifyByte: impossible" reifyByte :: Word8 -> (forall (s :: *). B s => Proxy s -> r) -> r reifyByte w k = case w of { #define GO(Tn,n) n -> k (Proxy :: Proxy Tn); BYTES(GO) #undef GO _ -> impossible } newtype W (b0 :: *) (b1 :: *) (b2 :: *) (b3 :: *) = W (W b0 b1 b2 b3) deriving Typeable newtype Stable (w0 :: *) (w1 :: *) (a :: *) = Stable (Stable w0 w1 a) deriving Typeable stable :: p b0 -> p b1 -> p b2 -> p b3 -> p b4 -> p b5 -> p b6 -> p b7 -> Proxy (Stable (W b0 b1 b2 b3) (W b4 b5 b6 b7) a) stable _ _ _ _ _ _ _ _ = Proxy {-# INLINE stable #-} stablePtrToIntPtr :: StablePtr a -> IntPtr stablePtrToIntPtr = ptrToIntPtr . castStablePtrToPtr {-# INLINE stablePtrToIntPtr #-} intPtrToStablePtr :: IntPtr -> StablePtr a intPtrToStablePtr = castPtrToStablePtr . intPtrToPtr {-# INLINE intPtrToStablePtr #-} byte0 :: p (Stable (W b0 b1 b2 b3) w1 a) -> Proxy b0 byte0 _ = Proxy byte1 :: p (Stable (W b0 b1 b2 b3) w1 a) -> Proxy b1 byte1 _ = Proxy byte2 :: p (Stable (W b0 b1 b2 b3) w1 a) -> Proxy b2 byte2 _ = Proxy byte3 :: p (Stable (W b0 b1 b2 b3) w1 a) -> Proxy b3 byte3 _ = Proxy byte4 :: p (Stable w0 (W b4 b5 b6 b7) a) -> Proxy b4 byte4 _ = Proxy byte5 :: p (Stable w0 (W b4 b5 b6 b7) a) -> Proxy b5 byte5 _ = Proxy byte6 :: p (Stable w0 (W b4 b5 b6 b7) a) -> Proxy b6 byte6 _ = Proxy byte7 :: p (Stable w0 (W b4 b5 b6 b7) a) -> Proxy b7 byte7 _ = Proxy argument :: (p s -> r) -> Proxy s argument _ = Proxy instance (B b0, B b1, B b2, B b3, B b4, B b5, B b6, B b7, w0 ~ W b0 b1 b2 b3, w1 ~ W b4 b5 b6 b7) => Reifies (Stable w0 w1 a) a where reflect = r where r = unsafePerformIO $ const <$> deRefStablePtr p <* freeStablePtr p s = argument r p = intPtrToStablePtr $ reflectByte (byte0 s) .|. (reflectByte (byte1 s) `shiftL` 8) .|. (reflectByte (byte2 s) `shiftL` 16) .|. (reflectByte (byte3 s) `shiftL` 24) .|. (reflectByte (byte4 s) `shiftL` 32) .|. (reflectByte (byte5 s) `shiftL` 40) .|. (reflectByte (byte6 s) `shiftL` 48) .|. (reflectByte (byte7 s) `shiftL` 56) {-# NOINLINE reflect #-} -- This had to be moved to the top level, due to an apparent bug in -- the ghc inliner introduced in ghc 7.0.x reflectBefore :: forall (proxy :: * -> *) s b. (Proxy s -> b) -> proxy s -> b reflectBefore f = const $! f Proxy {-# NOINLINE reflectBefore #-} -- | Reify a value at the type level in a 'Typeable'-compatible fashion, to be recovered with 'reflect'. -- -- This can be necessary to work around the changes to @Data.Typeable@ in GHC HEAD. reifyTypeable :: Typeable a => a -> (forall (s :: *). (Typeable s, Reifies s a) => Proxy s -> r) -> r #if MIN_VERSION_base(4,4,0) reifyTypeable a k = unsafeDupablePerformIO $ do #else reifyTypeable a k = unsafePerformIO $ do #endif p <- newStablePtr a let n = stablePtrToIntPtr p reifyByte (fromIntegral n) (\s0 -> reifyByte (fromIntegral (n `shiftR` 8)) (\s1 -> reifyByte (fromIntegral (n `shiftR` 16)) (\s2 -> reifyByte (fromIntegral (n `shiftR` 24)) (\s3 -> reifyByte (fromIntegral (n `shiftR` 32)) (\s4 -> reifyByte (fromIntegral (n `shiftR` 40)) (\s5 -> reifyByte (fromIntegral (n `shiftR` 48)) (\s6 -> reifyByte (fromIntegral (n `shiftR` 56)) (\s7 -> reflectBefore (fmap return k) $ stable s0 s1 s2 s3 s4 s5 s6 s7)))))))) data ReifiedMonoid a = ReifiedMonoid { reifiedMappend :: a -> a -> a, reifiedMempty :: a } instance Reifies s (ReifiedMonoid a) => Sem.Semigroup (ReflectedMonoid a s) where ReflectedMonoid x <> ReflectedMonoid y = reflectResult (\m -> ReflectedMonoid (reifiedMappend m x y)) instance Reifies s (ReifiedMonoid a) => Monoid (ReflectedMonoid a s) where #if !(MIN_VERSION_base(4,11,0)) mappend = (<>) #endif mempty = reflectResult (\m -> ReflectedMonoid (reifiedMempty m )) reflectResult :: forall f s a. Reifies s a => (a -> f s) -> f s reflectResult f = f (reflect (Proxy :: Proxy s)) newtype ReflectedMonoid a s = ReflectedMonoid a unreflectedMonoid :: ReflectedMonoid a s -> proxy s -> a unreflectedMonoid (ReflectedMonoid a) _ = a reifyMonoid :: (a -> a -> a) -> a -> (forall (s :: *). Reifies s (ReifiedMonoid a) => t -> ReflectedMonoid a s) -> t -> a reifyMonoid f z m xs = reify (ReifiedMonoid f z) (unreflectedMonoid (m xs)) -- | Fold a value using its 'Foldable' instance using -- explicitly provided 'Monoid' operations. This is like 'fold' -- where the 'Monoid' instance can be manually specified. -- -- @ -- 'foldBy' 'mappend' 'mempty' ≡ 'fold' -- @ -- -- >>> foldBy (++) [] ["hello","world"] -- "helloworld" foldBy :: Foldable t => (a -> a -> a) -> a -> t a -> a foldBy f z = reifyMonoid f z (foldMap ReflectedMonoid) -- | Fold a value using its 'Foldable' instance using -- explicitly provided 'Monoid' operations. This is like 'foldMap' -- where the 'Monoid' instance can be manually specified. -- -- @ -- 'foldMapBy' 'mappend' 'mempty' ≡ 'foldMap' -- @ -- -- >>> foldMapBy (+) 0 length ["hello","world"] -- 10 foldMapBy :: Foldable t => (r -> r -> r) -> r -> (a -> r) -> t a -> r foldMapBy f z g = reifyMonoid f z (foldMap (ReflectedMonoid #. g)) data ReifiedApplicative f = ReifiedApplicative { reifiedPure :: forall a. a -> f a, reifiedAp :: forall a b. f (a -> b) -> f a -> f b } newtype ReflectedApplicative f s a = ReflectedApplicative (f a) instance Reifies s (ReifiedApplicative f) => Functor (ReflectedApplicative f s) where fmap = liftA instance Reifies s (ReifiedApplicative f) => Applicative (ReflectedApplicative f s) where pure a = reflectResult1 (\m -> ReflectedApplicative (reifiedPure m a)) ReflectedApplicative x <*> ReflectedApplicative y = reflectResult1 (\m -> ReflectedApplicative (reifiedAp m x y)) reflectResult1 :: forall f s a b. Reifies s a => (a -> f s b) -> f s b reflectResult1 f = f (reflect (Proxy :: Proxy s)) unreflectedApplicative :: ReflectedApplicative f s a -> proxy s -> f a unreflectedApplicative (ReflectedApplicative a) _ = a reifyApplicative :: (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> (forall (s :: *). Reifies s (ReifiedApplicative f) => t -> ReflectedApplicative f s a) -> t -> f a reifyApplicative f g m xs = reify (ReifiedApplicative f g) (unreflectedApplicative (m xs)) -- | Traverse a container using its 'Traversable' instance using -- explicitly provided 'Applicative' operations. This is like 'traverse' -- where the 'Applicative' instance can be manually specified. traverseBy :: Traversable t => (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> (a -> f b) -> t a -> f (t b) traverseBy pur app f = reifyApplicative pur app (traverse (ReflectedApplicative #. f)) -- | Sequence a container using its 'Traversable' instance using -- explicitly provided 'Applicative' operations. This is like 'sequence' -- where the 'Applicative' instance can be manually specified. sequenceBy :: Traversable t => (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> t (f a) -> f (t a) sequenceBy pur app = reifyApplicative pur app (traverse ReflectedApplicative) (#.) :: (b -> c) -> (a -> b) -> a -> c (#.) _ = unsafeCoerce reflection-2.1.4/slow/0000755000000000000000000000000013316537060013026 5ustar0000000000000000reflection-2.1.4/slow/Data/0000755000000000000000000000000013316537060013677 5ustar0000000000000000reflection-2.1.4/slow/Data/Reflection.hs0000644000000000000000000001622113316537060016327 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE Rank2Types #-} {-# OPTIONS_GHC -fno-cse #-} {-# OPTIONS_GHC -fno-full-laziness #-} {-# OPTIONS_GHC -fno-float-in #-} {-# OPTIONS_GHC -fno-warn-unused-binds #-} ---------------------------------------------------------------------------- -- | -- Module : Data.Reflection -- Copyright : 2009-2012 Edward Kmett, -- 2012 Elliott Hird, -- 2004 Oleg Kiselyov and Chung-chieh Shan -- License : BSD3 -- -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- -- Reifies arbitrary terms at the type level. Based on the Functional -- Pearl: Implicit Configurations paper by Oleg Kiselyov and -- Chung-chieh Shan. -- -- -- -- The approach from the paper was modified to work with Data.Proxy -- and streamline the API by Edward Kmett and Elliott Hird. -- -- Usage comes down to two combinators, 'reify' and 'reflect'. -- -- >>> reify 6 (\p -> reflect p + reflect p) -- 12 -- -- The argument passed along by reify is just a @data 'Proxy' t = -- Proxy@, so all of the information needed to reconstruct your value -- has been moved to the type level. This enables it to be used when -- constructing instances (see @examples/Monoid.hs@). ------------------------------------------------------------------------------- module Data.Reflection ( Reifies(..) , reify ) where import Foreign.Ptr import Foreign.StablePtr import System.IO.Unsafe import Control.Applicative import Data.Proxy import Data.Bits import Data.Word #ifdef __HUGS__ #define unsafeDupablePerformIO unsafePerformIO #endif class B s where reflectByte :: proxy s -> IntPtr #define CAT(a,b) a/**/b #define BYTES(GO) \ GO(0) GO(1) GO(2) GO(3) GO(4) GO(5) GO(6) GO(7) GO(8) GO(9) GO(10) GO(11) \ GO(12) GO(13) GO(14) GO(15) GO(16) GO(17) GO(18) GO(19) GO(20) GO(21) GO(22) \ GO(23) GO(24) GO(25) GO(26) GO(27) GO(28) GO(29) GO(30) GO(31) GO(32) GO(33) \ GO(34) GO(35) GO(36) GO(37) GO(38) GO(39) GO(40) GO(41) GO(42) GO(43) GO(44) \ GO(45) GO(46) GO(47) GO(48) GO(49) GO(50) GO(51) GO(52) GO(53) GO(54) GO(55) \ GO(56) GO(57) GO(58) GO(59) GO(60) GO(61) GO(62) GO(63) GO(64) GO(65) GO(66) \ GO(67) GO(68) GO(69) GO(70) GO(71) GO(72) GO(73) GO(74) GO(75) GO(76) GO(77) \ GO(78) GO(79) GO(80) GO(81) GO(82) GO(83) GO(84) GO(85) GO(86) GO(87) GO(88) \ GO(89) GO(90) GO(91) GO(92) GO(93) GO(94) GO(95) GO(96) GO(97) GO(98) GO(99) \ GO(100) GO(101) GO(102) GO(103) GO(104) GO(105) GO(106) GO(107) GO(108) \ GO(109) GO(110) GO(111) GO(112) GO(113) GO(114) GO(115) GO(116) GO(117) \ GO(118) GO(119) GO(120) GO(121) GO(122) GO(123) GO(124) GO(125) GO(126) \ GO(127) GO(128) GO(129) GO(130) GO(131) GO(132) GO(133) GO(134) GO(135) \ GO(136) GO(137) GO(138) GO(139) GO(140) GO(141) GO(142) GO(143) GO(144) \ GO(145) GO(146) GO(147) GO(148) GO(149) GO(150) GO(151) GO(152) GO(153) \ GO(154) GO(155) GO(156) GO(157) GO(158) GO(159) GO(160) GO(161) GO(162) \ GO(163) GO(164) GO(165) GO(166) GO(167) GO(168) GO(169) GO(170) GO(171) \ GO(172) GO(173) GO(174) GO(175) GO(176) GO(177) GO(178) GO(179) GO(180) \ GO(181) GO(182) GO(183) GO(184) GO(185) GO(186) GO(187) GO(188) GO(189) \ GO(190) GO(191) GO(192) GO(193) GO(194) GO(195) GO(196) GO(197) GO(198) \ GO(199) GO(200) GO(201) GO(202) GO(203) GO(204) GO(205) GO(206) GO(207) \ GO(208) GO(209) GO(210) GO(211) GO(212) GO(213) GO(214) GO(215) GO(216) \ GO(217) GO(218) GO(219) GO(220) GO(221) GO(222) GO(223) GO(224) GO(225) \ GO(226) GO(227) GO(228) GO(229) GO(230) GO(231) GO(232) GO(233) GO(234) \ GO(235) GO(236) GO(237) GO(238) GO(239) GO(240) GO(241) GO(242) GO(243) \ GO(244) GO(245) GO(246) GO(247) GO(248) GO(249) GO(250) GO(251) GO(252) \ GO(253) GO(254) GO(255) #define GO(n) \ newtype CAT(T,n) = CAT(T,n) CAT(T,n); \ instance B CAT(T,n) where { \ reflectByte _ = n \ }; BYTES(GO) #undef GO impossible :: a impossible = error "Data.Reflection.reifyByte: impossible" reifyByte :: Word8 -> (forall s. B s => Proxy s -> r) -> r reifyByte w k = case w of { #define GO(n) n -> k (Proxy :: Proxy CAT(T,n)); BYTES(GO) #undef GO _ -> impossible } class Reifies s a | s -> a where -- | Recover a value inside a 'reify' context, given a proxy for its -- reified type. reflect :: proxy s -> a newtype Stable b0 b1 b2 b3 b4 b5 b6 b7 a = Stable (Stable b0 b1 b2 b3 b4 b5 b6 b7 a) stable :: p b0 -> p b1 -> p b2 -> p b3 -> p b4 -> p b5 -> p b6 -> p b7 -> Proxy (Stable b0 b1 b2 b3 b4 b5 b6 b7 a) stable _ _ _ _ _ _ _ _ = Proxy {-# INLINE stable #-} stablePtrToIntPtr :: StablePtr a -> IntPtr stablePtrToIntPtr = ptrToIntPtr . castStablePtrToPtr {-# INLINE stablePtrToIntPtr #-} intPtrToStablePtr :: IntPtr -> StablePtr a intPtrToStablePtr = castPtrToStablePtr . intPtrToPtr {-# INLINE intPtrToStablePtr #-} byte0 :: p (Stable b0 b1 b2 b3 b4 b5 b6 b7 a) -> Proxy b0 byte0 _ = Proxy byte1 :: p (Stable b0 b1 b2 b3 b4 b5 b6 b7 a) -> Proxy b1 byte1 _ = Proxy byte2 :: p (Stable b0 b1 b2 b3 b4 b5 b6 b7 a) -> Proxy b2 byte2 _ = Proxy byte3 :: p (Stable b0 b1 b2 b3 b4 b5 b6 b7 a) -> Proxy b3 byte3 _ = Proxy byte4 :: p (Stable b0 b1 b2 b3 b4 b5 b6 b7 a) -> Proxy b4 byte4 _ = Proxy byte5 :: p (Stable b0 b1 b2 b3 b4 b5 b6 b7 a) -> Proxy b5 byte5 _ = Proxy byte6 :: p (Stable b0 b1 b2 b3 b4 b5 b6 b7 a) -> Proxy b6 byte6 _ = Proxy byte7 :: p (Stable b0 b1 b2 b3 b4 b5 b6 b7 a) -> Proxy b7 byte7 _ = Proxy argument :: (p s -> r) -> Proxy s argument _ = Proxy instance (B b0, B b1, B b2, B b3, B b4, B b5, B b6, B b7) => Reifies (Stable b0 b1 b2 b3 b4 b5 b6 b7 a) a where reflect = r where r = unsafePerformIO $ const <$> deRefStablePtr p <* freeStablePtr p s = argument r p = intPtrToStablePtr $ reflectByte (byte0 s) .|. (reflectByte (byte1 s) `shiftL` 8) .|. (reflectByte (byte2 s) `shiftL` 16) .|. (reflectByte (byte3 s) `shiftL` 24) .|. (reflectByte (byte4 s) `shiftL` 32) .|. (reflectByte (byte5 s) `shiftL` 40) .|. (reflectByte (byte6 s) `shiftL` 48) .|. (reflectByte (byte7 s) `shiftL` 56) {-# NOINLINE reflect #-} -- This had to be moved to the top level, due to an apparent bug in -- the ghc inliner introduced in ghc 7.0.x reflectBefore :: Reifies s a => (Proxy s -> b) -> proxy s -> b reflectBefore f = const $! f Proxy {-# NOINLINE reflectBefore #-} -- | Reify a value at the type level, to be recovered with 'reflect'. reify :: a -> (forall s. (Reifies s a) => Proxy s -> r) -> r reify a k = unsafeDupablePerformIO $ do p <- newStablePtr a let n = stablePtrToIntPtr p reifyByte (fromIntegral n) (\s0 -> reifyByte (fromIntegral (n `shiftR` 8)) (\s1 -> reifyByte (fromIntegral (n `shiftR` 16)) (\s2 -> reifyByte (fromIntegral (n `shiftR` 24)) (\s3 -> reifyByte (fromIntegral (n `shiftR` 32)) (\s4 -> reifyByte (fromIntegral (n `shiftR` 40)) (\s5 -> reifyByte (fromIntegral (n `shiftR` 48)) (\s6 -> reifyByte (fromIntegral (n `shiftR` 56)) (\s7 -> reflectBefore (fmap return k) $ stable s0 s1 s2 s3 s4 s5 s6 s7)))))))) reflection-2.1.4/examples/0000755000000000000000000000000013316537060013660 5ustar0000000000000000reflection-2.1.4/examples/reflection-examples.cabal0000644000000000000000000000420513316537060020613 0ustar0000000000000000name: reflection-examples version: 0.1 license: BSD3 license-file: LICENSE author: Edward A. Kmett, Elliott Hird, Oleg Kiselyov and Chung-chieh Shan maintainer: Edward A. Kmett stability: experimental homepage: http://github.com/ekmett/reflection bug-reports: http://github.com/ekmett/reflection/issues category: Data, Reflection, Dependent Types synopsis: Examples of reflection description: Examples of reflection. copyright: 2009-2013 Edward A. Kmett, 2012 Elliott Hird, 2004 Oleg Kiselyov and Chung-chieh Shan build-type: Simple cabal-version: >= 1.10 tested-with: GHC == 7.0.4 , GHC == 7.2.2 , GHC == 7.4.2 , GHC == 7.6.3 , GHC == 7.8.4 , GHC == 7.10.3 , GHC == 8.0.2 , GHC == 8.2.2 , GHC == 8.4.3 , GHC == 8.6.1 flag examples default: True library if !flag(examples) buildable: False exposed-modules: Constraints Monoid build-depends: base >= 4.8 && < 5, constraints, newtype, reflection, tagged hs-source-dirs: . ghc-options: -Wall default-language: Haskell2010 executable reflection-from-json if !flag(examples) buildable: False main-is: FromJSON.hs build-depends: aeson, base >= 4.8 && < 5, lens, lens-aeson, reflection, tagged, text hs-source-dirs: . ghc-options: -Wall -threaded -rtsopts default-language: Haskell2010 executable reflection-reader-like if !flag(examples) buildable: False main-is: ReaderLike.hs build-depends: base >= 4.8 && < 5, reflection, tagged hs-source-dirs: . ghc-options: -Wall -threaded -rtsopts default-language: Haskell2010 reflection-2.1.4/examples/FromJSON.hs0000644000000000000000000000446113316537060015616 0ustar0000000000000000-- Example of a dynamically generated FromJSON instance. -- -- Can be useful when one needs to use a function with a -- FromJSON constraint, but some detail about the -- conversion from JSON is not known until runtime. {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-} import Data.Reflection -- from reflection import Data.Monoid -- from base import Data.Proxy -- from tagged import Data.Text -- from text import Data.Monoid import Data.Aeson -- from aeson import Data.Aeson.Types (Parser) import Control.Applicative -- These imports are only for constructing the example value import Control.Lens (preview) -- from lens import Data.Aeson.Lens (_Value,_String) -- form lens-aeson data Foo = Foo { field1 :: Int , field2 :: Int } deriving (Show) fooParser :: Text -> Object -> Parser Foo fooParser prefix o = do Foo <$> o .: (prefix <> "field1") <*> o .: (prefix <> "field2") -- A wrapper over Foo carrying a phantom type s newtype J a s = J { runJ :: a } -- If the phantom type s reifies the parsing function, we can -- use reflect to recover the function and implement -- our FromJSON instance for J. instance Reifies s (Object -> Parser a) => FromJSON (J a s) where parseJSON (Object v) = J <$> reflect (Proxy :: Proxy s) v -- Convince the compiler that the phantom type in the proxy -- supplied by reify is the same as the phantom type in J. -- -- Otherwise the FromJSON instance for J won't kick in. asProxyJ :: Proxy s -> J a s -> J a s asProxyJ _ = id exampleJSON :: Value exampleJSON = maybe Null id (preview _Value str) where str = "{ \"zzfield1\" : 5, \"zzfield2\" : 7 }"::Text main :: IO () main = do putStrLn "Enter prefix for the fields: " -- "zz" must be entered for the parse to succeed prefix <- fmap pack getLine -- fromJSON uses the dynamically generated FromJSON instance let result = reify (fooParser prefix) $ \proxy -> -- We must eliminate the J newtype before returning -- because, thanks to parametricity, -- the phantom type cannot escape the callback. runJ . asProxyJ proxy <$> fromJSON exampleJSON putStrLn (show (result :: Result Foo)) reflection-2.1.4/examples/Constraints.hs0000644000000000000000000000524413316537060016530 0ustar0000000000000000{-# LANGUAGE Rank2Types, TypeFamilies, TypeOperators, ConstraintKinds, PolyKinds, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, FlexibleContexts, UndecidableInstances #-} module Constraints where import Control.Newtype -- from newtype import Data.Constraint -- from constraints import Data.Constraint.Unsafe -- from constraints import Data.Monoid -- from base import Data.Proxy -- from tagged import Data.Reflection -- from reflection -- | Values in our dynamically constructed monoid over 'a' newtype Lift (p :: * -> Constraint) (a :: *) (s :: *) = Lift { lower :: a } class ReifiableConstraint p where data Def (p :: * -> Constraint) (a :: *) reifiedIns :: Reifies s (Def p a) :- p (Lift p a s) instance Newtype (Lift p a s) a where pack = Lift unpack = lower -- > ghci> with (Monoid (+) 0) $ mempty <> Lift 2 -- > 2 with :: Def p a -> (forall s. Reifies s (Def p a) => Lift p a s) -> a with d v = reify d $ lower . asProxyOf v reifyInstance :: Def p a -> (forall (s :: *). Reifies s (Def p a) => Proxy s -> r) -> r reifyInstance = reify asProxyOf :: f s -> Proxy s -> f s asProxyOf a _ = a -- > using (Monoid (+) 0) $ mappend mempty 12 -- > 12 using :: forall p a. ReifiableConstraint p => Def p a -> (p a => a) -> a using d m = reify d $ \(_ :: Proxy s) -> m \\ trans (unsafeCoerceConstraint :: (p (Lift p a s) :- p a)) reifiedIns usingT :: forall p f a. ReifiableConstraint p => Def p a -> (p a => f a) -> f a usingT d m = reify d $ \(_ :: Proxy s) -> m \\ trans (unsafeCoerceConstraint :: (p (Lift p a s) :- p a)) reifiedIns instance ReifiableConstraint Monoid where data Def Monoid a = Monoid { mappend_ :: a -> a -> a, mempty_ :: a } reifiedIns = Sub Dict instance Reifies s (Def Monoid a) => Monoid (Lift Monoid a s) where mappend a b = Lift $ mappend_ (reflect a) (lower a) (lower b) mempty = a where a = Lift $ mempty_ (reflect a) data ClassProxy (p :: * -> Constraint) = ClassProxy given :: ClassProxy c -> p s -> a -> Lift c a s given _ _ = Lift eq :: ClassProxy Eq eq = ClassProxy ord :: ClassProxy Ord ord = ClassProxy monoid :: ClassProxy Monoid monoid = ClassProxy instance ReifiableConstraint Eq where data Def Eq a = Eq { eq_ :: a -> a -> Bool } reifiedIns = Sub Dict instance Reifies s (Def Eq a) => Eq (Lift Eq a s) where a == b = eq_ (reflect a) (lower a) (lower b) instance ReifiableConstraint Ord where data Def Ord a = Ord { compare_ :: a -> a -> Ordering } reifiedIns = Sub Dict instance Reifies s (Def Ord a) => Eq (Lift Ord a s) where a == b = compare a b == EQ instance Reifies s (Def Ord a) => Ord (Lift Ord a s) where compare a b = compare_ (reflect a) (lower a) (lower b) reflection-2.1.4/examples/Benchmark.hs0000644000000000000000000000054213316537060016107 0ustar0000000000000000import Criterion.Main import qualified Data.Reflection as Old import qualified Data.NewReflection as New old :: [Int] -> [Int] old = map (\x -> Old.reify x Old.reflect) new :: [Int] -> [Int] new = map (\x -> New.reify x New.reflect) main :: IO () main = defaultMain [ bench "old" $ nf old [1..100000] , bench "new" $ nf new [1..100000] ] reflection-2.1.4/examples/ReaderLike.hs0000644000000000000000000000361713316537060016232 0ustar0000000000000000-- The UndecidableInstances here is benign, just for the "advanced" -- example at the end. {-# LANGUAGE FlexibleContexts, ScopedTypeVariables, UndecidableInstances #-} -- I don't demonstrate the advantages over implicit parameters here, -- like multiple reifications of the same thing coexisting in -- different, statically-checked contexts, etc.; this is intended as a -- comparison to Reader(T). import Data.Proxy import Data.Reflection import Control.Applicative import System.IO data MyConfig = MyConfig { magic :: Bool , volume :: Integer } data Report p = Report { magicality :: String , loud :: Bool } deriving (Show) -- some arbitrary thing we do calculations with newtype Datum p = Datum Integer deriving (Read, Show) report :: forall p. (Reifies p MyConfig) => Report p report = Report { magicality = if magic conf then "Magical." else "Not so magical..." , loud = volume conf >= 11 } where conf = reflect (Proxy :: Proxy p) calculate :: forall p. (Reifies p MyConfig) => Datum p -> Datum p -> Datum p calculate (Datum m) (Datum n) = Datum ((m+n) * volume conf) where conf = reflect (Proxy :: Proxy p) run :: forall p. (Reifies p MyConfig) => Proxy p -> IO () run p = do d1 <- ask "Datum 1:" :: IO (Datum p) d2 <- ask "Datum 2:" :: IO (Datum p) -- look ma, no plumbing print $ calculate d1 (calculate d2 d1) print (report :: Report p) ask :: Read s => String -> IO s ask prompt = do putStr prompt putChar ' ' hFlush stdout readLn main :: IO () main = do conf <- MyConfig <$> ask "Magic?" <*> ask "Volume:" reify conf run -- If you're feeling adventurous, here is something we could not do -- with ReaderT: instance Reifies p MyConfig => Num (Datum p) where (+) = calculate m * n | magic conf = m + n | otherwise = Datum 0 -- sorry, no magic for you. where conf = reflect (Proxy :: Proxy p) abs = undefined signum = undefined fromInteger = Datum reflection-2.1.4/examples/LICENSE0000644000000000000000000000305313316537060014666 0ustar0000000000000000Copyright (c) 2009-2013 Edward Kmett Copyright (c) 2004 Oleg Kiselyov and Chung-chieh Shan 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 Edward Kmett 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. reflection-2.1.4/examples/Monoid.hs0000644000000000000000000000202713316537060015442 0ustar0000000000000000{-# LANGUAGE CPP, Rank2Types, FlexibleContexts, UndecidableInstances #-} module Monoid where import Data.Reflection -- from reflection import Data.Semigroup -- from base import Data.Proxy -- from tagged -- | Values in our dynamically-constructed 'Monoid' over 'a' newtype M a s = M { runM :: a } deriving (Eq,Ord) -- | A dictionary describing a 'Monoid' data Monoid_ a = Monoid_ { mappend_ :: a -> a -> a, mempty_ :: a } instance Reifies s (Monoid_ a) => Semigroup (M a s) where a <> b = M $ mappend_ (reflect a) (runM a) (runM b) instance Reifies s (Monoid_ a) => Monoid (M a s) where #if !(MIN_VERSION_base(4,11,0)) mappend = (<>) #endif mempty = a where a = M $ mempty_ (reflect a) -- Construct a 'Monoid' instance out of a binary operation and unit that you have in scope! -- -- > ghci> withMonoid (+) 0 $ mempty <> M 2 -- > 2 withMonoid :: (a -> a -> a) -> a -> (forall s. Reifies s (Monoid_ a) => M a s) -> a withMonoid f z v = reify (Monoid_ f z) (runM . asProxyOf v) asProxyOf :: f s -> Proxy s -> f s asProxyOf a _ = a