Merge branch 'android-rebuild'
This commit is contained in:
commit
78e90130c3
83 changed files with 4042 additions and 6862 deletions
|
@ -294,6 +294,8 @@ expandExpressionSplice s lls = concat [before, spliced:padding, end]
|
|||
{- Tweaks code output by GHC in splices to actually build. Yipes. -}
|
||||
mangleCode :: String -> String
|
||||
mangleCode = flip_colon
|
||||
. remove_unnecessary_type_signatures
|
||||
. lambdaparenhack
|
||||
. lambdaparens
|
||||
. declaration_parens
|
||||
. case_layout
|
||||
|
@ -331,6 +333,12 @@ mangleCode = flip_colon
|
|||
preindent <- many1 $ oneOf " \n"
|
||||
string "\\ "
|
||||
lambdaparams <- restofline
|
||||
continuedlambdaparams <- many $ try $ do
|
||||
indent <- many1 $ char ' '
|
||||
p <- satisfy isLetter
|
||||
aram <- many $ satisfy isAlphaNum <|> oneOf "_"
|
||||
newline
|
||||
return $ indent ++ p:aram ++ "\n"
|
||||
indent <- many1 $ char ' '
|
||||
string "-> "
|
||||
firstline <- restofline
|
||||
|
@ -342,10 +350,46 @@ mangleCode = flip_colon
|
|||
return $ concat
|
||||
[ prefix:preindent
|
||||
, "(\\ " ++ lambdaparams ++ "\n"
|
||||
, concat continuedlambdaparams
|
||||
, indent ++ "-> "
|
||||
, lambdaparens $ intercalate "\n" (firstline:lambdalines)
|
||||
, ")\n"
|
||||
]
|
||||
|
||||
{- Hack to add missing parens in a specific case in yesod
|
||||
- static route code.
|
||||
-
|
||||
- StaticR
|
||||
- yesod_dispatch_env_a4iDV
|
||||
- (\ p_a4iE2 r_a4iE3
|
||||
- -> r_a4iE3 {Network.Wai.pathInfo = p_a4iE2}
|
||||
- xrest_a4iDT req_a4iDW)) }
|
||||
-
|
||||
- Need to add another paren around the lambda, and close it
|
||||
- before its parameters. lambdaparens misses this one because
|
||||
- there is already one paren present.
|
||||
-
|
||||
- FIXME: This is a hack. lambdaparens could just always add a
|
||||
- layer of parens even when a lambda seems to be in parent.
|
||||
-}
|
||||
lambdaparenhack = parsecAndReplace $ do
|
||||
indent <- many1 $ char ' '
|
||||
staticr <- string "StaticR"
|
||||
newline
|
||||
string indent
|
||||
yesod_dispatch_env <- restofline
|
||||
string indent
|
||||
lambdaprefix <- string "(\\ "
|
||||
l1 <- restofline
|
||||
string indent
|
||||
lambdaarrow <- string " ->"
|
||||
l2 <- restofline
|
||||
return $ unlines
|
||||
[ indent ++ staticr
|
||||
, indent ++ yesod_dispatch_env
|
||||
, indent ++ "(" ++ lambdaprefix ++ l1
|
||||
, indent ++ lambdaarrow ++ l2 ++ ")"
|
||||
]
|
||||
|
||||
restofline = manyTill (noneOf "\n") newline
|
||||
|
||||
|
@ -439,6 +483,19 @@ mangleCode = flip_colon
|
|||
- declarations. -}
|
||||
declaration_parens = replace "StaticR Route Static" "StaticR (Route Static)"
|
||||
|
||||
{- A type signature is sometimes given for an entire lambda,
|
||||
- which is not properly parenthesized or laid out. This is a
|
||||
- hack to remove one specific case where this happens and the
|
||||
- signature is easily inferred, so is just removed.
|
||||
-}
|
||||
remove_unnecessary_type_signatures = parsecAndReplace $ do
|
||||
string " ::"
|
||||
newline
|
||||
many1 $ char ' '
|
||||
string "Text.Css.Block Text.Css.Resolved"
|
||||
newline
|
||||
return ""
|
||||
|
||||
{- GHC may add full package and version qualifications for
|
||||
- symbols from unimported modules. We don't want these.
|
||||
-
|
||||
|
|
8
Creds.hs
8
Creds.hs
|
@ -16,10 +16,9 @@ import Crypto
|
|||
import Types.Remote (RemoteConfig, RemoteConfigKey)
|
||||
import Remote.Helper.Encryptable (remoteCipher, embedCreds)
|
||||
#ifndef mingw32_HOST_OS
|
||||
import Utility.Env (setEnv)
|
||||
import Utility.Env (setEnv, getEnv)
|
||||
#endif
|
||||
|
||||
import System.Environment
|
||||
import qualified Data.ByteString.Lazy.Char8 as L
|
||||
import qualified Data.Map as M
|
||||
import Utility.Base64
|
||||
|
@ -101,11 +100,10 @@ getRemoteCredPair c storage = maybe fromcache (return . Just) =<< fromenv
|
|||
{- Gets a CredPair from the environment. -}
|
||||
getEnvCredPair :: CredPairStorage -> IO (Maybe CredPair)
|
||||
getEnvCredPair storage = liftM2 (,)
|
||||
<$> get uenv
|
||||
<*> get penv
|
||||
<$> getEnv uenv
|
||||
<*> getEnv penv
|
||||
where
|
||||
(uenv, penv) = credPairEnvironment storage
|
||||
get = catchMaybeIO . getEnv
|
||||
|
||||
{- Stores a CredPair in the environment. -}
|
||||
setEnvCredPair :: CredPair -> CredPairStorage -> IO ()
|
||||
|
|
8
Makefile
8
Makefile
|
@ -160,12 +160,12 @@ osxapp: Build/Standalone Build/OSXMkLibs
|
|||
rm -f tmp/git-annex.dmg.bz2
|
||||
bzip2 --fast tmp/git-annex.dmg
|
||||
|
||||
ANDROID_FLAGS?=
|
||||
ANDROID_FLAGS?=-f-XMPP
|
||||
# Cross compile for Android.
|
||||
# Uses https://github.com/neurocyte/ghc-android
|
||||
android: Build/EvilSplicer
|
||||
echo "Running native build, to get TH splices.."
|
||||
if [ ! -e dist/setup/setup ]; then $(CABAL) configure -f"-Production $(ANDROID_FLAGS)" -O0; fi
|
||||
if [ ! -e dist/setup/setup ]; then $(CABAL) configure -f-Production -O0 $(ANDROID_FLAGS); fi
|
||||
mkdir -p tmp
|
||||
if ! $(CABAL) build --ghc-options=-ddump-splices 2> tmp/dump-splices; then tail tmp/dump-splices >&2; exit 1; fi
|
||||
echo "Setting up Android build tree.."
|
||||
|
@ -183,9 +183,9 @@ android: Build/EvilSplicer
|
|||
# Cabal cannot cross compile with custom build type, so workaround.
|
||||
sed -i 's/Build-type: Custom/Build-type: Simple/' tmp/androidtree/git-annex.cabal
|
||||
if [ ! -e tmp/androidtree/dist/setup/setup ]; then \
|
||||
cd tmp/androidtree && $$HOME/.ghc/android-14/arm-linux-androideabi-4.7/arm-linux-androideabi/bin/cabal configure -f"Android $(ANDROID_FLAGS)"; \
|
||||
cd tmp/androidtree && $$HOME/.ghc/android-14/arm-linux-androideabi-4.7/arm-linux-androideabi/bin/cabal configure -fAndroid $(ANDROID_FLAGS); \
|
||||
fi
|
||||
cd tmp/androidtree && $(CABAL) build
|
||||
cd tmp/androidtree && $$HOME/.ghc/android-14/arm-linux-androideabi-4.7/arm-linux-androideabi/bin/cabal build
|
||||
|
||||
adb:
|
||||
ANDROID_FLAGS="-Production" $(MAKE) android
|
||||
|
|
2
debian/changelog
vendored
2
debian/changelog
vendored
|
@ -3,6 +3,8 @@ git-annex (4.20130921) UNRELEASED; urgency=low
|
|||
* Use cryptohash rather than SHA for hashing when no external hash program
|
||||
is available. This is a significant speedup for SHA256 on OSX, for
|
||||
example.
|
||||
* Android build redone from scratch, many dependencies updated,
|
||||
and entire build can now be done using provided scripts.
|
||||
|
||||
-- Joey Hess <joeyh@debian.org> Sun, 22 Sep 2013 19:42:29 -0400
|
||||
|
||||
|
|
|
@ -19,14 +19,14 @@ of Bath CS department.
|
|||
|
||||
## building it yourself
|
||||
|
||||
git-annex can be built for Android, with `make android`. It's not an easy
|
||||
process:
|
||||
git-annex can be built from source for Android.
|
||||
|
||||
* First, install <https://github.com/neurocyte/ghc-android>.
|
||||
* You will need to have the Android SDK and NDK installed; see
|
||||
`standalone/android/Makefile` to configure the paths to them. You'll also
|
||||
need ant, and the JDK.
|
||||
* In `standalone/android/`, run `install-haskell-packages native`
|
||||
* You also need to install git and all the utilities listed on [[fromscratch]],
|
||||
on the system doing the building.
|
||||
* Then to build the full Android app bundle, use `make androidapp`
|
||||
1. Run `standalone/android/buildchroot` as root (requires debootstrap).
|
||||
This builds a chroot with an `androidbuilder` user.
|
||||
The rest of the build will run in this chroot as that user.
|
||||
2. Then run `standalone/android/install-haskell-packages`
|
||||
Note that this will break from time to time as new versions of packages
|
||||
are released, and the patches it applies have to be updated when
|
||||
this happens.
|
||||
3. Finally, once the chroot is set up, you can build an Android binary
|
||||
with `make android`, and `make androidapp` will build the complete APK.
|
||||
|
|
|
@ -133,8 +133,12 @@ Executable git-annex
|
|||
CPP-Options: -DWITH_FSEVENTS
|
||||
else
|
||||
if (! os(windows) && ! os(solaris) && ! os(linux))
|
||||
CPP-Options: -DWITH_KQUEUE
|
||||
C-Sources: Utility/libkqueue.c
|
||||
if flag(Android)
|
||||
Build-Depends: hinotify
|
||||
CPP-Options: -DWITH_INOTIFY
|
||||
else
|
||||
CPP-Options: -DWITH_KQUEUE
|
||||
C-Sources: Utility/libkqueue.c
|
||||
|
||||
if os(linux) && flag(Dbus)
|
||||
Build-Depends: dbus (>= 0.10.3)
|
||||
|
|
|
@ -2,22 +2,21 @@
|
|||
# and builds the Android app.
|
||||
|
||||
# Add Android cross-compiler to PATH (as installed by ghc-android)
|
||||
# (This directory also needs to have a cc that is a symlink to the prefixed
|
||||
# gcc cross-compiler executable.)
|
||||
ANDROID_CROSS_COMPILER?=$(HOME)/.ghc/android-14/arm-linux-androideabi-4.7/bin
|
||||
PATH:=$(ANDROID_CROSS_COMPILER):$(PATH)
|
||||
|
||||
# Paths to the Android SDK and NDK.
|
||||
export ANDROID_SDK_ROOT?=$(HOME)/tmp/adt-bundle-linux-x86/sdk
|
||||
export ANDROID_NDK_ROOT?=$(HOME)/tmp/android-ndk-r8d
|
||||
export ANDROID_SDK_ROOT?=$(HOME)/adt-bundle-linux-x86/sdk
|
||||
export ANDROID_NDK_ROOT?=$(HOME)/android-ndk
|
||||
|
||||
# Where to store the source tree used to build utilities. This
|
||||
# directory will be created by `make source`.
|
||||
GIT_ANNEX_ANDROID_SOURCETREE?=$(HOME)/tmp/android-sourcetree
|
||||
GIT_ANNEX_ANDROID_SOURCETREE?=$(HOME)/android-sourcetree
|
||||
|
||||
GITTREE=$(GIT_ANNEX_ANDROID_SOURCETREE)/git/installed-tree
|
||||
|
||||
build: start
|
||||
if [ ! -e "$(GIT_ANNEX_ANDROID_SOURCETREE)" ]; then $(MAKE) source; fi
|
||||
$(MAKE) $(GIT_ANNEX_ANDROID_SOURCETREE)/openssl/build-stamp
|
||||
$(MAKE) $(GIT_ANNEX_ANDROID_SOURCETREE)/openssh/build-stamp
|
||||
$(MAKE) $(GIT_ANNEX_ANDROID_SOURCETREE)/busybox/build-stamp
|
||||
|
@ -85,7 +84,9 @@ $(GIT_ANNEX_ANDROID_SOURCETREE)/openssl/build-stamp:
|
|||
touch $@
|
||||
|
||||
$(GIT_ANNEX_ANDROID_SOURCETREE)/openssh/build-stamp: openssh.patch openssh.config.h
|
||||
cd $(GIT_ANNEX_ANDROID_SOURCETREE)/openssh && git reset --hard
|
||||
# This is a known-good version that the patch works with.
|
||||
# TODO: Upgrade
|
||||
cd $(GIT_ANNEX_ANDROID_SOURCETREE)/openssh && git reset --hard 0a8617ed5af2f0248d0e9648e26b224e16ada742
|
||||
cd $(GIT_ANNEX_ANDROID_SOURCETREE)/openssh && ./configure --host=arm-linux-androideabi --with-ssl-dir=../openssl --without-openssl-header-check
|
||||
cat openssh.patch | (cd $(GIT_ANNEX_ANDROID_SOURCETREE)/openssh && patch -p1)
|
||||
cp openssh.config.h $(GIT_ANNEX_ANDROID_SOURCETREE)/openssh/config.h
|
||||
|
@ -105,7 +106,8 @@ $(GIT_ANNEX_ANDROID_SOURCETREE)/git/build-stamp:
|
|||
touch $@
|
||||
|
||||
$(GIT_ANNEX_ANDROID_SOURCETREE)/rsync/build-stamp: rsync.patch
|
||||
cat rsync.patch | (cd $(GIT_ANNEX_ANDROID_SOURCETREE)/rsync && git reset --hard origin/master && git am)
|
||||
# This is a known-good version that the patch works with.
|
||||
cat rsync.patch | (cd $(GIT_ANNEX_ANDROID_SOURCETREE)/rsync && git reset --hard eec26089b1c7bdbb260674480ffe6ece257bca63 && git am)
|
||||
cp $(GIT_ANNEX_ANDROID_SOURCETREE)/automake/lib/config.sub $(GIT_ANNEX_ANDROID_SOURCETREE)/automake/lib/config.guess $(GIT_ANNEX_ANDROID_SOURCETREE)/rsync/
|
||||
cd $(GIT_ANNEX_ANDROID_SOURCETREE)/rsync && ./configure --host=arm-linux-androideabi --disable-locale --disable-iconv-open --disable-iconv --disable-acl-support --disable-xattr-support
|
||||
cd $(GIT_ANNEX_ANDROID_SOURCETREE)/rsync && $(MAKE)
|
||||
|
@ -119,7 +121,8 @@ $(GIT_ANNEX_ANDROID_SOURCETREE)/gnupg/build-stamp:
|
|||
touch $@
|
||||
|
||||
$(GIT_ANNEX_ANDROID_SOURCETREE)/term/build-stamp: term.patch icons
|
||||
cd $(GIT_ANNEX_ANDROID_SOURCETREE)/term && git reset --hard
|
||||
# This is a known-good version that the patch works with.
|
||||
cd $(GIT_ANNEX_ANDROID_SOURCETREE)/term && git reset --hard 3d34b3c42295c215b62e70f3ee696dd664ba08ce
|
||||
cat term.patch | (cd $(GIT_ANNEX_ANDROID_SOURCETREE)/term && patch -p1)
|
||||
(cd icons && tar c .) | (cd $(GIT_ANNEX_ANDROID_SOURCETREE)/term/res && tar x)
|
||||
# This renaming has a purpose. It makes the path to the app's
|
||||
|
@ -129,21 +132,21 @@ $(GIT_ANNEX_ANDROID_SOURCETREE)/term/build-stamp: term.patch icons
|
|||
# app, if it's also installed.
|
||||
cd $(GIT_ANNEX_ANDROID_SOURCETREE)/term && find -name .git -prune -o -type f -print0 | xargs -0 perl -pi -e 's/jackpal/ga/g'
|
||||
cd $(GIT_ANNEX_ANDROID_SOURCETREE)/term && perl -pi -e 's/Terminal Emulator/Git Annex/g' res/*/strings.xml
|
||||
cd $(GIT_ANNEX_ANDROID_SOURCETREE)/term && tools/update.sh >/dev/null 2>&1
|
||||
cd $(GIT_ANNEX_ANDROID_SOURCETREE)/term && echo y | tools/update.sh
|
||||
touch $@
|
||||
|
||||
source: $(GIT_ANNEX_ANDROID_SOURCETREE)
|
||||
|
||||
$(GIT_ANNEX_ANDROID_SOURCETREE):
|
||||
mkdir -p $(GIT_ANNEX_ANDROID_SOURCETREE)
|
||||
git clone --bare git://git.savannah.gnu.org/automake.git $(GIT_ANNEX_ANDROID_SOURCETREE)/automake
|
||||
git clone --bare git://git.debian.org/git/d-i/busybox $(GIT_ANNEX_ANDROID_SOURCETREE)/busybox
|
||||
git clone --bare git://git.kernel.org/pub/scm/git/git.git $(GIT_ANNEX_ANDROID_SOURCETREE)/git
|
||||
git clone --bare git://git.samba.org/rsync.git $(GIT_ANNEX_ANDROID_SOURCETREE)/rsync
|
||||
git clone --bare git://git.gnupg.org/gnupg.git $(GIT_ANNEX_ANDROID_SOURCETREE)/gnupg
|
||||
git clone --bare git://git.openssl.org/openssl $(GIT_ANNEX_ANDROID_SOURCETREE)/openssl
|
||||
git clone --bare git://github.com/CyanogenMod/android_external_openssh.git $(GIT_ANNEX_ANDROID_SOURCETREE)/openssh
|
||||
git clone --bare git://github.com/jackpal/Android-Terminal-Emulator.git $(GIT_ANNEX_ANDROID_SOURCETREE)/term
|
||||
git clone git://git.savannah.gnu.org/automake.git $(GIT_ANNEX_ANDROID_SOURCETREE)/automake
|
||||
git clone git://git.debian.org/git/d-i/busybox $(GIT_ANNEX_ANDROID_SOURCETREE)/busybox
|
||||
git clone git://git.kernel.org/pub/scm/git/git.git $(GIT_ANNEX_ANDROID_SOURCETREE)/git
|
||||
git clone git://git.samba.org/rsync.git $(GIT_ANNEX_ANDROID_SOURCETREE)/rsync
|
||||
git clone git://git.gnupg.org/gnupg.git $(GIT_ANNEX_ANDROID_SOURCETREE)/gnupg
|
||||
git clone git://git.openssl.org/openssl $(GIT_ANNEX_ANDROID_SOURCETREE)/openssl
|
||||
git clone git://github.com/CyanogenMod/android_external_openssh.git $(GIT_ANNEX_ANDROID_SOURCETREE)/openssh
|
||||
git clone git://github.com/jackpal/Android-Terminal-Emulator.git $(GIT_ANNEX_ANDROID_SOURCETREE)/term
|
||||
|
||||
clean:
|
||||
rm -rf $(GITTREE)
|
||||
|
|
26
standalone/android/buildchroot
Executable file
26
standalone/android/buildchroot
Executable file
|
@ -0,0 +1,26 @@
|
|||
#!/bin/sh
|
||||
set -e
|
||||
if [ "$(whoami)" != root ]; then
|
||||
echo "Must run this as root!" >&2
|
||||
exit 1
|
||||
fi
|
||||
|
||||
debootstrap --arch=i386 stable debian-stable-android
|
||||
cp $0-inchroot debian-stable-android/tmp
|
||||
cp $0-inchroot-asuser debian-stable-android/tmp
|
||||
|
||||
# Don't use these vars in the chroot.
|
||||
unset TMP
|
||||
unset TEMP
|
||||
unset TMPDIR
|
||||
unset TEMPDIR
|
||||
|
||||
chroot debian-stable-android "tmp/$(basename $0)-inchroot"
|
||||
|
||||
echo
|
||||
echo
|
||||
echo "debian-stable-android is set up, with a user androidbuilder"
|
||||
echo "your next step is probably to check out git-annex in this chroot"
|
||||
echo "and run standalone/android/install-haskell-packages"
|
||||
echo
|
||||
echo
|
25
standalone/android/buildchroot-inchroot
Executable file
25
standalone/android/buildchroot-inchroot
Executable file
|
@ -0,0 +1,25 @@
|
|||
#!/bin/sh
|
||||
# Runs inside the chroot set up by buildchroot
|
||||
set -e
|
||||
if [ "$(whoami)" != root ]; then
|
||||
echo "Must run this as root!" >&2
|
||||
exit 1
|
||||
fi
|
||||
|
||||
# java needs this mounted to work
|
||||
mount -t proc proc /proc
|
||||
|
||||
echo "deb-src http://ftp.us.debian.org/debian stable main" >> /etc/apt/sources.list
|
||||
apt-get update
|
||||
apt-get -y install build-essential ghc git libncurses5-dev cabal-install
|
||||
apt-get -y install llvm-3.0 # not 3.1; buggy on arm. 3.2 is ok too
|
||||
apt-get -y install ca-certificates curl file m4 autoconf zlib1g-dev
|
||||
apt-get -y install libgnutls-dev libxml2-dev libgsasl7-dev pkg-config c2hs
|
||||
apt-get -y install ant default-jdk rsync wget gnupg lsof
|
||||
apt-get -y install gettext unzip
|
||||
apt-get clean
|
||||
wget http://snapshot.debian.org/archive/debian/20130903T155330Z/pool/main/a/automake-1.14/automake_1.14-1_all.deb
|
||||
dpkg -i automake*.deb
|
||||
rm *.deb
|
||||
useradd androidbuilder --create-home
|
||||
su androidbuilder -c $0-asuser
|
36
standalone/android/buildchroot-inchroot-asuser
Executable file
36
standalone/android/buildchroot-inchroot-asuser
Executable file
|
@ -0,0 +1,36 @@
|
|||
#!/bin/sh
|
||||
# Runs inside the chroot set up by buildchroot, as the user it creates
|
||||
set -e
|
||||
|
||||
cd
|
||||
rm -rf .ghc .cabal
|
||||
cabal update
|
||||
cabal install happy alex --bindir=$HOME/bin
|
||||
PATH=$HOME/bin:$PATH
|
||||
export PATH
|
||||
git clone https://github.com/joeyh/ghc-android
|
||||
cd ghc-android
|
||||
git checkout stable-ghc-snapshot
|
||||
./build
|
||||
|
||||
# This saves 2 gb, and the same sources are in build-*/ghc
|
||||
rm -rf stage0
|
||||
|
||||
# Set up android SDK where the git-annex android Makefile
|
||||
# expects to find it.
|
||||
cd ..
|
||||
ln -s ghc-android/android-ndk-* android-ndk
|
||||
wget http://dl.google.com/android/adt/adt-bundle-linux-x86-20130917.zip
|
||||
unzip adt*.zip
|
||||
rm adt*.zip
|
||||
mv adt-bundle-linux-x86-* adt-bundle-linux-x86
|
||||
rm -rf adt-bundle-linux-x86/eclipse
|
||||
|
||||
# The git-annex android Makefile needs this cc symlink.
|
||||
ln -s arm-linux-androideabi-gcc \
|
||||
$HOME/.ghc/android-14/arm-linux-androideabi-4.7/bin/cc
|
||||
|
||||
git clone git://git-annex.branchable.com/ git-annex
|
||||
|
||||
git config --global user.email androidbuilder@example.com
|
||||
git config --global user.name androidbuilder
|
6
standalone/android/clean-haskell-packages
Executable file
6
standalone/android/clean-haskell-packages
Executable file
|
@ -0,0 +1,6 @@
|
|||
#!/bin/sh
|
||||
# Removes all currently installed cross-compiled haskell packages
|
||||
# except those part of ghc.
|
||||
# Useful if the build failed.
|
||||
rm -f $(grep -l $HOME/.ghc/android-14/arm-linux-androideabi-4.7/.cabal/lib/ $HOME/.ghc/android-14/arm-linux-androideabi-4.7/lib/*-ghc-*/package.conf.d/*.conf)
|
||||
$HOME/.ghc/android-14/arm-linux-androideabi-4.7/arm-linux-androideabi/bin/ghc-pkg recache
|
|
@ -6,6 +6,7 @@
|
|||
- ** DO NOT COMMIT **
|
||||
-}
|
||||
import qualified Data.Monoid
|
||||
import qualified Data.Set
|
||||
import qualified Data.Map
|
||||
import qualified Data.Map as Data.Map.Base
|
||||
import qualified Data.Foldable
|
||||
|
@ -16,12 +17,16 @@ import qualified Text.Hamlet
|
|||
import qualified Text.Julius
|
||||
import qualified Text.Css
|
||||
import qualified "blaze-markup" Text.Blaze.Internal
|
||||
import qualified Yesod.Widget
|
||||
import qualified Yesod.Core.Widget
|
||||
import qualified Yesod.Routes.TH.Types
|
||||
import qualified Yesod.Routes.Dispatch
|
||||
import qualified WaiAppStatic.Storage.Embedded
|
||||
import qualified WaiAppStatic.Storage.Embedded.Runtime
|
||||
import qualified Data.FileEmbed
|
||||
import qualified Data.ByteString.Internal
|
||||
import qualified Data.Text.Encoding
|
||||
import qualified Network.Wai
|
||||
import qualified Yesod.Core.Types
|
||||
{- End EvilSplicer headers. -}
|
||||
|
||||
|
||||
|
|
|
@ -1,306 +0,0 @@
|
|||
From d195f807dac2351d29aeff00d2aee3e151eb82e3 Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Thu, 18 Apr 2013 19:37:28 -0400
|
||||
Subject: [PATCH] build without TH
|
||||
|
||||
Used the EvilSplicer to expand the TH
|
||||
|
||||
Left off CmdArgs to save time.
|
||||
---
|
||||
DAV.cabal | 20 +----
|
||||
Network/Protocol/HTTP/DAV.hs | 53 ++++++++++---
|
||||
Network/Protocol/HTTP/DAV/TH.hs | 167 ++++++++++++++++++++++++++++++++++++++-
|
||||
3 files changed, 207 insertions(+), 33 deletions(-)
|
||||
|
||||
diff --git a/DAV.cabal b/DAV.cabal
|
||||
index 774d4e5..8b85133 100644
|
||||
--- a/DAV.cabal
|
||||
+++ b/DAV.cabal
|
||||
@@ -38,25 +38,7 @@ library
|
||||
, transformers >= 0.3
|
||||
, xml-conduit >= 1.0 && <= 1.1
|
||||
, xml-hamlet >= 0.4 && <= 0.5
|
||||
-executable hdav
|
||||
- main-is: hdav.hs
|
||||
- ghc-options: -Wall
|
||||
- build-depends: base >= 4.5 && <= 5
|
||||
- , bytestring
|
||||
- , bytestring
|
||||
- , case-insensitive >= 0.4
|
||||
- , cmdargs >= 0.9
|
||||
- , containers
|
||||
- , http-conduit >= 1.4
|
||||
- , http-types >= 0.7
|
||||
- , lens >= 3.0
|
||||
- , lifted-base >= 0.1
|
||||
- , mtl >= 2.1
|
||||
- , network >= 2.3
|
||||
- , resourcet >= 0.3
|
||||
- , transformers >= 0.3
|
||||
- , xml-conduit >= 1.0 && <= 1.1
|
||||
- , xml-hamlet >= 0.4 && <= 0.5
|
||||
+ , text
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
diff --git a/Network/Protocol/HTTP/DAV.hs b/Network/Protocol/HTTP/DAV.hs
|
||||
index 02e5d15..c0be362 100644
|
||||
--- a/Network/Protocol/HTTP/DAV.hs
|
||||
+++ b/Network/Protocol/HTTP/DAV.hs
|
||||
@@ -52,7 +52,8 @@ import Network.HTTP.Types (hContentType, Method, Status, RequestHeaders, unautho
|
||||
|
||||
import qualified Text.XML as XML
|
||||
import Text.XML.Cursor (($/), (&/), element, node, fromDocument, checkName)
|
||||
-import Text.Hamlet.XML (xml)
|
||||
+import Text.Hamlet.XML
|
||||
+import qualified Data.Text
|
||||
|
||||
import Data.CaseInsensitive (mk)
|
||||
|
||||
@@ -246,18 +247,48 @@ makeCollection url username password = withDS url username password $
|
||||
propname :: XML.Document
|
||||
propname = XML.Document (XML.Prologue [] Nothing []) root []
|
||||
where
|
||||
- root = XML.Element "D:propfind" (Map.fromList [("xmlns:D", "DAV:")]) [xml|
|
||||
-<D:allprop>
|
||||
-|]
|
||||
+ root = XML.Element "D:propfind" (Map.fromList [("xmlns:D", "DAV:")]) $ concat
|
||||
+ [[XML.NodeElement
|
||||
+ (XML.Element
|
||||
+ (XML.Name
|
||||
+ (Data.Text.pack "D:allprop") Nothing Nothing)
|
||||
+ Map.empty
|
||||
+ (concat []))]]
|
||||
+
|
||||
|
||||
locky :: XML.Document
|
||||
locky = XML.Document (XML.Prologue [] Nothing []) root []
|
||||
where
|
||||
- root = XML.Element "D:lockinfo" (Map.fromList [("xmlns:D", "DAV:")]) [xml|
|
||||
-<D:lockscope>
|
||||
- <D:exclusive>
|
||||
-<D:locktype>
|
||||
- <D:write>
|
||||
-<D:owner>Haskell DAV user
|
||||
-|]
|
||||
+ root = XML.Element "D:lockinfo" (Map.fromList [("xmlns:D", "DAV:")]) $ concat
|
||||
+ [[XML.NodeElement
|
||||
+ (XML.Element
|
||||
+ (XML.Name
|
||||
+ (Data.Text.pack "D:lockscope") Nothing Nothing)
|
||||
+ Map.empty
|
||||
+ (concat
|
||||
+ [[XML.NodeElement
|
||||
+ (XML.Element
|
||||
+ (XML.Name
|
||||
+ (Data.Text.pack "D:exclusive") Nothing Nothing)
|
||||
+ Map.empty
|
||||
+ (concat []))]]))],
|
||||
+ [XML.NodeElement
|
||||
+ (XML.Element
|
||||
+ (XML.Name
|
||||
+ (Data.Text.pack "D:locktype") Nothing Nothing)
|
||||
+ Map.empty
|
||||
+ (concat
|
||||
+ [[XML.NodeElement
|
||||
+ (XML.Element
|
||||
+ (XML.Name (Data.Text.pack "D:write") Nothing Nothing)
|
||||
+ Map.empty
|
||||
+ (concat []))]]))],
|
||||
+ [XML.NodeElement
|
||||
+ (XML.Element
|
||||
+ (XML.Name (Data.Text.pack "D:owner") Nothing Nothing)
|
||||
+ Map.empty
|
||||
+ (concat
|
||||
+ [[XML.NodeContent
|
||||
+ (Data.Text.pack "Haskell DAV user")]]))]]
|
||||
+
|
||||
|
||||
diff --git a/Network/Protocol/HTTP/DAV/TH.hs b/Network/Protocol/HTTP/DAV/TH.hs
|
||||
index 036a2bc..4d3c0f4 100644
|
||||
--- a/Network/Protocol/HTTP/DAV/TH.hs
|
||||
+++ b/Network/Protocol/HTTP/DAV/TH.hs
|
||||
@@ -16,11 +16,13 @@
|
||||
-- You should have received a copy of the GNU General Public License
|
||||
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
-{-# LANGUAGE TemplateHaskell #-}
|
||||
+{-# LANGUAGE RankNTypes #-}
|
||||
|
||||
module Network.Protocol.HTTP.DAV.TH where
|
||||
|
||||
-import Control.Lens (makeLenses)
|
||||
+import Control.Lens
|
||||
+import qualified Control.Lens.Type
|
||||
+import qualified Data.Functor
|
||||
import qualified Data.ByteString as B
|
||||
import Network.HTTP.Conduit (Manager, Request)
|
||||
|
||||
@@ -33,4 +35,163 @@ data DAVContext a = DAVContext {
|
||||
, _basicusername :: B.ByteString
|
||||
, _basicpassword :: B.ByteString
|
||||
}
|
||||
-makeLenses ''DAVContext
|
||||
+allowedMethods ::
|
||||
+ forall a_a4Oo.
|
||||
+ Control.Lens.Type.Lens' (DAVContext a_a4Oo) [B.ByteString]
|
||||
+allowedMethods
|
||||
+ _f_a5tt
|
||||
+ (DAVContext __allowedMethods'_a5tu
|
||||
+ __baseRequest_a5tw
|
||||
+ __complianceClasses_a5tx
|
||||
+ __httpManager_a5ty
|
||||
+ __lockToken_a5tz
|
||||
+ __basicusername_a5tA
|
||||
+ __basicpassword_a5tB)
|
||||
+ = ((\ __allowedMethods_a5tv
|
||||
+ -> DAVContext
|
||||
+ __allowedMethods_a5tv
|
||||
+ __baseRequest_a5tw
|
||||
+ __complianceClasses_a5tx
|
||||
+ __httpManager_a5ty
|
||||
+ __lockToken_a5tz
|
||||
+ __basicusername_a5tA
|
||||
+ __basicpassword_a5tB)
|
||||
+ Data.Functor.<$> (_f_a5tt __allowedMethods'_a5tu))
|
||||
+{-# INLINE allowedMethods #-}
|
||||
+baseRequest ::
|
||||
+ forall a_a4Oo a_a5tC.
|
||||
+ Control.Lens.Type.Lens (DAVContext a_a4Oo) (DAVContext a_a5tC) (Request a_a4Oo) (Request a_a5tC)
|
||||
+baseRequest
|
||||
+ _f_a5tD
|
||||
+ (DAVContext __allowedMethods_a5tE
|
||||
+ __baseRequest'_a5tF
|
||||
+ __complianceClasses_a5tH
|
||||
+ __httpManager_a5tI
|
||||
+ __lockToken_a5tJ
|
||||
+ __basicusername_a5tK
|
||||
+ __basicpassword_a5tL)
|
||||
+ = ((\ __baseRequest_a5tG
|
||||
+ -> DAVContext
|
||||
+ __allowedMethods_a5tE
|
||||
+ __baseRequest_a5tG
|
||||
+ __complianceClasses_a5tH
|
||||
+ __httpManager_a5tI
|
||||
+ __lockToken_a5tJ
|
||||
+ __basicusername_a5tK
|
||||
+ __basicpassword_a5tL)
|
||||
+ Data.Functor.<$> (_f_a5tD __baseRequest'_a5tF))
|
||||
+{-# INLINE baseRequest #-}
|
||||
+basicpassword ::
|
||||
+ forall a_a4Oo.
|
||||
+ Control.Lens.Type.Lens' (DAVContext a_a4Oo) B.ByteString
|
||||
+basicpassword
|
||||
+ _f_a5tM
|
||||
+ (DAVContext __allowedMethods_a5tN
|
||||
+ __baseRequest_a5tO
|
||||
+ __complianceClasses_a5tP
|
||||
+ __httpManager_a5tQ
|
||||
+ __lockToken_a5tR
|
||||
+ __basicusername_a5tS
|
||||
+ __basicpassword'_a5tT)
|
||||
+ = ((\ __basicpassword_a5tU
|
||||
+ -> DAVContext
|
||||
+ __allowedMethods_a5tN
|
||||
+ __baseRequest_a5tO
|
||||
+ __complianceClasses_a5tP
|
||||
+ __httpManager_a5tQ
|
||||
+ __lockToken_a5tR
|
||||
+ __basicusername_a5tS
|
||||
+ __basicpassword_a5tU)
|
||||
+ Data.Functor.<$> (_f_a5tM __basicpassword'_a5tT))
|
||||
+{-# INLINE basicpassword #-}
|
||||
+basicusername ::
|
||||
+ forall a_a4Oo.
|
||||
+ Control.Lens.Type.Lens' (DAVContext a_a4Oo) B.ByteString
|
||||
+basicusername
|
||||
+ _f_a5tV
|
||||
+ (DAVContext __allowedMethods_a5tW
|
||||
+ __baseRequest_a5tX
|
||||
+ __complianceClasses_a5tY
|
||||
+ __httpManager_a5tZ
|
||||
+ __lockToken_a5u0
|
||||
+ __basicusername'_a5u1
|
||||
+ __basicpassword_a5u3)
|
||||
+ = ((\ __basicusername_a5u2
|
||||
+ -> DAVContext
|
||||
+ __allowedMethods_a5tW
|
||||
+ __baseRequest_a5tX
|
||||
+ __complianceClasses_a5tY
|
||||
+ __httpManager_a5tZ
|
||||
+ __lockToken_a5u0
|
||||
+ __basicusername_a5u2
|
||||
+ __basicpassword_a5u3)
|
||||
+ Data.Functor.<$> (_f_a5tV __basicusername'_a5u1))
|
||||
+{-# INLINE basicusername #-}
|
||||
+complianceClasses ::
|
||||
+ forall a_a4Oo.
|
||||
+ Control.Lens.Type.Lens' (DAVContext a_a4Oo) [B.ByteString]
|
||||
+complianceClasses
|
||||
+ _f_a5u4
|
||||
+ (DAVContext __allowedMethods_a5u5
|
||||
+ __baseRequest_a5u6
|
||||
+ __complianceClasses'_a5u7
|
||||
+ __httpManager_a5u9
|
||||
+ __lockToken_a5ua
|
||||
+ __basicusername_a5ub
|
||||
+ __basicpassword_a5uc)
|
||||
+ = ((\ __complianceClasses_a5u8
|
||||
+ -> DAVContext
|
||||
+ __allowedMethods_a5u5
|
||||
+ __baseRequest_a5u6
|
||||
+ __complianceClasses_a5u8
|
||||
+ __httpManager_a5u9
|
||||
+ __lockToken_a5ua
|
||||
+ __basicusername_a5ub
|
||||
+ __basicpassword_a5uc)
|
||||
+ Data.Functor.<$> (_f_a5u4 __complianceClasses'_a5u7))
|
||||
+{-# INLINE complianceClasses #-}
|
||||
+httpManager ::
|
||||
+ forall a_a4Oo. Control.Lens.Type.Lens' (DAVContext a_a4Oo) Manager
|
||||
+httpManager
|
||||
+ _f_a5ud
|
||||
+ (DAVContext __allowedMethods_a5ue
|
||||
+ __baseRequest_a5uf
|
||||
+ __complianceClasses_a5ug
|
||||
+ __httpManager'_a5uh
|
||||
+ __lockToken_a5uj
|
||||
+ __basicusername_a5uk
|
||||
+ __basicpassword_a5ul)
|
||||
+ = ((\ __httpManager_a5ui
|
||||
+ -> DAVContext
|
||||
+ __allowedMethods_a5ue
|
||||
+ __baseRequest_a5uf
|
||||
+ __complianceClasses_a5ug
|
||||
+ __httpManager_a5ui
|
||||
+ __lockToken_a5uj
|
||||
+ __basicusername_a5uk
|
||||
+ __basicpassword_a5ul)
|
||||
+ Data.Functor.<$> (_f_a5ud __httpManager'_a5uh))
|
||||
+{-# INLINE httpManager #-}
|
||||
+lockToken ::
|
||||
+ forall a_a4Oo.
|
||||
+ Control.Lens.Type.Lens' (DAVContext a_a4Oo) (Maybe B.ByteString)
|
||||
+lockToken
|
||||
+ _f_a5um
|
||||
+ (DAVContext __allowedMethods_a5un
|
||||
+ __baseRequest_a5uo
|
||||
+ __complianceClasses_a5up
|
||||
+ __httpManager_a5uq
|
||||
+ __lockToken'_a5ur
|
||||
+ __basicusername_a5ut
|
||||
+ __basicpassword_a5uu)
|
||||
+ = ((\ __lockToken_a5us
|
||||
+ -> DAVContext
|
||||
+ __allowedMethods_a5un
|
||||
+ __baseRequest_a5uo
|
||||
+ __complianceClasses_a5up
|
||||
+ __httpManager_a5uq
|
||||
+ __lockToken_a5us
|
||||
+ __basicusername_a5ut
|
||||
+ __basicpassword_a5uu)
|
||||
+ Data.Functor.<$> (_f_a5um __lockToken'_a5ur))
|
||||
+{-# INLINE lockToken #-}
|
||||
--
|
||||
1.7.10.4
|
||||
|
377
standalone/android/haskell-patches/DAV_build-without-TH.patch
Normal file
377
standalone/android/haskell-patches/DAV_build-without-TH.patch
Normal file
|
@ -0,0 +1,377 @@
|
|||
From 2b5fc33607720d0cccd7d8f9cb7232042ead73e6 Mon Sep 17 00:00:00 2001
|
||||
From: foo <foo@bar>
|
||||
Date: Sun, 22 Sep 2013 00:36:56 +0000
|
||||
Subject: [PATCH] expand TH
|
||||
|
||||
used the EvilSplicer
|
||||
+ manual fix ups
|
||||
---
|
||||
DAV.cabal | 20 +--
|
||||
Network/Protocol/HTTP/DAV.hs | 73 ++++++-----
|
||||
Network/Protocol/HTTP/DAV/TH.hs | 196 +++++++++++++++++++++++++++-
|
||||
dist/build/HSDAV-0.4.1.o | Bin 140080 -> 0 bytes
|
||||
dist/build/Network/Protocol/HTTP/DAV.hi | Bin 34549 -> 57657 bytes
|
||||
dist/build/Network/Protocol/HTTP/DAV.o | Bin 160248 -> 201932 bytes
|
||||
dist/build/Network/Protocol/HTTP/DAV/TH.hi | Bin 17056 -> 18733 bytes
|
||||
dist/build/Network/Protocol/HTTP/DAV/TH.o | Bin 19672 -> 28120 bytes
|
||||
dist/build/autogen/Paths_DAV.hs | 18 ++-
|
||||
dist/build/autogen/cabal_macros.h | 45 +++----
|
||||
dist/build/libHSDAV-0.4.1.a | Bin 200082 -> 260188 bytes
|
||||
dist/package.conf.inplace | 2 -
|
||||
dist/setup-config | 2 -
|
||||
13 files changed, 266 insertions(+), 90 deletions(-)
|
||||
delete mode 100644 dist/build/HSDAV-0.4.1.o
|
||||
delete mode 100644 dist/package.conf.inplace
|
||||
delete mode 100644 dist/setup-config
|
||||
|
||||
diff --git a/DAV.cabal b/DAV.cabal
|
||||
index 06b3a8b..90368c6 100644
|
||||
--- a/DAV.cabal
|
||||
+++ b/DAV.cabal
|
||||
@@ -38,25 +38,7 @@ library
|
||||
, transformers >= 0.3
|
||||
, xml-conduit >= 1.0 && <= 1.2
|
||||
, xml-hamlet >= 0.4 && <= 0.5
|
||||
-executable hdav
|
||||
- main-is: hdav.hs
|
||||
- ghc-options: -Wall
|
||||
- build-depends: base >= 4.5 && <= 5
|
||||
- , bytestring
|
||||
- , bytestring
|
||||
- , case-insensitive >= 0.4
|
||||
- , containers
|
||||
- , http-conduit >= 1.9.0
|
||||
- , http-types >= 0.7
|
||||
- , lens >= 3.0
|
||||
- , lifted-base >= 0.1
|
||||
- , mtl >= 2.1
|
||||
- , network >= 2.3
|
||||
- , optparse-applicative
|
||||
- , resourcet >= 0.3
|
||||
- , transformers >= 0.3
|
||||
- , xml-conduit >= 1.0 && <= 1.2
|
||||
- , xml-hamlet >= 0.4 && <= 0.5
|
||||
+ , text
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
diff --git a/Network/Protocol/HTTP/DAV.hs b/Network/Protocol/HTTP/DAV.hs
|
||||
index 8ffc270..d064a8f 100644
|
||||
--- a/Network/Protocol/HTTP/DAV.hs
|
||||
+++ b/Network/Protocol/HTTP/DAV.hs
|
||||
@@ -28,12 +28,12 @@ module Network.Protocol.HTTP.DAV (
|
||||
, deleteContent
|
||||
, moveContent
|
||||
, makeCollection
|
||||
- , caldavReport
|
||||
, module Network.Protocol.HTTP.DAV.TH
|
||||
) where
|
||||
|
||||
import Network.Protocol.HTTP.DAV.TH
|
||||
|
||||
+import qualified Data.Text
|
||||
import Control.Applicative (liftA2)
|
||||
import Control.Exception.Lifted (catchJust, finally, bracketOnError)
|
||||
import Control.Lens ((.~), (^.))
|
||||
@@ -200,11 +200,6 @@ props2patch = XML.renderLBS XML.def . patch . props . fromDocument
|
||||
, "{DAV:}supportedlock"
|
||||
]
|
||||
|
||||
-caldavReportM :: MonadResourceBase m => DAVState m XML.Document
|
||||
-caldavReportM = do
|
||||
- let ahs = [(hContentType, "application/xml; charset=\"utf-8\"")]
|
||||
- calrresp <- davRequest "REPORT" ahs (xmlBody calendarquery)
|
||||
- return $ (XML.parseLBS_ def . responseBody) calrresp
|
||||
|
||||
getProps :: String -> B.ByteString -> B.ByteString -> Maybe Depth -> IO XML.Document
|
||||
getProps url username password md = withDS url username password md getPropsM
|
||||
@@ -246,9 +241,6 @@ moveContent :: String -> B.ByteString -> B.ByteString -> B.ByteString -> IO ()
|
||||
moveContent url newurl username password = withDS url username password Nothing $
|
||||
moveContentM newurl
|
||||
|
||||
-caldavReport :: String -> B.ByteString -> B.ByteString -> IO XML.Document
|
||||
-caldavReport url username password = withDS url username password (Just Depth1) $ caldavReportM
|
||||
-
|
||||
-- | Creates a WebDAV collection, which is similar to a directory.
|
||||
--
|
||||
-- Returns False if the collection could not be made due to an intermediate
|
||||
@@ -264,28 +256,45 @@ makeCollection url username password = withDS url username password Nothing $
|
||||
propname :: XML.Document
|
||||
propname = XML.Document (XML.Prologue [] Nothing []) root []
|
||||
where
|
||||
- root = XML.Element "D:propfind" (Map.fromList [("xmlns:D", "DAV:")]) [xml|
|
||||
-<D:allprop>
|
||||
-|]
|
||||
-
|
||||
+ root = XML.Element "D:propfind" (Map.fromList [("xmlns:D", "DAV:")]) $ concat
|
||||
+ [[XML.NodeElement
|
||||
+ (XML.Element
|
||||
+ (XML.Name
|
||||
+ (Data.Text.pack "D:allprop") Nothing Nothing)
|
||||
+ Map.empty
|
||||
+ (concat []))]]
|
||||
locky :: XML.Document
|
||||
locky = XML.Document (XML.Prologue [] Nothing []) root []
|
||||
- where
|
||||
- root = XML.Element "D:lockinfo" (Map.fromList [("xmlns:D", "DAV:")]) [xml|
|
||||
-<D:lockscope>
|
||||
- <D:exclusive>
|
||||
-<D:locktype>
|
||||
- <D:write>
|
||||
-<D:owner>Haskell DAV user
|
||||
-|]
|
||||
-
|
||||
-calendarquery :: XML.Document
|
||||
-calendarquery = XML.Document (XML.Prologue [] Nothing []) root []
|
||||
- where
|
||||
- root = XML.Element "C:calendar-query" (Map.fromList [("xmlns:D", "DAV:"),("xmlns:C", "urn:ietf:params:xml:ns:caldav")]) [xml|
|
||||
-<D:prop>
|
||||
- <D:getetag>
|
||||
- <C:calendar-data>
|
||||
-<C:filter>
|
||||
- <C:comp-filter name="VCALENDAR">
|
||||
-|]
|
||||
+ where
|
||||
+ root = XML.Element "D:lockinfo" (Map.fromList [("xmlns:D", "DAV:")]) $ concat
|
||||
+ [[XML.NodeElement
|
||||
+ (XML.Element
|
||||
+ (XML.Name
|
||||
+ (Data.Text.pack "D:lockscope") Nothing Nothing)
|
||||
+ Map.empty
|
||||
+ (concat
|
||||
+ [[XML.NodeElement
|
||||
+ (XML.Element
|
||||
+ (XML.Name
|
||||
+ (Data.Text.pack "D:exclusive") Nothing Nothing)
|
||||
+ Map.empty
|
||||
+ (concat []))]]))],
|
||||
+ [XML.NodeElement
|
||||
+ (XML.Element
|
||||
+ (XML.Name
|
||||
+ (Data.Text.pack "D:locktype") Nothing Nothing)
|
||||
+ Map.empty
|
||||
+ (concat
|
||||
+ [[XML.NodeElement
|
||||
+ (XML.Element
|
||||
+ (XML.Name (Data.Text.pack "D:write") Nothing Nothing)
|
||||
+ Map.empty
|
||||
+ (concat []))]]))],
|
||||
+ [XML.NodeElement
|
||||
+ (XML.Element
|
||||
+ (XML.Name (Data.Text.pack "D:owner") Nothing Nothing)
|
||||
+ Map.empty
|
||||
+ (concat
|
||||
+ [[XML.NodeContent
|
||||
+ (Data.Text.pack "Haskell DAV user")]]))]]
|
||||
+
|
||||
diff --git a/Network/Protocol/HTTP/DAV/TH.hs b/Network/Protocol/HTTP/DAV/TH.hs
|
||||
index 9fb3495..18b8df7 100644
|
||||
--- a/Network/Protocol/HTTP/DAV/TH.hs
|
||||
+++ b/Network/Protocol/HTTP/DAV/TH.hs
|
||||
@@ -20,7 +20,8 @@
|
||||
|
||||
module Network.Protocol.HTTP.DAV.TH where
|
||||
|
||||
-import Control.Lens (makeLenses)
|
||||
+import qualified Control.Lens.Type
|
||||
+import qualified Data.Functor
|
||||
import qualified Data.ByteString as B
|
||||
import Network.HTTP.Conduit (Manager, Request)
|
||||
|
||||
@@ -46,4 +47,195 @@ data DAVContext a = DAVContext {
|
||||
, _basicpassword :: B.ByteString
|
||||
, _depth :: Maybe Depth
|
||||
}
|
||||
-makeLenses ''DAVContext
|
||||
+allowedMethods ::
|
||||
+ Control.Lens.Type.Lens' (DAVContext a_a4I4) [B.ByteString]
|
||||
+allowedMethods
|
||||
+ _f_a5GM
|
||||
+ (DAVContext __allowedMethods'_a5GN
|
||||
+ __baseRequest_a5GP
|
||||
+ __complianceClasses_a5GQ
|
||||
+ __httpManager_a5GR
|
||||
+ __lockToken_a5GS
|
||||
+ __basicusername_a5GT
|
||||
+ __basicpassword_a5GU
|
||||
+ __depth_a5GV)
|
||||
+ = ((\ __allowedMethods_a5GO
|
||||
+ -> DAVContext
|
||||
+ __allowedMethods_a5GO
|
||||
+ __baseRequest_a5GP
|
||||
+ __complianceClasses_a5GQ
|
||||
+ __httpManager_a5GR
|
||||
+ __lockToken_a5GS
|
||||
+ __basicusername_a5GT
|
||||
+ __basicpassword_a5GU
|
||||
+ __depth_a5GV)
|
||||
+ Data.Functor.<$> (_f_a5GM __allowedMethods'_a5GN))
|
||||
+{-# INLINE allowedMethods #-}
|
||||
+baseRequest ::
|
||||
+ Control.Lens.Type.Lens (DAVContext a_a4I4) (DAVContext a_a5GW) (Request a_a4I4) (Request a_a5GW)
|
||||
+baseRequest
|
||||
+ _f_a5GX
|
||||
+ (DAVContext __allowedMethods_a5GY
|
||||
+ __baseRequest'_a5GZ
|
||||
+ __complianceClasses_a5H1
|
||||
+ __httpManager_a5H2
|
||||
+ __lockToken_a5H3
|
||||
+ __basicusername_a5H4
|
||||
+ __basicpassword_a5H5
|
||||
+ __depth_a5H6)
|
||||
+ = ((\ __baseRequest_a5H0
|
||||
+ -> DAVContext
|
||||
+ __allowedMethods_a5GY
|
||||
+ __baseRequest_a5H0
|
||||
+ __complianceClasses_a5H1
|
||||
+ __httpManager_a5H2
|
||||
+ __lockToken_a5H3
|
||||
+ __basicusername_a5H4
|
||||
+ __basicpassword_a5H5
|
||||
+ __depth_a5H6)
|
||||
+ Data.Functor.<$> (_f_a5GX __baseRequest'_a5GZ))
|
||||
+{-# INLINE baseRequest #-}
|
||||
+basicpassword ::
|
||||
+ Control.Lens.Type.Lens' (DAVContext a_a4I4) B.ByteString
|
||||
+basicpassword
|
||||
+ _f_a5H7
|
||||
+ (DAVContext __allowedMethods_a5H8
|
||||
+ __baseRequest_a5H9
|
||||
+ __complianceClasses_a5Ha
|
||||
+ __httpManager_a5Hb
|
||||
+ __lockToken_a5Hc
|
||||
+ __basicusername_a5Hd
|
||||
+ __basicpassword'_a5He
|
||||
+ __depth_a5Hg)
|
||||
+ = ((\ __basicpassword_a5Hf
|
||||
+ -> DAVContext
|
||||
+ __allowedMethods_a5H8
|
||||
+ __baseRequest_a5H9
|
||||
+ __complianceClasses_a5Ha
|
||||
+ __httpManager_a5Hb
|
||||
+ __lockToken_a5Hc
|
||||
+ __basicusername_a5Hd
|
||||
+ __basicpassword_a5Hf
|
||||
+ __depth_a5Hg)
|
||||
+ Data.Functor.<$> (_f_a5H7 __basicpassword'_a5He))
|
||||
+{-# INLINE basicpassword #-}
|
||||
+basicusername ::
|
||||
+ Control.Lens.Type.Lens' (DAVContext a_a4I4) B.ByteString
|
||||
+basicusername
|
||||
+ _f_a5Hh
|
||||
+ (DAVContext __allowedMethods_a5Hi
|
||||
+ __baseRequest_a5Hj
|
||||
+ __complianceClasses_a5Hk
|
||||
+ __httpManager_a5Hl
|
||||
+ __lockToken_a5Hm
|
||||
+ __basicusername'_a5Hn
|
||||
+ __basicpassword_a5Hp
|
||||
+ __depth_a5Hq)
|
||||
+ = ((\ __basicusername_a5Ho
|
||||
+ -> DAVContext
|
||||
+ __allowedMethods_a5Hi
|
||||
+ __baseRequest_a5Hj
|
||||
+ __complianceClasses_a5Hk
|
||||
+ __httpManager_a5Hl
|
||||
+ __lockToken_a5Hm
|
||||
+ __basicusername_a5Ho
|
||||
+ __basicpassword_a5Hp
|
||||
+ __depth_a5Hq)
|
||||
+ Data.Functor.<$> (_f_a5Hh __basicusername'_a5Hn))
|
||||
+{-# INLINE basicusername #-}
|
||||
+complianceClasses ::
|
||||
+ Control.Lens.Type.Lens' (DAVContext a_a4I4) [B.ByteString]
|
||||
+complianceClasses
|
||||
+ _f_a5Hr
|
||||
+ (DAVContext __allowedMethods_a5Hs
|
||||
+ __baseRequest_a5Ht
|
||||
+ __complianceClasses'_a5Hu
|
||||
+ __httpManager_a5Hw
|
||||
+ __lockToken_a5Hx
|
||||
+ __basicusername_a5Hy
|
||||
+ __basicpassword_a5Hz
|
||||
+ __depth_a5HA)
|
||||
+ = ((\ __complianceClasses_a5Hv
|
||||
+ -> DAVContext
|
||||
+ __allowedMethods_a5Hs
|
||||
+ __baseRequest_a5Ht
|
||||
+ __complianceClasses_a5Hv
|
||||
+ __httpManager_a5Hw
|
||||
+ __lockToken_a5Hx
|
||||
+ __basicusername_a5Hy
|
||||
+ __basicpassword_a5Hz
|
||||
+ __depth_a5HA)
|
||||
+ Data.Functor.<$> (_f_a5Hr __complianceClasses'_a5Hu))
|
||||
+{-# INLINE complianceClasses #-}
|
||||
+depth ::
|
||||
+ Control.Lens.Type.Lens' (DAVContext a_a4I4) (Maybe Depth)
|
||||
+depth
|
||||
+ _f_a5HB
|
||||
+ (DAVContext __allowedMethods_a5HC
|
||||
+ __baseRequest_a5HD
|
||||
+ __complianceClasses_a5HE
|
||||
+ __httpManager_a5HF
|
||||
+ __lockToken_a5HG
|
||||
+ __basicusername_a5HH
|
||||
+ __basicpassword_a5HI
|
||||
+ __depth'_a5HJ)
|
||||
+ = ((\ __depth_a5HK
|
||||
+ -> DAVContext
|
||||
+ __allowedMethods_a5HC
|
||||
+ __baseRequest_a5HD
|
||||
+ __complianceClasses_a5HE
|
||||
+ __httpManager_a5HF
|
||||
+ __lockToken_a5HG
|
||||
+ __basicusername_a5HH
|
||||
+ __basicpassword_a5HI
|
||||
+ __depth_a5HK)
|
||||
+ Data.Functor.<$> (_f_a5HB __depth'_a5HJ))
|
||||
+{-# INLINE depth #-}
|
||||
+httpManager ::
|
||||
+ Control.Lens.Type.Lens' (DAVContext a_a4I4) Manager
|
||||
+httpManager
|
||||
+ _f_a5HL
|
||||
+ (DAVContext __allowedMethods_a5HM
|
||||
+ __baseRequest_a5HN
|
||||
+ __complianceClasses_a5HO
|
||||
+ __httpManager'_a5HP
|
||||
+ __lockToken_a5HR
|
||||
+ __basicusername_a5HS
|
||||
+ __basicpassword_a5HT
|
||||
+ __depth_a5HU)
|
||||
+ = ((\ __httpManager_a5HQ
|
||||
+ -> DAVContext
|
||||
+ __allowedMethods_a5HM
|
||||
+ __baseRequest_a5HN
|
||||
+ __complianceClasses_a5HO
|
||||
+ __httpManager_a5HQ
|
||||
+ __lockToken_a5HR
|
||||
+ __basicusername_a5HS
|
||||
+ __basicpassword_a5HT
|
||||
+ __depth_a5HU)
|
||||
+ Data.Functor.<$> (_f_a5HL __httpManager'_a5HP))
|
||||
+{-# INLINE httpManager #-}
|
||||
+lockToken ::
|
||||
+ Control.Lens.Type.Lens' (DAVContext a_a4I4) (Maybe B.ByteString)
|
||||
+lockToken
|
||||
+ _f_a5HV
|
||||
+ (DAVContext __allowedMethods_a5HW
|
||||
+ __baseRequest_a5HX
|
||||
+ __complianceClasses_a5HY
|
||||
+ __httpManager_a5HZ
|
||||
+ __lockToken'_a5I0
|
||||
+ __basicusername_a5I2
|
||||
+ __basicpassword_a5I3
|
||||
+ __depth_a5I4)
|
||||
+ = ((\ __lockToken_a5I1
|
||||
+ -> DAVContext
|
||||
+ __allowedMethods_a5HW
|
||||
+ __baseRequest_a5HX
|
||||
+ __complianceClasses_a5HY
|
||||
+ __httpManager_a5HZ
|
||||
+ __lockToken_a5I1
|
||||
+ __basicusername_a5I2
|
||||
+ __basicpassword_a5I3
|
||||
+ __depth_a5I4)
|
||||
+ Data.Functor.<$> (_f_a5HV __lockToken'_a5I0))
|
||||
+{-# INLINE lockToken #-}
|
|
@ -1,31 +1,25 @@
|
|||
From 32d0741c64e6bd280e46f7c452db9462fbac05f9 Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Tue, 7 May 2013 18:21:04 -0400
|
||||
Subject: [PATCH] fix build
|
||||
From 5c57c4ae7dac0c1aa940005f5ea55fdcd4fcd1f5 Mon Sep 17 00:00:00 2001
|
||||
From: foo <foo@bar>
|
||||
Date: Sat, 21 Sep 2013 22:46:42 +0000
|
||||
Subject: [PATCH] fix build with new base
|
||||
|
||||
---
|
||||
HTTP.cabal | 4 ++--
|
||||
1 file changed, 2 insertions(+), 2 deletions(-)
|
||||
HTTP.cabal | 2 +-
|
||||
1 file changed, 1 insertion(+), 1 deletion(-)
|
||||
|
||||
diff --git a/HTTP.cabal b/HTTP.cabal
|
||||
index 76cb5d6..edddf26 100644
|
||||
index 76cb5d6..bb38f24 100644
|
||||
--- a/HTTP.cabal
|
||||
+++ b/HTTP.cabal
|
||||
@@ -85,12 +85,12 @@ Library
|
||||
@@ -85,7 +85,7 @@ Library
|
||||
Network.HTTP.Utils
|
||||
Paths_HTTP
|
||||
GHC-options: -fwarn-missing-signatures -Wall
|
||||
- Build-depends: base >= 2 && < 4.7, network < 2.5, parsec
|
||||
+ Build-depends: base >= 2 && < 4.8, network < 2.5, parsec
|
||||
+ Build-depends: base >= 2 && < 4.9, network < 2.5, parsec
|
||||
Extensions: FlexibleInstances
|
||||
if flag(old-base)
|
||||
Build-depends: base < 3
|
||||
else
|
||||
- Build-depends: base >= 3, array, old-time, bytestring
|
||||
+ Build-depends: base >= 3, array, old-time, bytestring (>= 0.10.3.0)
|
||||
|
||||
if flag(mtl1)
|
||||
Build-depends: mtl >= 1.1 && < 1.2
|
||||
--
|
||||
1.7.10.4
|
||||
|
||||
|
|
|
@ -0,0 +1,56 @@
|
|||
From 083c9d135ec68316db173235994c63603ad76444 Mon Sep 17 00:00:00 2001
|
||||
From: foo <foo@bar>
|
||||
Date: Sat, 21 Sep 2013 23:01:35 +0000
|
||||
Subject: [PATCH] hack to get to build with new ghc
|
||||
|
||||
Copied the old implemenations of block and unblock from old Control.Exception
|
||||
since these deprecated functions have now been removed.
|
||||
---
|
||||
MonadCatchIO-transformers.cabal | 2 +-
|
||||
src/Control/Monad/CatchIO.hs | 13 +++++++++++--
|
||||
2 files changed, 12 insertions(+), 3 deletions(-)
|
||||
|
||||
diff --git a/MonadCatchIO-transformers.cabal b/MonadCatchIO-transformers.cabal
|
||||
index fe6674d..b9f559f 100644
|
||||
--- a/MonadCatchIO-transformers.cabal
|
||||
+++ b/MonadCatchIO-transformers.cabal
|
||||
@@ -26,4 +26,4 @@ Library
|
||||
Exposed-Modules:
|
||||
Control.Monad.CatchIO
|
||||
Hs-Source-Dirs: src
|
||||
- Ghc-options: -Wall
|
||||
+ Ghc-options: -Wall -fglasgow-exts
|
||||
diff --git a/src/Control/Monad/CatchIO.hs b/src/Control/Monad/CatchIO.hs
|
||||
index 62afb83..853996b 100644
|
||||
--- a/src/Control/Monad/CatchIO.hs
|
||||
+++ b/src/Control/Monad/CatchIO.hs
|
||||
@@ -19,6 +19,9 @@ where
|
||||
import Prelude hiding ( catch )
|
||||
import Control.Applicative ((<$>))
|
||||
import qualified Control.Exception.Extensible as E
|
||||
+import qualified Control.Exception.Base as E
|
||||
+import GHC.Base (maskAsyncExceptions#)
|
||||
+import GHC.IO (unsafeUnmask, IO(..))
|
||||
|
||||
import Control.Monad.IO.Class (MonadIO,liftIO)
|
||||
|
||||
@@ -51,8 +54,14 @@ class MonadIO m => MonadCatchIO m where
|
||||
|
||||
instance MonadCatchIO IO where
|
||||
catch = E.catch
|
||||
- block = E.block
|
||||
- unblock = E.unblock
|
||||
+ block = oldblock
|
||||
+ unblock = oldunblock
|
||||
+
|
||||
+oldblock :: IO a -> IO a
|
||||
+oldblock (IO io) = IO $ maskAsyncExceptions# io
|
||||
+
|
||||
+oldunblock :: IO a -> IO a
|
||||
+oldunblock = unsafeUnmask
|
||||
|
||||
-- | Warning: this instance is somewhat contentious.
|
||||
--
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -0,0 +1,36 @@
|
|||
From 010db89634eb0f64e7961581e65da3acbb2b9f3d Mon Sep 17 00:00:00 2001
|
||||
From: foo <foo@bar>
|
||||
Date: Sat, 21 Sep 2013 22:05:41 +0000
|
||||
Subject: [PATCH] fix build with new base
|
||||
|
||||
---
|
||||
src/Control/Concurrent/MSampleVar.hs | 6 +-----
|
||||
1 file changed, 1 insertion(+), 5 deletions(-)
|
||||
|
||||
diff --git a/src/Control/Concurrent/MSampleVar.hs b/src/Control/Concurrent/MSampleVar.hs
|
||||
index d029c64..16ad6c5 100644
|
||||
--- a/src/Control/Concurrent/MSampleVar.hs
|
||||
+++ b/src/Control/Concurrent/MSampleVar.hs
|
||||
@@ -30,7 +30,7 @@ module Control.Concurrent.MSampleVar
|
||||
import Control.Monad(void,join)
|
||||
import Control.Concurrent.MVar(MVar,newMVar,newEmptyMVar,tryTakeMVar,takeMVar,putMVar,withMVar,isEmptyMVar)
|
||||
import Control.Exception(mask_)
|
||||
-import Data.Typeable(Typeable1(typeOf1),mkTyCon,mkTyConApp)
|
||||
+import Data.Typeable(mkTyConApp)
|
||||
|
||||
-- |
|
||||
-- Sample variables are slightly different from a normal 'MVar':
|
||||
@@ -62,10 +62,6 @@ data MSampleVar a = MSampleVar { readQueue :: MVar ()
|
||||
, lockedStore :: MVar (MVar a) }
|
||||
deriving (Eq)
|
||||
|
||||
-instance Typeable1 MSampleVar where
|
||||
- typeOf1 _ = mkTyConApp tc []
|
||||
- where tc = mkTyCon "MSampleVar"
|
||||
-
|
||||
|
||||
-- | 'newEmptySV' allocates a new MSampleVar in an empty state. No futher
|
||||
-- allocation is done when using the 'MSampleVar'.
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,24 +0,0 @@
|
|||
From b220c377941d0b1271cf525a8d06bb8e48196d2b Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Thu, 28 Feb 2013 23:29:04 -0400
|
||||
Subject: [PATCH] disable TH
|
||||
|
||||
---
|
||||
aeson.cabal | 1 -
|
||||
1 file changed, 1 deletion(-)
|
||||
|
||||
diff --git a/aeson.cabal b/aeson.cabal
|
||||
index 242aa67..275aa49 100644
|
||||
--- a/aeson.cabal
|
||||
+++ b/aeson.cabal
|
||||
@@ -99,7 +99,6 @@ library
|
||||
Data.Aeson.Generic
|
||||
Data.Aeson.Parser
|
||||
Data.Aeson.Types
|
||||
- Data.Aeson.TH
|
||||
|
||||
other-modules:
|
||||
Data.Aeson.Functions
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,14 +1,14 @@
|
|||
From 55f424de9946c4d1d89837bb18698437aecfcfa4 Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Thu, 28 Feb 2013 23:29:16 -0400
|
||||
Subject: [PATCH] allow building with unreleased ghc
|
||||
From 0035f0366e426af213244b2eb25ffb63cb9e74d0 Mon Sep 17 00:00:00 2001
|
||||
From: foo <foo@bar>
|
||||
Date: Sun, 22 Sep 2013 06:14:50 +0000
|
||||
Subject: [PATCH] fix build with new ghc
|
||||
|
||||
---
|
||||
async.cabal | 2 +-
|
||||
1 file changed, 1 insertion(+), 1 deletion(-)
|
||||
|
||||
diff --git a/async.cabal b/async.cabal
|
||||
index 8e47d9d..ff317c7 100644
|
||||
index 8e47d9d..98e6312 100644
|
||||
--- a/async.cabal
|
||||
+++ b/async.cabal
|
||||
@@ -70,7 +70,7 @@ source-repository head
|
||||
|
@ -16,7 +16,7 @@ index 8e47d9d..ff317c7 100644
|
|||
library
|
||||
exposed-modules: Control.Concurrent.Async
|
||||
- build-depends: base >= 4.3 && < 4.7, stm >= 2.2 && < 2.5
|
||||
+ build-depends: base >= 4.3 && < 4.8, stm >= 2.2 && < 2.5
|
||||
+ build-depends: base >= 4.3 && < 4.9, stm >= 2.2 && < 2.5
|
||||
|
||||
test-suite test-async
|
||||
type: exitcode-stdio-1.0
|
|
@ -0,0 +1,26 @@
|
|||
From 09bcaf4f203c39c967a6951d56fd015347bb5dae Mon Sep 17 00:00:00 2001
|
||||
From: foo <foo@bar>
|
||||
Date: Sat, 21 Sep 2013 21:57:21 +0000
|
||||
Subject: [PATCH] fix build with newer base
|
||||
|
||||
---
|
||||
Data/BloomFilter/Array.hs | 3 ++-
|
||||
1 file changed, 2 insertions(+), 1 deletion(-)
|
||||
|
||||
diff --git a/Data/BloomFilter/Array.hs b/Data/BloomFilter/Array.hs
|
||||
index e085bbe..d94757a 100644
|
||||
--- a/Data/BloomFilter/Array.hs
|
||||
+++ b/Data/BloomFilter/Array.hs
|
||||
@@ -3,7 +3,8 @@
|
||||
|
||||
module Data.BloomFilter.Array (newArray) where
|
||||
|
||||
-import Control.Monad.ST (ST, unsafeIOToST)
|
||||
+import Control.Monad.ST (ST)
|
||||
+import Control.Monad.ST.Unsafe (unsafeIOToST)
|
||||
import Data.Array.Base (MArray, STUArray(..), unsafeNewArray_)
|
||||
#if __GLASGOW_HASKELL__ >= 704
|
||||
import Foreign.C.Types (CInt(..), CSize(..))
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,27 +0,0 @@
|
|||
From efd0e93de82c0b5554a4f3a4517e6127f405f6da Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Thu, 28 Feb 2013 23:29:36 -0400
|
||||
Subject: [PATCH] allow building with unreleased ghc
|
||||
|
||||
---
|
||||
case-insensitive.cabal | 4 ++--
|
||||
1 file changed, 2 insertions(+), 2 deletions(-)
|
||||
|
||||
diff --git a/case-insensitive.cabal b/case-insensitive.cabal
|
||||
index a73479d..18a1a51 100644
|
||||
--- a/case-insensitive.cabal
|
||||
+++ b/case-insensitive.cabal
|
||||
@@ -25,8 +25,8 @@ source-repository head
|
||||
|
||||
Library
|
||||
GHC-Options: -Wall
|
||||
- build-depends: base >= 3 && < 4.6
|
||||
- , bytestring >= 0.9 && < 0.10
|
||||
+ build-depends: base >= 3 && < 4.8
|
||||
+ , bytestring >= 0.9 && < 0.15
|
||||
, text >= 0.3 && < 0.12
|
||||
, hashable >= 1.0 && < 1.2
|
||||
exposed-modules: Data.CaseInsensitive
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,37 +0,0 @@
|
|||
From 3779c75175e895f94b21341ebd6361e9d6af54fd Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Thu, 9 May 2013 12:36:23 -0400
|
||||
Subject: [PATCH] support Android cert store
|
||||
|
||||
Android puts it in a different place and has only hashed files.
|
||||
See https://github.com/vincenthz/hs-certificate/issues/19
|
||||
---
|
||||
System/Certificate/X509/Unix.hs | 5 +++--
|
||||
1 file changed, 3 insertions(+), 2 deletions(-)
|
||||
|
||||
diff --git a/System/Certificate/X509/Unix.hs b/System/Certificate/X509/Unix.hs
|
||||
index 8463465..74e9503 100644
|
||||
--- a/System/Certificate/X509/Unix.hs
|
||||
+++ b/System/Certificate/X509/Unix.hs
|
||||
@@ -35,7 +35,8 @@ import qualified Control.Exception as E
|
||||
import Data.Char
|
||||
|
||||
defaultSystemPath :: FilePath
|
||||
-defaultSystemPath = "/etc/ssl/certs/"
|
||||
+defaultSystemPath = "/system/etc/security/cacerts/"
|
||||
+--defaultSystemPath = "/etc/ssl/certs/"
|
||||
|
||||
envPathOverride :: String
|
||||
envPathOverride = "SYSTEM_CERTIFICATE_PATH"
|
||||
@@ -47,7 +48,7 @@ listDirectoryCerts path = (map (path </>) . filter isCert <$> getDirectoryConten
|
||||
&& isDigit (s !! 9)
|
||||
&& (s !! 8) == '.'
|
||||
&& all isHexDigit (take 8 s)
|
||||
- isCert x = (not $ isPrefixOf "." x) && (not $ isHashedFile x)
|
||||
+ isCert x = (not $ isPrefixOf "." x)
|
||||
|
||||
getSystemCertificateStore :: IO CertificateStore
|
||||
getSystemCertificateStore = makeCertificateStore . concat <$> (getSystemPath >>= listDirectoryCerts >>= mapM readCertificates)
|
||||
--
|
||||
1.8.2.rc3
|
||||
|
|
@ -1,34 +0,0 @@
|
|||
From d456247000ab839a1d32749717f4f8f92e37dbba Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Tue, 7 May 2013 17:45:45 -0400
|
||||
Subject: [PATCH] fix cross build
|
||||
|
||||
---
|
||||
cipher-aes.cabal | 5 +----
|
||||
1 file changed, 1 insertion(+), 4 deletions(-)
|
||||
|
||||
diff --git a/cipher-aes.cabal b/cipher-aes.cabal
|
||||
index 02ddfd0..eb916e3 100644
|
||||
--- a/cipher-aes.cabal
|
||||
+++ b/cipher-aes.cabal
|
||||
@@ -31,16 +31,13 @@ Extra-Source-Files: Tests/*.hs
|
||||
|
||||
Library
|
||||
Build-Depends: base >= 4 && < 5
|
||||
- , bytestring
|
||||
+ , bytestring >= 0.10.3.0
|
||||
Exposed-modules: Crypto.Cipher.AES
|
||||
ghc-options: -Wall
|
||||
C-sources: cbits/aes_generic.c
|
||||
cbits/aes.c
|
||||
cbits/gf.c
|
||||
cbits/cpu.c
|
||||
- if os(linux) && (arch(i386) || arch(x86_64))
|
||||
- CC-options: -mssse3 -maes -mpclmul -DWITH_AESNI
|
||||
- C-sources: cbits/aes_x86ni.c
|
||||
|
||||
Test-Suite test-cipher-aes
|
||||
type: exitcode-stdio-1.0
|
||||
--
|
||||
1.7.10.4
|
||||
|
25
standalone/android/haskell-patches/comonad_cross-build.patch
Normal file
25
standalone/android/haskell-patches/comonad_cross-build.patch
Normal file
|
@ -0,0 +1,25 @@
|
|||
From 2cb43c46d345341d1aa77c4b2a88514c056d3122 Mon Sep 17 00:00:00 2001
|
||||
From: foo <foo@bar>
|
||||
Date: Sat, 21 Sep 2013 22:25:18 +0000
|
||||
Subject: [PATCH] cross build
|
||||
|
||||
---
|
||||
comonad.cabal | 2 +-
|
||||
1 file changed, 1 insertion(+), 1 deletion(-)
|
||||
|
||||
diff --git a/comonad.cabal b/comonad.cabal
|
||||
index e01f1a7..e807e05 100644
|
||||
--- a/comonad.cabal
|
||||
+++ b/comonad.cabal
|
||||
@@ -13,7 +13,7 @@ copyright: Copyright (C) 2008-2013 Edward A. Kmett,
|
||||
Copyright (C) 2004-2008 Dave Menendez
|
||||
synopsis: Haskell 98 compatible comonads
|
||||
description: Haskell 98 compatible comonads
|
||||
-build-type: Custom
|
||||
+build-type: Simple
|
||||
extra-source-files:
|
||||
.gitignore
|
||||
.travis.yml
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,73 +0,0 @@
|
|||
From 8459f93270c7a6e8a2ebd415db2110a66bf1ec41 Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Wed, 15 May 2013 20:31:14 -0400
|
||||
Subject: [PATCH] use getprop to get dns server
|
||||
|
||||
---
|
||||
Network/DNS/Resolver.hs | 13 +++++++++++--
|
||||
dns.cabal | 4 ++++
|
||||
2 files changed, 15 insertions(+), 2 deletions(-)
|
||||
|
||||
diff --git a/Network/DNS/Resolver.hs b/Network/DNS/Resolver.hs
|
||||
index 70ab9ed..9b27336 100644
|
||||
--- a/Network/DNS/Resolver.hs
|
||||
+++ b/Network/DNS/Resolver.hs
|
||||
@@ -41,6 +41,8 @@ import Network.Socket.ByteString.Lazy
|
||||
import Prelude hiding (lookup)
|
||||
import System.Random
|
||||
import System.Timeout
|
||||
+import System.Process (readProcess)
|
||||
+import System.Directory
|
||||
|
||||
#if mingw32_HOST_OS == 1
|
||||
import Network.Socket (send)
|
||||
@@ -73,7 +75,7 @@ data ResolvConf = ResolvConf {
|
||||
-}
|
||||
defaultResolvConf :: ResolvConf
|
||||
defaultResolvConf = ResolvConf {
|
||||
- resolvInfo = RCFilePath "/etc/resolv.conf"
|
||||
+ resolvInfo = RCFilePath "/system/etc/resolv.conf"
|
||||
, resolvTimeout = 3 * 1000 * 1000
|
||||
, resolvBufsize = 512
|
||||
}
|
||||
@@ -111,7 +113,14 @@ makeResolvSeed conf = ResolvSeed <$> addr
|
||||
where
|
||||
addr = case resolvInfo conf of
|
||||
RCHostName numhost -> makeAddrInfo numhost
|
||||
- RCFilePath file -> toAddr <$> readFile file >>= makeAddrInfo
|
||||
+ RCFilePath file -> do
|
||||
+ exists <- doesFileExist file
|
||||
+ if exists
|
||||
+ then toAddr <$> readFile file >>= makeAddrInfo
|
||||
+ else do
|
||||
+ s <- readProcess "getprop" ["net.dns1"] ""
|
||||
+ makeAddrInfo $ takeWhile (/= '\n') s
|
||||
+
|
||||
toAddr cs = let l:_ = filter ("nameserver" `isPrefixOf`) $ lines cs
|
||||
in extract l
|
||||
extract = reverse . dropWhile isSpace . reverse . dropWhile isSpace . drop 11
|
||||
diff --git a/dns.cabal b/dns.cabal
|
||||
index 40671f6..2c19734 100644
|
||||
--- a/dns.cabal
|
||||
+++ b/dns.cabal
|
||||
@@ -34,6 +34,8 @@ library
|
||||
, network >= 2.3
|
||||
, network-conduit
|
||||
, random
|
||||
+ , process
|
||||
+ , directory
|
||||
else
|
||||
Build-Depends: base >= 4 && < 5
|
||||
, attoparsec
|
||||
@@ -49,6 +51,8 @@ library
|
||||
, network-bytestring
|
||||
, network-conduit
|
||||
, random
|
||||
+ , process
|
||||
+ , directory
|
||||
Source-Repository head
|
||||
Type: git
|
||||
Location: git://github.com/kazu-yamamoto/dns.git
|
||||
--
|
||||
1.7.10.4
|
||||
|
25
standalone/android/haskell-patches/entropy_cross-build.patch
Normal file
25
standalone/android/haskell-patches/entropy_cross-build.patch
Normal file
|
@ -0,0 +1,25 @@
|
|||
From 35c6718205e9d7f5e5fc44578ea6a9971beac151 Mon Sep 17 00:00:00 2001
|
||||
From: foo <foo@bar>
|
||||
Date: Sat, 21 Sep 2013 23:32:18 +0000
|
||||
Subject: [PATCH] cross build
|
||||
|
||||
---
|
||||
entropy.cabal | 2 +-
|
||||
1 file changed, 1 insertion(+), 1 deletion(-)
|
||||
|
||||
diff --git a/entropy.cabal b/entropy.cabal
|
||||
index 45e4705..17553d8 100644
|
||||
--- a/entropy.cabal
|
||||
+++ b/entropy.cabal
|
||||
@@ -14,7 +14,7 @@ category: Data, Cryptography
|
||||
homepage: https://github.com/TomMD/entropy
|
||||
bug-reports: https://github.com/TomMD/entropy/issues
|
||||
stability: stable
|
||||
-build-type: Custom
|
||||
+build-type: Simple
|
||||
cabal-version: >= 1.6
|
||||
tested-with: GHC == 6.12.1
|
||||
data-files:
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,193 +0,0 @@
|
|||
From 256ff157005f44c97fa5affe2ed9655815b3788e Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Mon, 15 Apr 2013 12:38:22 -0400
|
||||
Subject: [PATCH] remove TH and export one symbol used by TH
|
||||
|
||||
---
|
||||
Data/.FileEmbed.hs.swp | Bin 16384 -> 0 bytes
|
||||
Data/FileEmbed.hs | 80 +++----------------------------------------------
|
||||
2 files changed, 4 insertions(+), 76 deletions(-)
|
||||
delete mode 100644 Data/.FileEmbed.hs.swp
|
||||
|
||||
diff --git a/Data/.FileEmbed.hs.swp b/Data/.FileEmbed.hs.swp
|
||||
deleted file mode 100644
|
||||
index 1b2ddbfaa71697e9df3869555aee8c97ca7ea0cb..0000000000000000000000000000000000000000
|
||||
GIT binary patch
|
||||
literal 0
|
||||
HcmV?d00001
|
||||
|
||||
literal 16384
|
||||
zcmeHNZEPGz8J?z;l0w=5RfRyn>$8>HBX?)xk`I~qq+D`I3}?sToJzq>+`YRw-^O>l
|
||||
z*WKCLCgwvzNFb1);!i<T;wykkiv)sSh>r*%6;!D~AU?_ukSIa|0TNP$5Jm93GrM~q
|
||||
zjuRvP0NRxw-|fsh@60^&&O0;jTz%?+xp_KLykFqiFT`)B+;d-j<zDfRmkV*(lbf7;
|
||||
zt7p{>ZzZDh-@^(gRkt_UayqggyLH(tOcke!Zz&#`JZUR?@)Xi5oLp=NyHc47r3|DD
|
||||
z?1q6*wF*b~iTkJDJT;yfqgTJ`{BBC6GARQo11SS311SS311SS311SS31OG=1sNNp&
|
||||
zPxNOGa0R$6!tMCX1MiLA@sU0$11SS311SS311SS311SS311SS311SS311SUlqYT(h
|
||||
zA*RvxX$}D3{-0w2zq&_=9|B(oJ`TJeP{1ls23`y71@-_h+%3fOz|Vo70p9>V3^ahF
|
||||
zz%+0#un)Kc_}e}qegu3C_%d)6aDW-$b-)X+5aMazbHMw6w*zCq9^f|M$M{{sb>Io$
|
||||
zDsTmu2a3QOfxq4*#4mxL0AB%~0z$wCs=#SrKk&!BLOct68+a6001g9(fV+S@fnUE&
|
||||
zh$n$h0-pdb0VUu*;P-b5@f+Y7;Bnwnz!hK(r~;F~i!T-8@4!!iYruDb&jKF=LO=l}
|
||||
z;0?g*f#>cJ;yXYO7zh6R5+S|?d;oYSa0ECE>;;}ffaVv#4}hnDCxOR-j{zSATEGS1
|
||||
zUf>TH+wTKwz-8bZPyu+%$AEi)y8$7HpN>=%&@2UQZ=IZNDccep(X*R1=Uo!Qv&r|F
|
||||
z8Jcqy6-rc7zT>V&%DFV2<%^snec$sb!$18fCO`ckYgMW_*Oh*5hAw!aPtCB~-K3yr
|
||||
zHzc*~fa+4Z)bM;i>?!<IBqOxS=%3}}X(cza!urcaWv_9wd>JSs<)EY;NTk@!fF`JX
|
||||
zv>3Y3yhZ_fP_B{J(t=EaWs>r`cn*w|i$SmBsN>)V!d0{a3W`nN>yg!w?y722*IsoR
|
||||
zIjW1e6I2H&$qQI17t5PU8d6Ln`|m=;if3thDtR$n3Za#w9SzTI*ou}jEt$zvX1<oW
|
||||
z80A4Srn}>`)S~V9(`4Css&o76R4UEVgY_)e>q`~-uF1^iL|+^_<~`SLQkP~+I={=s
|
||||
zQKTEGGGiGjn24J*LHx6xfM%%a_<^B28kDZxn<tC2t4^S@%zkGHtQDyhsGJt%GIXrK
|
||||
zI+XMw-SlK|((z?OdH!Z)1LYtdxXm2dolcf}GE@ba=Q{e`fUpEnO%Tq5&Guz#GOZk~
|
||||
zit~4_h0Q@%JInQuWhu1&*kmb32M!z{>%k4fsOc5bDaxmfoNn(4&sEY@h7~A^-}^l#
|
||||
z*HdSlW)ntrY@$T4n56TGuod$b)sPe1mtjh|;#q2X16deQ?%kpd`@|>?exEx_%T}C_
|
||||
zAF|EdMR<`&z3$E|k4;n?*OJNf^GB+<h1z~sSJ2iaKa`@MWMzxlnH4tIQ+6j9%o(Yq
|
||||
z?0Fqb80}q_yfV8i%x0d;gNZ1#(_CZYjE#7Vj`w;MYRgVf`ZO^{RYz6$(-f{!qish<
|
||||
z&9<Q5OofsAsGG5k6u`Qcw`ibkTNgz=Sn?_xJ*sm{F+lM<S~%(x&JhHMXW1Ang=pZi
|
||||
zX;;#$9tJf}a-)~MsHX#eW21_dqgmt9Z92xQJ$$^`JSlrffHCs0!-1{%o~P*GLCQ{M
|
||||
zF?U&^7<XDUKew>*K;<2^xw8u^N_Kl4Tger;-!<9kSkw6<`KcV7z2los87-D+PCek^
|
||||
zLl^t`BV)Id&9Qw(oi{T8dSa_%FN!%qBdTt0YlQ+WwVi<Qr`nR%J%6q3`B(tF7G?D>
|
||||
z5TP<F3I+Vp7M<pK&i>1|9a6r;`r+!bsHn?+u{b<1RC87<BuQ=d%m^_3JSQu9B3qUp
|
||||
zx+rSABd1fVm(z~ec&t80NH-n|s#wXg+PcZ?B$!m(0jM;DCkZ1Y8BWnfIPpy;ah4{m
|
||||
zL^y*EFW6m~$uSGD2viLE2E9u6m#TqP44#6EnX*o|=lO~r4sEz%M>c7s9Hdxqiz@s(
|
||||
z&mpowdKmc5BeJu}oNw~lAK)LB{f5_+n)igwzE@B9jBNhq1`no6rCl4irbtf|X4vqp
|
||||
zUvI{*7Dx!zZ!yFAm#@QA$LdCS8sPUoVK>0m3)8&CbN$AgMgvyc3^2>}HcT%Rmc`3k
|
||||
zP7G(yoh_bs1G^>33iaor^jn_aojaRIj`m|j9_|@V2ph5h`=_K3FLA!tDZ&YN9PDji
|
||||
z1XyIT5cXS;h+xyWj!Z1PxqP(7Cwg`?yW$D>@1um>WBF*@ryYg0SS%ISYxYFEiQ)Z;
|
||||
znW(&iY<q6BbSDjrXvP$bJj@ODIeEBF8L(aG4M|>b6}dsP&eOTj4jgNnKZn#VT{r8*
|
||||
z&X#?XFyGG&*MNnFtZ4Pi^Il%AO25j@;8oca8J01^i@wvX4i&g{iw^N(!YVCZ_{ie5
|
||||
zIB%RNe<-~0>X+BPHsP{ryQ`tSDvM{#s#IJ$Q><;e%HA*@I!Ehm>Bnt#+{>VxS=BY=
|
||||
zF&#KzxYPQmQR9=wZiq~pO$3+rCXmD$p;&ojyI7Us(3D+IYBZJ+RUdm_{YsR08vSk=
|
||||
zg^`cMe#7hbcnT}0D@E69hWM^0nzj=5q~c0poT|qcPM<%1x<V%w7iqlk?%~9xXcdp>
|
||||
z(gJ+`e*))O7w26*|L5^>9q0OIfiD6d0UiM^0B;5E1O9|_{L{cS;4xqcI0Wnm{(>|7
|
||||
zmw?Xzp9a=}67W3E?$?2D0$%_Kcn$C(&g|EKEnpEi415pg^Q*w;fe!&Iz!6{^xE=T%
|
||||
z+WHLe7{KlB0_l@7kTQ@mkTQ@mkTQ@m@ZZS*MbFzpgaMiW!X4$}y6-5-8#zuowaEXY
|
||||
zO(D^Or`kBev0xM}pL2t-)p8mRLO6q=aT5mD!ELj%<qa+cej^TP^H)R_1`f_hIkhN^
|
||||
zw5~rYVcLNII*1cD8lPwdLK)W3;Rk74Rv#L%3%*2NsCpry9Pv&&D!)xG4k{VRfmYyb
|
||||
zJs1!(n|Zs1V;33}#oIYfuH*9AgetCQ@LpkJ`^|!>WS92}IBf8pMleGe4v*>U5U#dd
|
||||
z8>({f!okrwx^0Nk@8+Ii=#C-#?_Dw^w;EPm;t(zeFDmK?6|dF8x(Pv&6-7o7z1H^=
|
||||
zp6{&cwkmJVy<FA2MmHEb1$q6m6XD@QA8E7YE00EW0TI_bq#a>o6NW|1E4~>r)#MRJ
|
||||
zMs<S%zBC7Z9QQSC1tU_;QFbbuCq3#WvdOJL2+xhDgx~}mEu$Wk^qov(%qEezmx$W1
|
||||
zARZXtyuDeML&nADtV`s|bt>2LC=hGcn)&p|kwa&PDJQgEt$EO3jZUuIaqSKi^9_lz
|
||||
z9hWDvK4Heq9I<p$5b<H0AC0Nv(9@6J#<6O?9MBhJS$c?1$`2tJ({qyV`Zg=dz?jDA
|
||||
zI%FLM82bu1%(xZ5BBIDW(h77&6yq6+*+fEI<Dg6&2a2*eNY0hd>f<{sAr2sLAk_D|
|
||||
z`qc+J6D-CzXMwU2H^e;Cr|*ba{SoCH#C(s9#asr$L<aeZ%jg>#<yG9U%QsA@jlbq-
|
||||
zVmD{{!*M8LFw8#`bk_k6DC6o_$TW{HhA_3Xr+|~_=du%-O(ufrT|dkaU2AGbJCF*)
|
||||
k07GoDCUU!rsE!Us=xSj*161jGRmD&g5~lU!(k&JL0(zanmH+?%
|
||||
|
||||
diff --git a/Data/FileEmbed.hs b/Data/FileEmbed.hs
|
||||
index 66f7004..f8c98c9 100644
|
||||
--- a/Data/FileEmbed.hs
|
||||
+++ b/Data/FileEmbed.hs
|
||||
@@ -1,31 +1,15 @@
|
||||
-{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
module Data.FileEmbed
|
||||
( -- * Embed at compile time
|
||||
- embedFile
|
||||
- , embedDir
|
||||
- , getDir
|
||||
+ getDir
|
||||
-- * Inject into an executable
|
||||
-#if MIN_VERSION_template_haskell(2,5,0)
|
||||
- , dummySpace
|
||||
-#endif
|
||||
, inject
|
||||
, injectFile
|
||||
+
|
||||
+ -- used by TH (pointlessly)
|
||||
+ , stringToBs
|
||||
) where
|
||||
|
||||
-import Language.Haskell.TH.Syntax
|
||||
- ( Exp (AppE, ListE, LitE, TupE, SigE)
|
||||
-#if MIN_VERSION_template_haskell(2,5,0)
|
||||
- , Lit (StringL, StringPrimL, IntegerL)
|
||||
-#else
|
||||
- , Lit (StringL, IntegerL)
|
||||
-#endif
|
||||
- , Q
|
||||
- , runIO
|
||||
-#if MIN_VERSION_template_haskell(2,7,0)
|
||||
- , Quasi(qAddDependentFile)
|
||||
-#endif
|
||||
- )
|
||||
import System.Directory (doesDirectoryExist, doesFileExist,
|
||||
getDirectoryContents)
|
||||
import Control.Monad (filterM)
|
||||
@@ -37,51 +21,12 @@ import Data.ByteString.Unsafe (unsafePackAddressLen)
|
||||
import System.IO.Unsafe (unsafePerformIO)
|
||||
import System.FilePath ((</>))
|
||||
|
||||
--- | Embed a single file in your source code.
|
||||
---
|
||||
--- > import qualified Data.ByteString
|
||||
--- >
|
||||
--- > myFile :: Data.ByteString.ByteString
|
||||
--- > myFile = $(embedFile "dirName/fileName")
|
||||
-embedFile :: FilePath -> Q Exp
|
||||
-embedFile fp =
|
||||
-#if MIN_VERSION_template_haskell(2,7,0)
|
||||
- qAddDependentFile fp >>
|
||||
-#endif
|
||||
- (runIO $ B.readFile fp) >>= bsToExp
|
||||
-
|
||||
--- | Embed a directory recusrively in your source code.
|
||||
---
|
||||
--- > import qualified Data.ByteString
|
||||
--- >
|
||||
--- > myDir :: [(FilePath, Data.ByteString.ByteString)]
|
||||
--- > myDir = $(embedDir "dirName")
|
||||
-embedDir :: FilePath -> Q Exp
|
||||
-embedDir fp = do
|
||||
- typ <- [t| [(FilePath, B.ByteString)] |]
|
||||
- e <- ListE <$> ((runIO $ fileList fp) >>= mapM (pairToExp fp))
|
||||
- return $ SigE e typ
|
||||
-
|
||||
-- | Get a directory tree in the IO monad.
|
||||
--
|
||||
-- This is the workhorse of 'embedDir'
|
||||
getDir :: FilePath -> IO [(FilePath, B.ByteString)]
|
||||
getDir = fileList
|
||||
|
||||
-pairToExp :: FilePath -> (FilePath, B.ByteString) -> Q Exp
|
||||
-pairToExp _root (path, bs) = do
|
||||
-#if MIN_VERSION_template_haskell(2,7,0)
|
||||
- qAddDependentFile $ _root ++ '/' : path
|
||||
-#endif
|
||||
- exp' <- bsToExp bs
|
||||
- return $! TupE [LitE $ StringL path, exp']
|
||||
-
|
||||
-bsToExp :: B.ByteString -> Q Exp
|
||||
-bsToExp bs = do
|
||||
- helper <- [| stringToBs |]
|
||||
- let chars = B8.unpack bs
|
||||
- return $! AppE helper $! LitE $! StringL chars
|
||||
-
|
||||
stringToBs :: String -> B.ByteString
|
||||
stringToBs = B8.pack
|
||||
|
||||
@@ -123,23 +68,6 @@ padSize i =
|
||||
let s = show i
|
||||
in replicate (sizeLen - length s) '0' ++ s
|
||||
|
||||
-#if MIN_VERSION_template_haskell(2,5,0)
|
||||
-dummySpace :: Int -> Q Exp
|
||||
-dummySpace space = do
|
||||
- let size = padSize space
|
||||
- let start = magic ++ size
|
||||
- let chars = LitE $ StringPrimL $
|
||||
-#if MIN_VERSION_template_haskell(2,6,0)
|
||||
- map (toEnum . fromEnum) $
|
||||
-#endif
|
||||
- start ++ replicate space '0'
|
||||
- let len = LitE $ IntegerL $ fromIntegral $ length start + space
|
||||
- upi <- [|unsafePerformIO|]
|
||||
- pack <- [|unsafePackAddressLen|]
|
||||
- getInner' <- [|getInner|]
|
||||
- return $ getInner' `AppE` (upi `AppE` (pack `AppE` len `AppE` chars))
|
||||
-#endif
|
||||
-
|
||||
inject :: B.ByteString -- ^ bs to inject
|
||||
-> B.ByteString -- ^ original BS containing dummy
|
||||
-> Maybe B.ByteString -- ^ new BS, or Nothing if there is insufficient dummy space
|
||||
--
|
||||
1.8.2.rc3
|
||||
|
|
@ -0,0 +1,25 @@
|
|||
From fdbd29ce6e8ff11f721f9e74cac1f4ca14e6773d Mon Sep 17 00:00:00 2001
|
||||
From: foo <foo@bar>
|
||||
Date: Sun, 22 Sep 2013 07:06:33 +0000
|
||||
Subject: [PATCH] export TH symbols
|
||||
|
||||
---
|
||||
Data/FileEmbed.hs | 2 ++
|
||||
1 file changed, 2 insertions(+)
|
||||
|
||||
diff --git a/Data/FileEmbed.hs b/Data/FileEmbed.hs
|
||||
index c17f082..6654f60 100644
|
||||
--- a/Data/FileEmbed.hs
|
||||
+++ b/Data/FileEmbed.hs
|
||||
@@ -26,6 +26,8 @@ module Data.FileEmbed
|
||||
#endif
|
||||
, inject
|
||||
, injectFile
|
||||
+ -- used by TH (pointlessly)
|
||||
+ , stringToBs
|
||||
) where
|
||||
|
||||
import Language.Haskell.TH.Syntax
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -0,0 +1,50 @@
|
|||
From afdec6c9e66211a0ac8419fffe191b059d1fd00c Mon Sep 17 00:00:00 2001
|
||||
From: foo <foo@bar>
|
||||
Date: Sun, 22 Sep 2013 17:24:33 +0000
|
||||
Subject: [PATCH] fix build with new base
|
||||
|
||||
---
|
||||
Data/Text/IDN/IDNA.chs | 1 +
|
||||
Data/Text/IDN/Punycode.chs | 1 +
|
||||
Data/Text/IDN/StringPrep.chs | 1 +
|
||||
3 files changed, 3 insertions(+)
|
||||
|
||||
diff --git a/Data/Text/IDN/IDNA.chs b/Data/Text/IDN/IDNA.chs
|
||||
index ed29ee4..dbb4ba5 100644
|
||||
--- a/Data/Text/IDN/IDNA.chs
|
||||
+++ b/Data/Text/IDN/IDNA.chs
|
||||
@@ -31,6 +31,7 @@ import Foreign
|
||||
import Foreign.C
|
||||
|
||||
import Data.Text.IDN.Internal
|
||||
+import System.IO.Unsafe
|
||||
|
||||
#include <idna.h>
|
||||
#include <idn-free.h>
|
||||
diff --git a/Data/Text/IDN/Punycode.chs b/Data/Text/IDN/Punycode.chs
|
||||
index 24b5fa6..4e62555 100644
|
||||
--- a/Data/Text/IDN/Punycode.chs
|
||||
+++ b/Data/Text/IDN/Punycode.chs
|
||||
@@ -32,6 +32,7 @@ import Data.List (unfoldr)
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.Text as T
|
||||
|
||||
+import System.IO.Unsafe
|
||||
import Foreign
|
||||
import Foreign.C
|
||||
|
||||
diff --git a/Data/Text/IDN/StringPrep.chs b/Data/Text/IDN/StringPrep.chs
|
||||
index 752dc9e..5e9fd84 100644
|
||||
--- a/Data/Text/IDN/StringPrep.chs
|
||||
+++ b/Data/Text/IDN/StringPrep.chs
|
||||
@@ -39,6 +39,7 @@ import qualified Data.ByteString as B
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as TE
|
||||
|
||||
+import System.IO.Unsafe
|
||||
import Foreign
|
||||
import Foreign.C
|
||||
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,23 +0,0 @@
|
|||
From 643b3c9fd95967c5911107f46498cd851e68f97d Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Tue, 7 May 2013 18:26:33 -0400
|
||||
Subject: [PATCH] fix build
|
||||
|
||||
---
|
||||
hS3.cabal | 3 ---
|
||||
1 file changed, 3 deletions(-)
|
||||
|
||||
diff --git a/hS3.cabal b/hS3.cabal
|
||||
index 35f7496..e04bf65 100644
|
||||
--- a/hS3.cabal
|
||||
+++ b/hS3.cabal
|
||||
@@ -44,6 +44,3 @@ Library
|
||||
Network.AWS.AWSConnection,
|
||||
Network.AWS.Authentication,
|
||||
Network.AWS.ArrowUtils
|
||||
-
|
||||
-Executable hs3
|
||||
- main-is: hS3.hs
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,294 +0,0 @@
|
|||
From b2c677ed39f1aca3a1111691ba51b26f7fd414a4 Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Wed, 8 May 2013 01:50:58 -0400
|
||||
Subject: [PATCH] remove TH
|
||||
|
||||
---
|
||||
Text/Hamlet.hs | 219 ++------------------------------------------------------
|
||||
hamlet.cabal | 2 +-
|
||||
2 files changed, 7 insertions(+), 214 deletions(-)
|
||||
|
||||
diff --git a/Text/Hamlet.hs b/Text/Hamlet.hs
|
||||
index 4ac870a..63b8555 100644
|
||||
--- a/Text/Hamlet.hs
|
||||
+++ b/Text/Hamlet.hs
|
||||
@@ -11,35 +11,26 @@
|
||||
module Text.Hamlet
|
||||
( -- * Plain HTML
|
||||
Html
|
||||
- , shamlet
|
||||
- , shamletFile
|
||||
- , xshamlet
|
||||
- , xshamletFile
|
||||
-- * Hamlet
|
||||
, HtmlUrl
|
||||
- , hamlet
|
||||
- , hamletFile
|
||||
- , xhamlet
|
||||
- , xhamletFile
|
||||
-- * I18N Hamlet
|
||||
, HtmlUrlI18n
|
||||
- , ihamlet
|
||||
- , ihamletFile
|
||||
-- * Type classes
|
||||
, ToAttributes (..)
|
||||
-- * Internal, for making more
|
||||
, HamletSettings (..)
|
||||
, NewlineStyle (..)
|
||||
- , hamletWithSettings
|
||||
- , hamletFileWithSettings
|
||||
, defaultHamletSettings
|
||||
, xhtmlHamletSettings
|
||||
, Env (..)
|
||||
, HamletRules (..)
|
||||
- , hamletRules
|
||||
- , ihamletRules
|
||||
- , htmlRules
|
||||
, CloseStyle (..)
|
||||
+ , condH
|
||||
+ , maybeH
|
||||
+
|
||||
+ -- referred to in TH splices
|
||||
+ , attrsToHtml
|
||||
+ , asHtmlUrl
|
||||
) where
|
||||
|
||||
import Text.Shakespeare.Base
|
||||
@@ -90,14 +81,6 @@ type HtmlUrl url = Render url -> Html
|
||||
-- | A function generating an 'Html' given a message translator and a URL rendering function.
|
||||
type HtmlUrlI18n msg url = Translate msg -> Render url -> Html
|
||||
|
||||
-docsToExp :: Env -> HamletRules -> Scope -> [Doc] -> Q Exp
|
||||
-docsToExp env hr scope docs = do
|
||||
- exps <- mapM (docToExp env hr scope) docs
|
||||
- case exps of
|
||||
- [] -> [|return ()|]
|
||||
- [x] -> return x
|
||||
- _ -> return $ DoE $ map NoBindS exps
|
||||
-
|
||||
unIdent :: Ident -> String
|
||||
unIdent (Ident s) = s
|
||||
|
||||
@@ -159,169 +142,9 @@ recordToFieldNames conStr = do
|
||||
[fields] <- return [fields | RecC name fields <- cons, name == conName]
|
||||
return [fieldName | (fieldName, _, _) <- fields]
|
||||
|
||||
-docToExp :: Env -> HamletRules -> Scope -> Doc -> Q Exp
|
||||
-docToExp env hr scope (DocForall list idents inside) = do
|
||||
- let list' = derefToExp scope list
|
||||
- (pat, extraScope) <- bindingPattern idents
|
||||
- let scope' = extraScope ++ scope
|
||||
- mh <- [|F.mapM_|]
|
||||
- inside' <- docsToExp env hr scope' inside
|
||||
- let lam = LamE [pat] inside'
|
||||
- return $ mh `AppE` lam `AppE` list'
|
||||
-docToExp env hr scope (DocWith [] inside) = do
|
||||
- inside' <- docsToExp env hr scope inside
|
||||
- return $ inside'
|
||||
-docToExp env hr scope (DocWith ((deref, idents):dis) inside) = do
|
||||
- let deref' = derefToExp scope deref
|
||||
- (pat, extraScope) <- bindingPattern idents
|
||||
- let scope' = extraScope ++ scope
|
||||
- inside' <- docToExp env hr scope' (DocWith dis inside)
|
||||
- let lam = LamE [pat] inside'
|
||||
- return $ lam `AppE` deref'
|
||||
-docToExp env hr scope (DocMaybe val idents inside mno) = do
|
||||
- let val' = derefToExp scope val
|
||||
- (pat, extraScope) <- bindingPattern idents
|
||||
- let scope' = extraScope ++ scope
|
||||
- inside' <- docsToExp env hr scope' inside
|
||||
- let inside'' = LamE [pat] inside'
|
||||
- ninside' <- case mno of
|
||||
- Nothing -> [|Nothing|]
|
||||
- Just no -> do
|
||||
- no' <- docsToExp env hr scope no
|
||||
- j <- [|Just|]
|
||||
- return $ j `AppE` no'
|
||||
- mh <- [|maybeH|]
|
||||
- return $ mh `AppE` val' `AppE` inside'' `AppE` ninside'
|
||||
-docToExp env hr scope (DocCond conds final) = do
|
||||
- conds' <- mapM go conds
|
||||
- final' <- case final of
|
||||
- Nothing -> [|Nothing|]
|
||||
- Just f -> do
|
||||
- f' <- docsToExp env hr scope f
|
||||
- j <- [|Just|]
|
||||
- return $ j `AppE` f'
|
||||
- ch <- [|condH|]
|
||||
- return $ ch `AppE` ListE conds' `AppE` final'
|
||||
- where
|
||||
- go :: (Deref, [Doc]) -> Q Exp
|
||||
- go (d, docs) = do
|
||||
- let d' = derefToExp scope d
|
||||
- docs' <- docsToExp env hr scope docs
|
||||
- return $ TupE [d', docs']
|
||||
-docToExp env hr scope (DocCase deref cases) = do
|
||||
- let exp_ = derefToExp scope deref
|
||||
- matches <- mapM toMatch cases
|
||||
- return $ CaseE exp_ matches
|
||||
- where
|
||||
- readMay s =
|
||||
- case reads s of
|
||||
- (x, ""):_ -> Just x
|
||||
- _ -> Nothing
|
||||
- toMatch (idents, inside) = do
|
||||
- let pat = case map unIdent idents of
|
||||
- ["_"] -> WildP
|
||||
- [str]
|
||||
- | Just i <- readMay str -> LitP $ IntegerL i
|
||||
- strs -> let (constr:fields) = map mkName strs
|
||||
- in ConP constr (map VarP fields)
|
||||
- insideExp <- docsToExp env hr scope inside
|
||||
- return $ Match pat (NormalB insideExp) []
|
||||
-docToExp env hr v (DocContent c) = contentToExp env hr v c
|
||||
-
|
||||
-contentToExp :: Env -> HamletRules -> Scope -> Content -> Q Exp
|
||||
-contentToExp _ hr _ (ContentRaw s) = do
|
||||
- os <- [|preEscapedText . pack|]
|
||||
- let s' = LitE $ StringL s
|
||||
- return $ hrFromHtml hr `AppE` (os `AppE` s')
|
||||
-contentToExp _ hr scope (ContentVar d) = do
|
||||
- str <- [|toHtml|]
|
||||
- return $ hrFromHtml hr `AppE` (str `AppE` derefToExp scope d)
|
||||
-contentToExp env hr scope (ContentUrl hasParams d) =
|
||||
- case urlRender env of
|
||||
- Nothing -> error "URL interpolation used, but no URL renderer provided"
|
||||
- Just wrender -> wrender $ \render -> do
|
||||
- let render' = return render
|
||||
- ou <- if hasParams
|
||||
- then [|\(u, p) -> $(render') u p|]
|
||||
- else [|\u -> $(render') u []|]
|
||||
- let d' = derefToExp scope d
|
||||
- pet <- [|toHtml|]
|
||||
- return $ hrFromHtml hr `AppE` (pet `AppE` (ou `AppE` d'))
|
||||
-contentToExp env hr scope (ContentEmbed d) = hrEmbed hr env $ derefToExp scope d
|
||||
-contentToExp env hr scope (ContentMsg d) =
|
||||
- case msgRender env of
|
||||
- Nothing -> error "Message interpolation used, but no message renderer provided"
|
||||
- Just wrender -> wrender $ \render ->
|
||||
- return $ hrFromHtml hr `AppE` (render `AppE` derefToExp scope d)
|
||||
-contentToExp _ hr scope (ContentAttrs d) = do
|
||||
- html <- [|attrsToHtml . toAttributes|]
|
||||
- return $ hrFromHtml hr `AppE` (html `AppE` derefToExp scope d)
|
||||
-
|
||||
-shamlet :: QuasiQuoter
|
||||
-shamlet = hamletWithSettings htmlRules defaultHamletSettings
|
||||
-
|
||||
-xshamlet :: QuasiQuoter
|
||||
-xshamlet = hamletWithSettings htmlRules xhtmlHamletSettings
|
||||
-
|
||||
-htmlRules :: Q HamletRules
|
||||
-htmlRules = do
|
||||
- i <- [|id|]
|
||||
- return $ HamletRules i ($ (Env Nothing Nothing)) (\_ b -> return b)
|
||||
-
|
||||
-hamlet :: QuasiQuoter
|
||||
-hamlet = hamletWithSettings hamletRules defaultHamletSettings
|
||||
-
|
||||
-xhamlet :: QuasiQuoter
|
||||
-xhamlet = hamletWithSettings hamletRules xhtmlHamletSettings
|
||||
-
|
||||
asHtmlUrl :: HtmlUrl url -> HtmlUrl url
|
||||
asHtmlUrl = id
|
||||
|
||||
-hamletRules :: Q HamletRules
|
||||
-hamletRules = do
|
||||
- i <- [|id|]
|
||||
- let ur f = do
|
||||
- r <- newName "_render"
|
||||
- let env = Env
|
||||
- { urlRender = Just ($ (VarE r))
|
||||
- , msgRender = Nothing
|
||||
- }
|
||||
- h <- f env
|
||||
- return $ LamE [VarP r] h
|
||||
- return $ HamletRules i ur em
|
||||
- where
|
||||
- em (Env (Just urender) Nothing) e = do
|
||||
- asHtmlUrl' <- [|asHtmlUrl|]
|
||||
- urender $ \ur' -> return ((asHtmlUrl' `AppE` e) `AppE` ur')
|
||||
- em _ _ = error "bad Env"
|
||||
-
|
||||
-ihamlet :: QuasiQuoter
|
||||
-ihamlet = hamletWithSettings ihamletRules defaultHamletSettings
|
||||
-
|
||||
-ihamletRules :: Q HamletRules
|
||||
-ihamletRules = do
|
||||
- i <- [|id|]
|
||||
- let ur f = do
|
||||
- u <- newName "_urender"
|
||||
- m <- newName "_mrender"
|
||||
- let env = Env
|
||||
- { urlRender = Just ($ (VarE u))
|
||||
- , msgRender = Just ($ (VarE m))
|
||||
- }
|
||||
- h <- f env
|
||||
- return $ LamE [VarP m, VarP u] h
|
||||
- return $ HamletRules i ur em
|
||||
- where
|
||||
- em (Env (Just urender) (Just mrender)) e =
|
||||
- urender $ \ur' -> mrender $ \mr -> return (e `AppE` mr `AppE` ur')
|
||||
- em _ _ = error "bad Env"
|
||||
-
|
||||
-hamletWithSettings :: Q HamletRules -> HamletSettings -> QuasiQuoter
|
||||
-hamletWithSettings hr set =
|
||||
- QuasiQuoter
|
||||
- { quoteExp = hamletFromString hr set
|
||||
- }
|
||||
-
|
||||
data HamletRules = HamletRules
|
||||
{ hrFromHtml :: Exp
|
||||
, hrWithEnv :: (Env -> Q Exp) -> Q Exp
|
||||
@@ -333,36 +156,6 @@ data Env = Env
|
||||
, msgRender :: Maybe ((Exp -> Q Exp) -> Q Exp)
|
||||
}
|
||||
|
||||
-hamletFromString :: Q HamletRules -> HamletSettings -> String -> Q Exp
|
||||
-hamletFromString qhr set s = do
|
||||
- hr <- qhr
|
||||
- case parseDoc set s of
|
||||
- Error s' -> error s'
|
||||
- Ok (_mnl, d) -> hrWithEnv hr $ \env -> docsToExp env hr [] d
|
||||
-
|
||||
-hamletFileWithSettings :: Q HamletRules -> HamletSettings -> FilePath -> Q Exp
|
||||
-hamletFileWithSettings qhr set fp = do
|
||||
-#ifdef GHC_7_4
|
||||
- qAddDependentFile fp
|
||||
-#endif
|
||||
- contents <- fmap TL.unpack $ qRunIO $ readUtf8File fp
|
||||
- hamletFromString qhr set contents
|
||||
-
|
||||
-hamletFile :: FilePath -> Q Exp
|
||||
-hamletFile = hamletFileWithSettings hamletRules defaultHamletSettings
|
||||
-
|
||||
-xhamletFile :: FilePath -> Q Exp
|
||||
-xhamletFile = hamletFileWithSettings hamletRules xhtmlHamletSettings
|
||||
-
|
||||
-shamletFile :: FilePath -> Q Exp
|
||||
-shamletFile = hamletFileWithSettings htmlRules defaultHamletSettings
|
||||
-
|
||||
-xshamletFile :: FilePath -> Q Exp
|
||||
-xshamletFile = hamletFileWithSettings htmlRules xhtmlHamletSettings
|
||||
-
|
||||
-ihamletFile :: FilePath -> Q Exp
|
||||
-ihamletFile = hamletFileWithSettings ihamletRules defaultHamletSettings
|
||||
-
|
||||
varName :: Scope -> String -> Exp
|
||||
varName _ "" = error "Illegal empty varName"
|
||||
varName scope v@(_:_) = fromMaybe (strToExp v) $ lookup (Ident v) scope
|
||||
diff --git a/hamlet.cabal b/hamlet.cabal
|
||||
index 73fa6a8..4348508 100644
|
||||
--- a/hamlet.cabal
|
||||
+++ b/hamlet.cabal
|
||||
@@ -50,7 +50,7 @@ library
|
||||
, text >= 0.7 && < 0.12
|
||||
, containers >= 0.2
|
||||
, blaze-builder >= 0.2 && < 0.4
|
||||
- , process >= 1.0 && < 1.2
|
||||
+ , process >= 1.0 && < 1.3
|
||||
, blaze-html >= 0.5 && < 0.6
|
||||
, blaze-markup >= 0.5.1 && < 0.6
|
||||
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -0,0 +1,28 @@
|
|||
From 9819f4b387679c889f1259f9fd969513aa2efcf2 Mon Sep 17 00:00:00 2001
|
||||
From: foo <foo@bar>
|
||||
Date: Sun, 22 Sep 2013 03:51:06 +0000
|
||||
Subject: [PATCH] export TH splice stuff
|
||||
|
||||
---
|
||||
Text/Hamlet.hs | 5 +++++
|
||||
1 file changed, 5 insertions(+)
|
||||
|
||||
diff --git a/Text/Hamlet.hs b/Text/Hamlet.hs
|
||||
index 6568d6c..687dec4 100644
|
||||
--- a/Text/Hamlet.hs
|
||||
+++ b/Text/Hamlet.hs
|
||||
@@ -40,6 +40,11 @@ module Text.Hamlet
|
||||
, ihamletRules
|
||||
, htmlRules
|
||||
, CloseStyle (..)
|
||||
+ -- referred to by TH splices
|
||||
+ , asHtmlUrl
|
||||
+ , maybeH
|
||||
+ , condH
|
||||
+ , attrsToHtml
|
||||
) where
|
||||
|
||||
import Text.Shakespeare.Base
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,27 +1,30 @@
|
|||
From bbb49942123f06a36b170966e445692297f71d26 Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Thu, 18 Apr 2013 19:14:30 -0400
|
||||
Subject: [PATCH] build without TH
|
||||
From 3141355f14d6acb9382bebcf8723c411be5aa62f Mon Sep 17 00:00:00 2001
|
||||
From: foo <foo@bar>
|
||||
Date: Sun, 22 Sep 2013 00:31:39 +0000
|
||||
Subject: [PATCH] various hacking to cross build
|
||||
|
||||
---
|
||||
lens.cabal | 13 +------------
|
||||
src/Control/Exception/Lens.hs | 2 +-
|
||||
src/Control/Lens.hs | 6 +++---
|
||||
src/Control/Lens/Equality.hs | 4 ++--
|
||||
src/Control/Lens/Fold.hs | 6 +++---
|
||||
src/Control/Lens/Internal.hs | 2 +-
|
||||
src/Control/Lens/Internal/Zipper.hs | 2 +-
|
||||
src/Control/Lens/Iso.hs | 2 --
|
||||
src/Control/Lens/Lens.hs | 2 +-
|
||||
src/Control/Lens/Operators.hs | 2 +-
|
||||
src/Control/Lens/Plated.hs | 2 +-
|
||||
src/Control/Lens/Setter.hs | 2 --
|
||||
src/Control/Lens/TH.hs | 2 +-
|
||||
src/Data/Data/Lens.hs | 6 +++---
|
||||
14 files changed, 19 insertions(+), 34 deletions(-)
|
||||
lens.cabal | 12 +-----------
|
||||
src/Control/Exception/Lens.hs | 2 +-
|
||||
src/Control/Lens.hs | 6 +++---
|
||||
src/Control/Lens/Equality.hs | 4 ++--
|
||||
src/Control/Lens/Fold.hs | 6 +++---
|
||||
src/Control/Lens/Internal.hs | 2 +-
|
||||
src/Control/Lens/Internal/Exception.hs | 26 +-------------------------
|
||||
src/Control/Lens/Internal/Instances.hs | 14 --------------
|
||||
src/Control/Lens/Internal/Zipper.hs | 2 +-
|
||||
src/Control/Lens/Iso.hs | 2 --
|
||||
src/Control/Lens/Lens.hs | 2 +-
|
||||
src/Control/Lens/Operators.hs | 2 +-
|
||||
src/Control/Lens/Plated.hs | 2 +-
|
||||
src/Control/Lens/Prism.hs | 2 --
|
||||
src/Control/Lens/Setter.hs | 2 --
|
||||
src/Control/Lens/TH.hs | 2 +-
|
||||
src/Data/Data/Lens.hs | 6 +++---
|
||||
17 files changed, 20 insertions(+), 74 deletions(-)
|
||||
|
||||
diff --git a/lens.cabal b/lens.cabal
|
||||
index a06b3ce..a654b3d 100644
|
||||
index 2a94e1e..1f9a4b7 100644
|
||||
--- a/lens.cabal
|
||||
+++ b/lens.cabal
|
||||
@@ -10,7 +10,7 @@ stability: provisional
|
||||
|
@ -33,15 +36,7 @@ index a06b3ce..a654b3d 100644
|
|||
tested-with: GHC == 7.0.4, GHC == 7.4.1, GHC == 7.4.2, GHC == 7.6.1, GHC == 7.7.20121213, GHC == 7.7.20130117
|
||||
synopsis: Lenses, Folds and Traversals
|
||||
description:
|
||||
@@ -171,7 +171,6 @@ library
|
||||
containers >= 0.4.0 && < 0.6,
|
||||
distributive >= 0.3 && < 1,
|
||||
filepath >= 1.2.0.0 && < 1.4,
|
||||
- generic-deriving == 1.4.*,
|
||||
ghc-prim,
|
||||
hashable >= 1.1.2.3 && < 1.3,
|
||||
MonadCatchIO-transformers >= 0.3 && < 0.4,
|
||||
@@ -233,14 +232,12 @@ library
|
||||
@@ -238,14 +238,12 @@ library
|
||||
Control.Lens.Review
|
||||
Control.Lens.Setter
|
||||
Control.Lens.Simple
|
||||
|
@ -56,7 +51,7 @@ index a06b3ce..a654b3d 100644
|
|||
Control.Parallel.Strategies.Lens
|
||||
Control.Seq.Lens
|
||||
Data.Array.Lens
|
||||
@@ -264,12 +261,8 @@ library
|
||||
@@ -269,12 +267,8 @@ library
|
||||
Data.Typeable.Lens
|
||||
Data.Vector.Lens
|
||||
Data.Vector.Generic.Lens
|
||||
|
@ -69,7 +64,7 @@ index a06b3ce..a654b3d 100644
|
|||
Numeric.Lens
|
||||
|
||||
if flag(safe)
|
||||
@@ -368,7 +361,6 @@ test-suite doctests
|
||||
@@ -373,7 +367,6 @@ test-suite doctests
|
||||
deepseq,
|
||||
doctest >= 0.9.1,
|
||||
filepath,
|
||||
|
@ -77,7 +72,7 @@ index a06b3ce..a654b3d 100644
|
|||
mtl,
|
||||
nats,
|
||||
parallel,
|
||||
@@ -394,7 +386,6 @@ benchmark plated
|
||||
@@ -399,7 +392,6 @@ benchmark plated
|
||||
comonad,
|
||||
criterion,
|
||||
deepseq,
|
||||
|
@ -85,7 +80,7 @@ index a06b3ce..a654b3d 100644
|
|||
lens,
|
||||
transformers
|
||||
|
||||
@@ -429,7 +420,6 @@ benchmark unsafe
|
||||
@@ -434,7 +426,6 @@ benchmark unsafe
|
||||
comonads-fd,
|
||||
criterion,
|
||||
deepseq,
|
||||
|
@ -93,7 +88,7 @@ index a06b3ce..a654b3d 100644
|
|||
lens,
|
||||
transformers
|
||||
|
||||
@@ -446,6 +436,5 @@ benchmark zipper
|
||||
@@ -451,6 +442,5 @@ benchmark zipper
|
||||
comonads-fd,
|
||||
criterion,
|
||||
deepseq,
|
||||
|
@ -101,7 +96,7 @@ index a06b3ce..a654b3d 100644
|
|||
lens,
|
||||
transformers
|
||||
diff --git a/src/Control/Exception/Lens.hs b/src/Control/Exception/Lens.hs
|
||||
index 5c26d4e..9909132 100644
|
||||
index 4bc3926..28f55be 100644
|
||||
--- a/src/Control/Exception/Lens.hs
|
||||
+++ b/src/Control/Exception/Lens.hs
|
||||
@@ -112,7 +112,7 @@ import Prelude
|
||||
|
@ -114,7 +109,7 @@ index 5c26d4e..9909132 100644
|
|||
-- $setup
|
||||
-- >>> :set -XNoOverloadedStrings
|
||||
diff --git a/src/Control/Lens.hs b/src/Control/Lens.hs
|
||||
index 8481e44..74700ae 100644
|
||||
index 242c3c1..2ab9cdb 100644
|
||||
--- a/src/Control/Lens.hs
|
||||
+++ b/src/Control/Lens.hs
|
||||
@@ -59,7 +59,7 @@ module Control.Lens
|
||||
|
@ -157,10 +152,10 @@ index 982c2d7..3a3fe1a 100644
|
|||
-- $setup
|
||||
-- >>> import Control.Lens
|
||||
diff --git a/src/Control/Lens/Fold.hs b/src/Control/Lens/Fold.hs
|
||||
index ae5100d..467eb37 100644
|
||||
index 32a4073..cc7da1e 100644
|
||||
--- a/src/Control/Lens/Fold.hs
|
||||
+++ b/src/Control/Lens/Fold.hs
|
||||
@@ -161,9 +161,9 @@ import Data.Traversable
|
||||
@@ -163,9 +163,9 @@ import Data.Traversable
|
||||
-- >>> let g :: Expr -> Expr; g = Debug.SimpleReflect.Vars.g
|
||||
-- >>> let timingOut :: NFData a => a -> IO a; timingOut = fmap (fromMaybe (error "timeout")) . timeout (5*10^6) . evaluate . force
|
||||
|
||||
|
@ -183,6 +178,90 @@ index 295662e..539642d 100644
|
|||
|
||||
-{-# ANN module "HLint: ignore Use import/export shortcut" #-}
|
||||
+
|
||||
diff --git a/src/Control/Lens/Internal/Exception.hs b/src/Control/Lens/Internal/Exception.hs
|
||||
index 387203e..8bea89b 100644
|
||||
--- a/src/Control/Lens/Internal/Exception.hs
|
||||
+++ b/src/Control/Lens/Internal/Exception.hs
|
||||
@@ -36,6 +36,7 @@ import Data.Monoid
|
||||
import Data.Proxy
|
||||
import Data.Reflection
|
||||
import Data.Typeable
|
||||
+import Data.Typeable
|
||||
import System.IO.Unsafe
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
@@ -128,18 +129,6 @@ class Handleable e (m :: * -> *) (h :: * -> *) | h -> e m where
|
||||
handler_ l = handler l . const
|
||||
{-# INLINE handler_ #-}
|
||||
|
||||
-instance Handleable SomeException IO Exception.Handler where
|
||||
- handler = handlerIO
|
||||
-
|
||||
-instance Handleable SomeException m (CatchIO.Handler m) where
|
||||
- handler = handlerCatchIO
|
||||
-
|
||||
-handlerIO :: forall a r. Getting (First a) SomeException a -> (a -> IO r) -> Exception.Handler r
|
||||
-handlerIO l f = reify (preview l) $ \ (_ :: Proxy s) -> Exception.Handler (\(Handling a :: Handling a s IO) -> f a)
|
||||
-
|
||||
-handlerCatchIO :: forall m a r. Getting (First a) SomeException a -> (a -> m r) -> CatchIO.Handler m r
|
||||
-handlerCatchIO l f = reify (preview l) $ \ (_ :: Proxy s) -> CatchIO.Handler (\(Handling a :: Handling a s m) -> f a)
|
||||
-
|
||||
------------------------------------------------------------------------------
|
||||
-- Helpers
|
||||
------------------------------------------------------------------------------
|
||||
@@ -159,21 +148,8 @@ supply = unsafePerformIO $ newIORef 0
|
||||
-- | This permits the construction of an \"impossible\" 'Control.Exception.Handler' that matches only if some function does.
|
||||
newtype Handling a s (m :: * -> *) = Handling a
|
||||
|
||||
--- the m parameter exists simply to break the Typeable1 pattern, so we can provide this without overlap.
|
||||
--- here we simply generate a fresh TypeRep so we'll fail to compare as equal to any other TypeRep.
|
||||
-instance Typeable (Handling a s m) where
|
||||
- typeOf _ = unsafePerformIO $ do
|
||||
- i <- atomicModifyIORef supply $ \a -> let a' = a + 1 in a' `seq` (a', a)
|
||||
- return $ mkTyConApp (mkTyCon3 "lens" "Control.Lens.Internal.Exception" ("Handling" ++ show i)) []
|
||||
- {-# INLINE typeOf #-}
|
||||
-
|
||||
-- The @Handling@ wrapper is uninteresting, and should never be thrown, so you won't get much benefit here.
|
||||
instance Show (Handling a s m) where
|
||||
showsPrec d _ = showParen (d > 10) $ showString "Handling ..."
|
||||
{-# INLINE showsPrec #-}
|
||||
|
||||
-instance Reifies s (SomeException -> Maybe a) => Exception (Handling a s m) where
|
||||
- toException _ = SomeException HandlingException
|
||||
- {-# INLINE toException #-}
|
||||
- fromException = fmap Handling . reflect (Proxy :: Proxy s)
|
||||
- {-# INLINE fromException #-}
|
||||
diff --git a/src/Control/Lens/Internal/Instances.hs b/src/Control/Lens/Internal/Instances.hs
|
||||
index 6783f33..17715ce 100644
|
||||
--- a/src/Control/Lens/Internal/Instances.hs
|
||||
+++ b/src/Control/Lens/Internal/Instances.hs
|
||||
@@ -24,26 +24,12 @@ import Data.Traversable
|
||||
-- Orphan Instances
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
-instance Foldable ((,) b) where
|
||||
- foldMap f (_, a) = f a
|
||||
-
|
||||
instance Foldable1 ((,) b) where
|
||||
foldMap1 f (_, a) = f a
|
||||
|
||||
-instance Traversable ((,) b) where
|
||||
- traverse f (b, a) = (,) b <$> f a
|
||||
-
|
||||
instance Traversable1 ((,) b) where
|
||||
traverse1 f (b, a) = (,) b <$> f a
|
||||
|
||||
-instance Foldable (Either a) where
|
||||
- foldMap _ (Left _) = mempty
|
||||
- foldMap f (Right a) = f a
|
||||
-
|
||||
-instance Traversable (Either a) where
|
||||
- traverse _ (Left b) = pure (Left b)
|
||||
- traverse f (Right a) = Right <$> f a
|
||||
-
|
||||
instance Foldable (Const m) where
|
||||
foldMap _ _ = mempty
|
||||
|
||||
diff --git a/src/Control/Lens/Internal/Zipper.hs b/src/Control/Lens/Internal/Zipper.hs
|
||||
index 95875b7..76060be 100644
|
||||
--- a/src/Control/Lens/Internal/Zipper.hs
|
||||
|
@ -197,12 +276,12 @@ index 95875b7..76060be 100644
|
|||
------------------------------------------------------------------------------
|
||||
-- * Jacket
|
||||
diff --git a/src/Control/Lens/Iso.hs b/src/Control/Lens/Iso.hs
|
||||
index 62d40ef..235511a 100644
|
||||
index 1152af4..80c3175 100644
|
||||
--- a/src/Control/Lens/Iso.hs
|
||||
+++ b/src/Control/Lens/Iso.hs
|
||||
@@ -70,8 +70,6 @@ import Data.Profunctor.Unsafe
|
||||
import Unsafe.Coerce
|
||||
#endif
|
||||
@@ -82,8 +82,6 @@ import Data.Maybe
|
||||
import Data.Profunctor
|
||||
import Data.Profunctor.Unsafe
|
||||
|
||||
-{-# ANN module "HLint: ignore Use on" #-}
|
||||
-
|
||||
|
@ -210,12 +289,12 @@ index 62d40ef..235511a 100644
|
|||
-- >>> :set -XNoOverloadedStrings
|
||||
-- >>> import Control.Lens
|
||||
diff --git a/src/Control/Lens/Lens.hs b/src/Control/Lens/Lens.hs
|
||||
index ff2a45f..5401ec4 100644
|
||||
index b26cc06..6f84943 100644
|
||||
--- a/src/Control/Lens/Lens.hs
|
||||
+++ b/src/Control/Lens/Lens.hs
|
||||
@@ -120,7 +120,7 @@ import Data.Profunctor
|
||||
import Data.Profunctor.Rep
|
||||
@@ -126,7 +126,7 @@ import Data.Profunctor.Rep
|
||||
import Data.Profunctor.Unsafe
|
||||
import Data.Void
|
||||
|
||||
-{-# ANN module "HLint: ignore Use ***" #-}
|
||||
+
|
||||
|
@ -223,17 +302,17 @@ index ff2a45f..5401ec4 100644
|
|||
-- $setup
|
||||
-- >>> :set -XNoOverloadedStrings
|
||||
diff --git a/src/Control/Lens/Operators.hs b/src/Control/Lens/Operators.hs
|
||||
index d88cb49..fa7b37e 100644
|
||||
index 11868e0..475c945 100644
|
||||
--- a/src/Control/Lens/Operators.hs
|
||||
+++ b/src/Control/Lens/Operators.hs
|
||||
@@ -107,4 +107,4 @@ import Control.Lens.Review
|
||||
@@ -108,4 +108,4 @@ import Control.Lens.Review
|
||||
import Control.Lens.Setter
|
||||
import Control.Lens.Zipper
|
||||
|
||||
-{-# ANN module "HLint: ignore Use import/export shortcut" #-}
|
||||
+
|
||||
diff --git a/src/Control/Lens/Plated.hs b/src/Control/Lens/Plated.hs
|
||||
index 07d9212..27070c0 100644
|
||||
index a8c4d20..cef574e 100644
|
||||
--- a/src/Control/Lens/Plated.hs
|
||||
+++ b/src/Control/Lens/Plated.hs
|
||||
@@ -95,7 +95,7 @@ import Data.Data.Lens
|
||||
|
@ -245,6 +324,19 @@ index 07d9212..27070c0 100644
|
|||
|
||||
-- | A 'Plated' type is one where we know how to extract its immediate self-similar children.
|
||||
--
|
||||
diff --git a/src/Control/Lens/Prism.hs b/src/Control/Lens/Prism.hs
|
||||
index 45b5cfe..88c7ff9 100644
|
||||
--- a/src/Control/Lens/Prism.hs
|
||||
+++ b/src/Control/Lens/Prism.hs
|
||||
@@ -53,8 +53,6 @@ import Unsafe.Coerce
|
||||
import Data.Profunctor.Unsafe
|
||||
#endif
|
||||
|
||||
-{-# ANN module "HLint: ignore Use camelCase" #-}
|
||||
-
|
||||
-- $setup
|
||||
-- >>> :set -XNoOverloadedStrings
|
||||
-- >>> import Control.Lens
|
||||
diff --git a/src/Control/Lens/Setter.hs b/src/Control/Lens/Setter.hs
|
||||
index 2acbfa6..4a12c6b 100644
|
||||
--- a/src/Control/Lens/Setter.hs
|
||||
|
@ -259,7 +351,7 @@ index 2acbfa6..4a12c6b 100644
|
|||
-- >>> import Control.Lens
|
||||
-- >>> import Control.Monad.State
|
||||
diff --git a/src/Control/Lens/TH.hs b/src/Control/Lens/TH.hs
|
||||
index fbf4adb..ee723d7 100644
|
||||
index a05eb07..49218b5 100644
|
||||
--- a/src/Control/Lens/TH.hs
|
||||
+++ b/src/Control/Lens/TH.hs
|
||||
@@ -87,7 +87,7 @@ import Language.Haskell.TH
|
||||
|
@ -289,5 +381,5 @@ index cf1e7c9..b39dacf 100644
|
|||
-- $setup
|
||||
-- >>> :set -XNoOverloadedStrings
|
||||
--
|
||||
1.8.2.rc3
|
||||
1.7.10.4
|
||||
|
|
@ -1,27 +0,0 @@
|
|||
From 9d53e3fa4516a948a6e84987e9c1c9fd07f973bf Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Sun, 21 Apr 2013 15:44:51 -0400
|
||||
Subject: [PATCH] static link with libxml2
|
||||
|
||||
This requires libxml2.a (and no .so) be installed in the ugly hardcoded
|
||||
lib dir. When built this way, the haskell library will link the
|
||||
C library into executables with no further options.
|
||||
---
|
||||
libxml-sax.cabal | 1 +
|
||||
1 file changed, 1 insertion(+)
|
||||
|
||||
diff --git a/libxml-sax.cabal b/libxml-sax.cabal
|
||||
index 5edfdb6..338bc55 100644
|
||||
--- a/libxml-sax.cabal
|
||||
+++ b/libxml-sax.cabal
|
||||
@@ -31,6 +31,7 @@ library
|
||||
hs-source-dirs: lib
|
||||
ghc-options: -Wall -O2
|
||||
cc-options: -Wall
|
||||
+ LD-Options: -L /home/joey/.ghc/android-14/arm-linux-androideabi-4.7/arm-linux-androideabi/sysroot/usr/lib/
|
||||
|
||||
build-depends:
|
||||
base >= 4.1 && < 5.0
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,163 +0,0 @@
|
|||
From 4bb0de1e6213ec925820c8b9cc3ff5f3c3c72d7a Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Thu, 28 Feb 2013 23:31:27 -0400
|
||||
Subject: [PATCH] hacked for newer ghc
|
||||
|
||||
---
|
||||
Control/Concurrent/Lifted.hs | 2 +-
|
||||
Control/Exception/Lifted.hs | 11 ++--------
|
||||
Setup.hs | 46 ++----------------------------------------
|
||||
lifted-base.cabal | 9 ++++-----
|
||||
4 files changed, 9 insertions(+), 59 deletions(-)
|
||||
|
||||
diff --git a/Control/Concurrent/Lifted.hs b/Control/Concurrent/Lifted.hs
|
||||
index 4bc58a8..e4445e6 100644
|
||||
--- a/Control/Concurrent/Lifted.hs
|
||||
+++ b/Control/Concurrent/Lifted.hs
|
||||
@@ -124,7 +124,7 @@ import Control.Concurrent.SampleVar.Lifted
|
||||
#endif
|
||||
import Control.Exception.Lifted ( throwTo
|
||||
#if MIN_VERSION_base(4,6,0)
|
||||
- , SomeException, try, mask
|
||||
+ , SomeException, try
|
||||
#endif
|
||||
)
|
||||
#include "inlinable.h"
|
||||
diff --git a/Control/Exception/Lifted.hs b/Control/Exception/Lifted.hs
|
||||
index 871cda7..0b9d8b7 100644
|
||||
--- a/Control/Exception/Lifted.hs
|
||||
+++ b/Control/Exception/Lifted.hs
|
||||
@@ -50,8 +50,8 @@ module Control.Exception.Lifted
|
||||
-- |The following functions allow a thread to control delivery of
|
||||
-- asynchronous exceptions during a critical region.
|
||||
#if MIN_VERSION_base(4,3,0)
|
||||
- , mask, mask_
|
||||
- , uninterruptibleMask, uninterruptibleMask_
|
||||
+ , mask_
|
||||
+ , uninterruptibleMask_
|
||||
, getMaskingState
|
||||
#if MIN_VERSION_base(4,4,0)
|
||||
, allowInterrupt
|
||||
@@ -266,10 +266,6 @@ evaluate = liftBase ∘ E.evaluate
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
#if MIN_VERSION_base(4,3,0)
|
||||
--- |Generalized version of 'E.mask'.
|
||||
-mask ∷ MonadBaseControl IO m ⇒ ((∀ a. m a → m a) → m b) → m b
|
||||
-mask = liftBaseOp E.mask ∘ liftRestore
|
||||
-{-# INLINABLE mask #-}
|
||||
|
||||
liftRestore ∷ MonadBaseControl IO m
|
||||
⇒ ((∀ a. m a → m a) → b)
|
||||
@@ -283,9 +279,6 @@ mask_ = liftBaseOp_ E.mask_
|
||||
{-# INLINABLE mask_ #-}
|
||||
|
||||
-- |Generalized version of 'E.uninterruptibleMask'.
|
||||
-uninterruptibleMask ∷ MonadBaseControl IO m ⇒ ((∀ a. m a → m a) → m b) → m b
|
||||
-uninterruptibleMask = liftBaseOp E.uninterruptibleMask ∘ liftRestore
|
||||
-{-# INLINABLE uninterruptibleMask #-}
|
||||
|
||||
-- |Generalized version of 'E.uninterruptibleMask_'.
|
||||
uninterruptibleMask_ ∷ MonadBaseControl IO m ⇒ m a → m a
|
||||
diff --git a/Setup.hs b/Setup.hs
|
||||
index 33956e1..9a994af 100644
|
||||
--- a/Setup.hs
|
||||
+++ b/Setup.hs
|
||||
@@ -1,44 +1,2 @@
|
||||
-#! /usr/bin/env runhaskell
|
||||
-
|
||||
-{-# LANGUAGE NoImplicitPrelude, UnicodeSyntax #-}
|
||||
-
|
||||
-module Main (main) where
|
||||
-
|
||||
-
|
||||
--------------------------------------------------------------------------------
|
||||
--- Imports
|
||||
--------------------------------------------------------------------------------
|
||||
-
|
||||
--- from base
|
||||
-import System.IO ( IO )
|
||||
-
|
||||
--- from cabal
|
||||
-import Distribution.Simple ( defaultMainWithHooks
|
||||
- , simpleUserHooks
|
||||
- , UserHooks(haddockHook)
|
||||
- )
|
||||
-
|
||||
-import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..) )
|
||||
-import Distribution.Simple.Program ( userSpecifyArgs )
|
||||
-import Distribution.Simple.Setup ( HaddockFlags )
|
||||
-import Distribution.PackageDescription ( PackageDescription(..) )
|
||||
-
|
||||
-
|
||||
--------------------------------------------------------------------------------
|
||||
--- Cabal setup program which sets the CPP define '__HADDOCK __' when haddock is run.
|
||||
--------------------------------------------------------------------------------
|
||||
-
|
||||
-main ∷ IO ()
|
||||
-main = defaultMainWithHooks hooks
|
||||
- where
|
||||
- hooks = simpleUserHooks { haddockHook = haddockHook' }
|
||||
-
|
||||
--- Define __HADDOCK__ for CPP when running haddock.
|
||||
-haddockHook' ∷ PackageDescription → LocalBuildInfo → UserHooks → HaddockFlags → IO ()
|
||||
-haddockHook' pkg lbi =
|
||||
- haddockHook simpleUserHooks pkg (lbi { withPrograms = p })
|
||||
- where
|
||||
- p = userSpecifyArgs "haddock" ["--optghc=-D__HADDOCK__"] (withPrograms lbi)
|
||||
-
|
||||
-
|
||||
--- The End ---------------------------------------------------------------------
|
||||
+import Distribution.Simple
|
||||
+main = defaultMain
|
||||
diff --git a/lifted-base.cabal b/lifted-base.cabal
|
||||
index 54ef418..8da5086 100644
|
||||
--- a/lifted-base.cabal
|
||||
+++ b/lifted-base.cabal
|
||||
@@ -9,7 +9,7 @@ Copyright: (c) 2011-2012 Bas van Dijk, Anders Kaseorg
|
||||
Homepage: https://github.com/basvandijk/lifted-base
|
||||
Bug-reports: https://github.com/basvandijk/lifted-base/issues
|
||||
Category: Control
|
||||
-Build-type: Custom
|
||||
+Build-type: Simple
|
||||
Cabal-version: >= 1.9.2
|
||||
Description: @lifted-base@ exports IO operations from the base library lifted to
|
||||
any instance of 'MonadBase' or 'MonadBaseControl'.
|
||||
@@ -37,7 +37,6 @@ Library
|
||||
Exposed-modules: Control.Exception.Lifted
|
||||
Control.Concurrent.MVar.Lifted
|
||||
Control.Concurrent.Chan.Lifted
|
||||
- Control.Concurrent.Lifted
|
||||
Data.IORef.Lifted
|
||||
System.Timeout.Lifted
|
||||
if impl(ghc < 7.6)
|
||||
@@ -46,7 +45,7 @@ Library
|
||||
Control.Concurrent.QSemN.Lifted
|
||||
Control.Concurrent.SampleVar.Lifted
|
||||
|
||||
- Build-depends: base >= 3 && < 4.7
|
||||
+ Build-depends: base >= 3 && < 4.8
|
||||
, base-unicode-symbols >= 0.1.1 && < 0.3
|
||||
, transformers-base >= 0.4 && < 0.5
|
||||
, monad-control >= 0.3 && < 0.4
|
||||
@@ -64,7 +63,7 @@ test-suite test-lifted-base
|
||||
hs-source-dirs: test
|
||||
|
||||
build-depends: lifted-base
|
||||
- , base >= 3 && < 4.7
|
||||
+ , base >= 3 && < 4.8
|
||||
, transformers >= 0.2 && < 0.4
|
||||
, transformers-base >= 0.4 && < 0.5
|
||||
, monad-control >= 0.3 && < 0.4
|
||||
@@ -87,7 +86,7 @@ benchmark bench-lifted-base
|
||||
ghc-options: -O2
|
||||
|
||||
build-depends: lifted-base
|
||||
- , base >= 3 && < 4.7
|
||||
+ , base >= 3 && < 4.8
|
||||
, transformers >= 0.2 && < 0.4
|
||||
, criterion >= 0.5 && < 0.7
|
||||
, monad-control >= 0.3 && < 0.4
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -0,0 +1,25 @@
|
|||
From 8a98fa29048b508c64d5bb1e03ef89bfad8adc01 Mon Sep 17 00:00:00 2001
|
||||
From: foo <foo@bar>
|
||||
Date: Sat, 21 Sep 2013 21:34:17 +0000
|
||||
Subject: [PATCH] crossbuild
|
||||
|
||||
---
|
||||
lifted-base.cabal | 2 +-
|
||||
1 file changed, 1 insertion(+), 1 deletion(-)
|
||||
|
||||
diff --git a/lifted-base.cabal b/lifted-base.cabal
|
||||
index 24f2860..3bef225 100644
|
||||
--- a/lifted-base.cabal
|
||||
+++ b/lifted-base.cabal
|
||||
@@ -9,7 +9,7 @@ Copyright: (c) 2011-2012 Bas van Dijk, Anders Kaseorg
|
||||
Homepage: https://github.com/basvandijk/lifted-base
|
||||
Bug-reports: https://github.com/basvandijk/lifted-base/issues
|
||||
Category: Control
|
||||
-Build-type: Custom
|
||||
+Build-type: Simple
|
||||
Cabal-version: >= 1.8
|
||||
Description: @lifted-base@ exports IO operations from the base library lifted to
|
||||
any instance of 'MonadBase' or 'MonadBaseControl'.
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,25 +0,0 @@
|
|||
From 3dde0175096903207c9774d8f6bba9b81ab6c2f9 Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Thu, 28 Feb 2013 23:31:45 -0400
|
||||
Subject: [PATCH] build with newer ghc
|
||||
|
||||
---
|
||||
monad-control.cabal | 2 +-
|
||||
1 file changed, 1 insertion(+), 1 deletion(-)
|
||||
|
||||
diff --git a/monad-control.cabal b/monad-control.cabal
|
||||
index 2e3eb46..b12ffaf 100644
|
||||
--- a/monad-control.cabal
|
||||
+++ b/monad-control.cabal
|
||||
@@ -56,7 +56,7 @@ Library
|
||||
|
||||
Exposed-modules: Control.Monad.Trans.Control
|
||||
|
||||
- Build-depends: base >= 3 && < 4.7
|
||||
+ Build-depends: base >= 3 && < 4.8
|
||||
, base-unicode-symbols >= 0.1.1 && < 0.3
|
||||
, transformers >= 0.2 && < 0.4
|
||||
, transformers-base >= 0.4.1 && < 0.5
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,124 +0,0 @@
|
|||
From ca88563e63cc31f0b96b00d3a4fe1f0c56b1e1eb Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Thu, 28 Feb 2013 23:32:01 -0400
|
||||
Subject: [PATCH] remove TH logging stuff
|
||||
|
||||
---
|
||||
Control/Monad/Logger.hs | 76 -----------------------------------------------
|
||||
monad-logger.cabal | 2 +-
|
||||
2 files changed, 1 insertion(+), 77 deletions(-)
|
||||
|
||||
diff --git a/Control/Monad/Logger.hs b/Control/Monad/Logger.hs
|
||||
index fd1282b..80b8ed9 100644
|
||||
--- a/Control/Monad/Logger.hs
|
||||
+++ b/Control/Monad/Logger.hs
|
||||
@@ -27,18 +27,6 @@ module Control.Monad.Logger
|
||||
, LoggingT (..)
|
||||
, runStderrLoggingT
|
||||
, runStdoutLoggingT
|
||||
- -- * TH logging
|
||||
- , logDebug
|
||||
- , logInfo
|
||||
- , logWarn
|
||||
- , logError
|
||||
- , logOther
|
||||
- -- * TH logging with source
|
||||
- , logDebugS
|
||||
- , logInfoS
|
||||
- , logWarnS
|
||||
- , logErrorS
|
||||
- , logOtherS
|
||||
) where
|
||||
|
||||
import Language.Haskell.TH.Syntax (Lift (lift), Q, Exp, Loc (..), qLocation)
|
||||
@@ -91,13 +79,6 @@ import Control.Monad.Writer.Class ( MonadWriter (..) )
|
||||
data LogLevel = LevelDebug | LevelInfo | LevelWarn | LevelError | LevelOther Text
|
||||
deriving (Eq, Prelude.Show, Prelude.Read, Ord)
|
||||
|
||||
-instance Lift LogLevel where
|
||||
- lift LevelDebug = [|LevelDebug|]
|
||||
- lift LevelInfo = [|LevelInfo|]
|
||||
- lift LevelWarn = [|LevelWarn|]
|
||||
- lift LevelError = [|LevelError|]
|
||||
- lift (LevelOther x) = [|LevelOther $ pack $(lift $ unpack x)|]
|
||||
-
|
||||
type LogSource = Text
|
||||
|
||||
class Monad m => MonadLogger m where
|
||||
@@ -128,63 +109,6 @@ instance (MonadLogger m, Monoid w) => MonadLogger (Strict.WriterT w m) where DEF
|
||||
instance (MonadLogger m, Monoid w) => MonadLogger (Strict.RWST r w s m) where DEF
|
||||
#undef DEF
|
||||
|
||||
-logTH :: LogLevel -> Q Exp
|
||||
-logTH level =
|
||||
- [|monadLoggerLog $(qLocation >>= liftLoc) $(lift level) . (id :: Text -> Text)|]
|
||||
-
|
||||
--- | Generates a function that takes a 'Text' and logs a 'LevelDebug' message. Usage:
|
||||
---
|
||||
--- > $(logDebug) "This is a debug log message"
|
||||
-logDebug :: Q Exp
|
||||
-logDebug = logTH LevelDebug
|
||||
-
|
||||
--- | See 'logDebug'
|
||||
-logInfo :: Q Exp
|
||||
-logInfo = logTH LevelInfo
|
||||
--- | See 'logDebug'
|
||||
-logWarn :: Q Exp
|
||||
-logWarn = logTH LevelWarn
|
||||
--- | See 'logDebug'
|
||||
-logError :: Q Exp
|
||||
-logError = logTH LevelError
|
||||
-
|
||||
--- | Generates a function that takes a 'Text' and logs a 'LevelOther' message. Usage:
|
||||
---
|
||||
--- > $(logOther "My new level") "This is a log message"
|
||||
-logOther :: Text -> Q Exp
|
||||
-logOther = logTH . LevelOther
|
||||
-
|
||||
-liftLoc :: Loc -> Q Exp
|
||||
-liftLoc (Loc a b c (d1, d2) (e1, e2)) = [|Loc
|
||||
- $(lift a)
|
||||
- $(lift b)
|
||||
- $(lift c)
|
||||
- ($(lift d1), $(lift d2))
|
||||
- ($(lift e1), $(lift e2))
|
||||
- |]
|
||||
-
|
||||
--- | Generates a function that takes a 'LogSource' and 'Text' and logs a 'LevelDebug' message. Usage:
|
||||
---
|
||||
--- > $logDebug "SomeSource" "This is a debug log message"
|
||||
-logDebugS :: Q Exp
|
||||
-logDebugS = [|\a b -> monadLoggerLogSource $(qLocation >>= liftLoc) a LevelDebug (b :: Text)|]
|
||||
-
|
||||
--- | See 'logDebugS'
|
||||
-logInfoS :: Q Exp
|
||||
-logInfoS = [|\a b -> monadLoggerLogSource $(qLocation >>= liftLoc) a LevelInfo (b :: Text)|]
|
||||
--- | See 'logDebugS'
|
||||
-logWarnS :: Q Exp
|
||||
-logWarnS = [|\a b -> monadLoggerLogSource $(qLocation >>= liftLoc) a LevelWarn (b :: Text)|]
|
||||
--- | See 'logDebugS'
|
||||
-logErrorS :: Q Exp
|
||||
-logErrorS = [|\a b -> monadLoggerLogSource $(qLocation >>= liftLoc) a LevelError (b :: Text)|]
|
||||
-
|
||||
--- | Generates a function that takes a 'LogSource', a level name and a 'Text' and logs a 'LevelOther' message. Usage:
|
||||
---
|
||||
--- > $logOther "SomeSource" "My new level" "This is a log message"
|
||||
-logOtherS :: Q Exp
|
||||
-logOtherS = [|\src level msg -> monadLoggerLogSource $(qLocation >>= liftLoc) src (LevelOther level) (msg :: Text)|]
|
||||
-
|
||||
-- | Monad transformer that adds a new logging function.
|
||||
--
|
||||
-- Since 0.2.2
|
||||
diff --git a/monad-logger.cabal b/monad-logger.cabal
|
||||
index ab71424..fa3d292 100644
|
||||
--- a/monad-logger.cabal
|
||||
+++ b/monad-logger.cabal
|
||||
@@ -24,4 +24,4 @@ library
|
||||
, transformers-base
|
||||
, monad-control
|
||||
, mtl
|
||||
- , bytestring
|
||||
+ , bytestring >= 0.10.3.0
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,43 +0,0 @@
|
|||
From 3e05f3a3bf886c302fb6d6caa7ee92cf9736b6ad Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Thu, 28 Feb 2013 23:33:45 -0400
|
||||
Subject: [PATCH] NoDelay does not work on Android
|
||||
|
||||
(I think the other change is no-op)
|
||||
---
|
||||
Data/Conduit/Network/Utils.hs | 6 +++---
|
||||
1 file changed, 3 insertions(+), 3 deletions(-)
|
||||
|
||||
diff --git a/Data/Conduit/Network/Utils.hs b/Data/Conduit/Network/Utils.hs
|
||||
index 32a7286..01ff84e 100644
|
||||
--- a/Data/Conduit/Network/Utils.hs
|
||||
+++ b/Data/Conduit/Network/Utils.hs
|
||||
@@ -6,14 +6,14 @@ module Data.Conduit.Network.Utils
|
||||
, getSocket
|
||||
) where
|
||||
|
||||
-import Network.Socket (AddrInfo, Socket, SocketType)
|
||||
+import Network.Socket (Socket, SocketType)
|
||||
import qualified Network.Socket as NS
|
||||
import Data.String (IsString (fromString))
|
||||
import Control.Exception (bracketOnError, IOException)
|
||||
import qualified Control.Exception as E
|
||||
|
||||
-- | Attempt to connect to the given host/port using given @SocketType@.
|
||||
-getSocket :: String -> Int -> SocketType -> IO (Socket, AddrInfo)
|
||||
+getSocket :: String -> Int -> SocketType -> IO (Socket, NS.AddrInfo)
|
||||
getSocket host' port' sockettype = do
|
||||
let hints = NS.defaultHints {
|
||||
NS.addrFlags = [NS.AI_ADDRCONFIG]
|
||||
@@ -93,7 +93,7 @@ bindPort p s sockettype = do
|
||||
sockOpts =
|
||||
case sockettype of
|
||||
NS.Datagram -> [(NS.ReuseAddr,1)]
|
||||
- _ -> [(NS.NoDelay,1), (NS.ReuseAddr,1)]
|
||||
+ _ -> [(NS.ReuseAddr,1)] -- Android seems to not have NoDelay
|
||||
|
||||
theBody addr =
|
||||
bracketOnError
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,60 +0,0 @@
|
|||
From d15ae2193eff9cd38ebce641279996233434b50f Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Sun, 21 Apr 2013 16:05:53 -0400
|
||||
Subject: [PATCH] avoid using gnuidn
|
||||
|
||||
IDN is only used to handle the domain name part of a XMPP server JID.
|
||||
Which seems not worth the bloat on Android.
|
||||
---
|
||||
lib/Network/Protocol/XMPP/JID.hs | 11 ++++-------
|
||||
network-protocol-xmpp.cabal | 1 -
|
||||
2 files changed, 4 insertions(+), 8 deletions(-)
|
||||
|
||||
diff --git a/lib/Network/Protocol/XMPP/JID.hs b/lib/Network/Protocol/XMPP/JID.hs
|
||||
index 91745e0..2a50409 100644
|
||||
--- a/lib/Network/Protocol/XMPP/JID.hs
|
||||
+++ b/lib/Network/Protocol/XMPP/JID.hs
|
||||
@@ -29,7 +29,6 @@ module Network.Protocol.XMPP.JID
|
||||
|
||||
import qualified Data.Text
|
||||
import Data.Text (Text)
|
||||
-import qualified Data.Text.IDN.StringPrep as SP
|
||||
import Data.String (IsString, fromString)
|
||||
|
||||
newtype Node = Node { strNode :: Text }
|
||||
@@ -85,16 +84,14 @@ parseJID str = maybeJID where
|
||||
then Just Nothing
|
||||
else fmap Just (f x)
|
||||
maybeJID = do
|
||||
- preppedNode <- nullable node (stringprepM SP.xmppNode)
|
||||
- preppedDomain <- stringprepM SP.nameprep domain
|
||||
- preppedResource <- nullable resource (stringprepM SP.xmppResource)
|
||||
+ preppedNode <- nullable node (stringprepM id)
|
||||
+ preppedDomain <- stringprepM id domain
|
||||
+ preppedResource <- nullable resource (stringprepM id)
|
||||
return $ JID
|
||||
(fmap Node preppedNode)
|
||||
(Domain preppedDomain)
|
||||
(fmap Resource preppedResource)
|
||||
- stringprepM p x = case SP.stringprep p SP.defaultFlags x of
|
||||
- Left _ -> Nothing
|
||||
- Right y -> Just y
|
||||
+ stringprepM p x = Just x
|
||||
|
||||
parseJID_ :: Text -> JID
|
||||
parseJID_ text = case parseJID text of
|
||||
diff --git a/network-protocol-xmpp.cabal b/network-protocol-xmpp.cabal
|
||||
index 807cda9..3aaad67 100644
|
||||
--- a/network-protocol-xmpp.cabal
|
||||
+++ b/network-protocol-xmpp.cabal
|
||||
@@ -30,7 +30,6 @@ library
|
||||
build-depends:
|
||||
base >= 4.0 && < 5.0
|
||||
, bytestring >= 0.9
|
||||
- , gnuidn >= 0.2 && < 0.3
|
||||
, gnutls >= 0.1.4 && < 0.3
|
||||
, gsasl >= 0.3 && < 0.4
|
||||
, libxml-sax >= 0.7 && < 0.8
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -0,0 +1,25 @@
|
|||
From 0b9df0de3aa45918a2a9226a2da6be4680276419 Mon Sep 17 00:00:00 2001
|
||||
From: foo <foo@bar>
|
||||
Date: Sun, 22 Sep 2013 03:31:55 +0000
|
||||
Subject: [PATCH] stub out
|
||||
|
||||
---
|
||||
persistent-template.cabal | 2 +-
|
||||
1 file changed, 1 insertion(+), 1 deletion(-)
|
||||
|
||||
diff --git a/persistent-template.cabal b/persistent-template.cabal
|
||||
index 8216ce7..f23234b 100644
|
||||
--- a/persistent-template.cabal
|
||||
+++ b/persistent-template.cabal
|
||||
@@ -23,7 +23,7 @@ library
|
||||
, containers
|
||||
, aeson
|
||||
, monad-logger
|
||||
- exposed-modules: Database.Persist.TH
|
||||
+ exposed-modules:
|
||||
ghc-options: -Wall
|
||||
if impl(ghc >= 7.4)
|
||||
cpp-options: -DGHC_7_4
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,71 +1,32 @@
|
|||
From 8fddef803ee9191ca15363283b7e4d5af4c70f3a Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Thu, 28 Feb 2013 23:34:10 -0400
|
||||
From 760fa2c5044ae38bee8114ff84c625ac59f35c6f Mon Sep 17 00:00:00 2001
|
||||
From: foo <foo@bar>
|
||||
Date: Sun, 22 Sep 2013 00:03:55 +0000
|
||||
Subject: [PATCH] disable TH
|
||||
|
||||
---
|
||||
Database/Persist/GenericSql/Internal.hs | 6 +-----
|
||||
Database/Persist/GenericSql/Raw.hs | 5 ++---
|
||||
2 files changed, 3 insertions(+), 8 deletions(-)
|
||||
Database/Persist/Sql/Raw.hs | 2 --
|
||||
1 file changed, 2 deletions(-)
|
||||
|
||||
diff --git a/Database/Persist/GenericSql/Internal.hs b/Database/Persist/GenericSql/Internal.hs
|
||||
index f109887..5273398 100644
|
||||
--- a/Database/Persist/GenericSql/Internal.hs
|
||||
+++ b/Database/Persist/GenericSql/Internal.hs
|
||||
@@ -14,7 +14,6 @@ module Database.Persist.GenericSql.Internal
|
||||
, createSqlPool
|
||||
, mkColumns
|
||||
, Column (..)
|
||||
- , logSQL
|
||||
, InsertSqlResult (..)
|
||||
) where
|
||||
|
||||
@@ -33,7 +32,7 @@ import Data.Monoid (Monoid, mappend, mconcat)
|
||||
import Database.Persist.EntityDef
|
||||
import qualified Data.Conduit as C
|
||||
import Language.Haskell.TH.Syntax (Q, Exp)
|
||||
-import Control.Monad.Logger (logDebugS)
|
||||
+
|
||||
import Data.Maybe (mapMaybe, listToMaybe)
|
||||
import Data.Int (Int64)
|
||||
|
||||
@@ -197,6 +196,3 @@ tableColumn t s = go $ entityColumns t
|
||||
| x == s = ColumnDef x y z
|
||||
| otherwise = go rest
|
||||
-}
|
||||
-
|
||||
-logSQL :: Q Exp
|
||||
-logSQL = [|\sql_foo params_foo -> $logDebugS (T.pack "SQL") $ T.pack $ show (sql_foo :: Text) ++ " " ++ show (params_foo :: [PersistValue])|]
|
||||
diff --git a/Database/Persist/GenericSql/Raw.hs b/Database/Persist/GenericSql/Raw.hs
|
||||
index e4bf9f4..3da8fa0 100644
|
||||
--- a/Database/Persist/GenericSql/Raw.hs
|
||||
+++ b/Database/Persist/GenericSql/Raw.hs
|
||||
@@ -26,7 +26,6 @@ import Database.Persist.GenericSql.Internal hiding (execute, withStmt)
|
||||
import Database.Persist.Store (PersistValue)
|
||||
import Data.IORef
|
||||
import Control.Monad.IO.Class
|
||||
-import Control.Monad.Logger (logDebugS)
|
||||
import Control.Monad.Trans.Reader
|
||||
import qualified Data.Map as Map
|
||||
import Control.Applicative (Applicative)
|
||||
@@ -134,7 +133,7 @@ withStmt :: (MonadSqlPersist m, MonadResource m)
|
||||
diff --git a/Database/Persist/Sql/Raw.hs b/Database/Persist/Sql/Raw.hs
|
||||
index 73189dd..6efebea 100644
|
||||
--- a/Database/Persist/Sql/Raw.hs
|
||||
+++ b/Database/Persist/Sql/Raw.hs
|
||||
@@ -22,7 +22,6 @@ rawQuery :: (MonadSqlPersist m, MonadResource m)
|
||||
-> [PersistValue]
|
||||
-> Source m [PersistValue]
|
||||
withStmt sql vals = do
|
||||
rawQuery sql vals = do
|
||||
- lift $ $logDebugS (pack "SQL") $ pack $ show sql ++ " " ++ show vals
|
||||
+ -- lift $ pack $ show sql ++ " " ++ show vals
|
||||
conn <- lift askSqlConn
|
||||
bracketP
|
||||
(getStmt' conn sql)
|
||||
@@ -146,7 +145,7 @@ execute x y = liftM (const ()) $ executeCount x y
|
||||
(getStmtConn conn sql)
|
||||
@@ -34,7 +33,6 @@ rawExecute x y = liftM (const ()) $ rawExecuteCount x y
|
||||
|
||||
executeCount :: MonadSqlPersist m => Text -> [PersistValue] -> m Int64
|
||||
executeCount sql vals = do
|
||||
rawExecuteCount :: MonadSqlPersist m => Text -> [PersistValue] -> m Int64
|
||||
rawExecuteCount sql vals = do
|
||||
- $logDebugS (pack "SQL") $ pack $ show sql ++ " " ++ show vals
|
||||
+ -- pack $ show sql ++ " " ++ show vals
|
||||
stmt <- getStmt sql
|
||||
res <- liftIO $ I.execute stmt vals
|
||||
liftIO $ reset stmt
|
||||
res <- liftIO $ stmtExecute stmt vals
|
||||
liftIO $ stmtReset stmt
|
||||
--
|
||||
1.7.10.4
|
||||
|
||||
|
|
|
@ -0,0 +1,96 @@
|
|||
From 2b1ee45058b0d6db90f77e4859d01d1e8434906c Mon Sep 17 00:00:00 2001
|
||||
From: foo <foo@bar>
|
||||
Date: Sat, 21 Sep 2013 23:11:51 +0000
|
||||
Subject: [PATCH] fix build with new ghc
|
||||
|
||||
---
|
||||
Data/Primitive/Array.hs | 2 +-
|
||||
Data/Primitive/ByteArray.hs | 2 +-
|
||||
Data/Primitive/MutVar.hs | 4 ++--
|
||||
Data/Primitive/Types.hs | 13 +++++++------
|
||||
4 files changed, 11 insertions(+), 10 deletions(-)
|
||||
|
||||
diff --git a/Data/Primitive/Array.hs b/Data/Primitive/Array.hs
|
||||
index b82dcac..b28abea 100644
|
||||
--- a/Data/Primitive/Array.hs
|
||||
+++ b/Data/Primitive/Array.hs
|
||||
@@ -106,7 +106,7 @@ unsafeThawArray (Array arr#)
|
||||
sameMutableArray :: MutableArray s a -> MutableArray s a -> Bool
|
||||
{-# INLINE sameMutableArray #-}
|
||||
sameMutableArray (MutableArray arr#) (MutableArray brr#)
|
||||
- = sameMutableArray# arr# brr#
|
||||
+ = tagToEnum# (sameMutableArray# arr# brr#)
|
||||
|
||||
-- | Copy a slice of an immutable array to a mutable array.
|
||||
copyArray :: PrimMonad m
|
||||
diff --git a/Data/Primitive/ByteArray.hs b/Data/Primitive/ByteArray.hs
|
||||
index 2a47254..3a1ed6e 100644
|
||||
--- a/Data/Primitive/ByteArray.hs
|
||||
+++ b/Data/Primitive/ByteArray.hs
|
||||
@@ -99,7 +99,7 @@ mutableByteArrayContents (MutableByteArray arr#)
|
||||
sameMutableByteArray :: MutableByteArray s -> MutableByteArray s -> Bool
|
||||
{-# INLINE sameMutableByteArray #-}
|
||||
sameMutableByteArray (MutableByteArray arr#) (MutableByteArray brr#)
|
||||
- = sameMutableByteArray# arr# brr#
|
||||
+ = tagToEnum# (sameMutableByteArray# arr# brr#)
|
||||
|
||||
-- | Convert a mutable byte array to an immutable one without copying. The
|
||||
-- array should not be modified after the conversion.
|
||||
diff --git a/Data/Primitive/MutVar.hs b/Data/Primitive/MutVar.hs
|
||||
index 9745ec7..eb654c9 100644
|
||||
--- a/Data/Primitive/MutVar.hs
|
||||
+++ b/Data/Primitive/MutVar.hs
|
||||
@@ -23,7 +23,7 @@ module Data.Primitive.MutVar (
|
||||
) where
|
||||
|
||||
import Control.Monad.Primitive ( PrimMonad(..), primitive_ )
|
||||
-import GHC.Prim ( MutVar#, sameMutVar#, newMutVar#,
|
||||
+import GHC.Prim ( MutVar#, sameMutVar#, newMutVar#, tagToEnum#,
|
||||
readMutVar#, writeMutVar#, atomicModifyMutVar# )
|
||||
import Data.Typeable ( Typeable )
|
||||
|
||||
@@ -33,7 +33,7 @@ data MutVar s a = MutVar (MutVar# s a)
|
||||
deriving ( Typeable )
|
||||
|
||||
instance Eq (MutVar s a) where
|
||||
- MutVar mva# == MutVar mvb# = sameMutVar# mva# mvb#
|
||||
+ MutVar mva# == MutVar mvb# = tagToEnum# (sameMutVar# mva# mvb#)
|
||||
|
||||
-- | Create a new 'MutVar' with the specified initial value
|
||||
newMutVar :: PrimMonad m => a -> m (MutVar (PrimState m) a)
|
||||
diff --git a/Data/Primitive/Types.hs b/Data/Primitive/Types.hs
|
||||
index 7568f0c..d961e97 100644
|
||||
--- a/Data/Primitive/Types.hs
|
||||
+++ b/Data/Primitive/Types.hs
|
||||
@@ -20,6 +20,7 @@ module Data.Primitive.Types (
|
||||
import Control.Monad.Primitive
|
||||
import Data.Primitive.MachDeps
|
||||
import Data.Primitive.Internal.Operations
|
||||
+import GHC.Prim (tagToEnum#)
|
||||
|
||||
import GHC.Base (
|
||||
unsafeCoerce#,
|
||||
@@ -48,14 +49,14 @@ import Data.Primitive.Internal.Compat ( mkNoRepType )
|
||||
data Addr = Addr Addr# deriving ( Typeable )
|
||||
|
||||
instance Eq Addr where
|
||||
- Addr a# == Addr b# = eqAddr# a# b#
|
||||
- Addr a# /= Addr b# = neAddr# a# b#
|
||||
+ Addr a# == Addr b# = tagToEnum# (eqAddr# a# b#)
|
||||
+ Addr a# /= Addr b# = tagToEnum# (neAddr# a# b#)
|
||||
|
||||
instance Ord Addr where
|
||||
- Addr a# > Addr b# = gtAddr# a# b#
|
||||
- Addr a# >= Addr b# = geAddr# a# b#
|
||||
- Addr a# < Addr b# = ltAddr# a# b#
|
||||
- Addr a# <= Addr b# = leAddr# a# b#
|
||||
+ Addr a# > Addr b# = tagToEnum# (gtAddr# a# b#)
|
||||
+ Addr a# >= Addr b# = tagToEnum# (geAddr# a# b#)
|
||||
+ Addr a# < Addr b# = tagToEnum# (ltAddr# a# b#)
|
||||
+ Addr a# <= Addr b# = tagToEnum# (leAddr# a# b#)
|
||||
|
||||
instance Data Addr where
|
||||
toConstr _ = error "toConstr"
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -0,0 +1,24 @@
|
|||
From 0b0d4250cfce44b1a03b50458b4122370ab349ce Mon Sep 17 00:00:00 2001
|
||||
From: foo <foo@bar>
|
||||
Date: Sat, 21 Sep 2013 21:50:51 +0000
|
||||
Subject: [PATCH] fix build with new ghc
|
||||
|
||||
---
|
||||
System/Process/Internals.hs | 1 +
|
||||
1 file changed, 1 insertion(+)
|
||||
|
||||
diff --git a/System/Process/Internals.hs b/System/Process/Internals.hs
|
||||
index a73c6fc..6676a72 100644
|
||||
--- a/System/Process/Internals.hs
|
||||
+++ b/System/Process/Internals.hs
|
||||
@@ -61,6 +61,7 @@ import Control.Concurrent
|
||||
import Control.Exception
|
||||
import Foreign.C
|
||||
import Foreign
|
||||
+import System.IO.Unsafe
|
||||
|
||||
# ifdef __GLASGOW_HASKELL__
|
||||
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,44 +0,0 @@
|
|||
From c10ab80793a21dce0c7516725e1ca3b36a87aa25 Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Thu, 28 Feb 2013 23:35:08 -0400
|
||||
Subject: [PATCH] hack to build with hacked up lifted-base, which is currently
|
||||
lacking a mask
|
||||
|
||||
---
|
||||
Control/Monad/Trans/Resource.hs | 6 +++---
|
||||
1 file changed, 3 insertions(+), 3 deletions(-)
|
||||
|
||||
diff --git a/Control/Monad/Trans/Resource.hs b/Control/Monad/Trans/Resource.hs
|
||||
index d209dd8..61ab349 100644
|
||||
--- a/Control/Monad/Trans/Resource.hs
|
||||
+++ b/Control/Monad/Trans/Resource.hs
|
||||
@@ -5,7 +5,7 @@
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
-{-# LANGUAGE DeriveDataTypeable #-}
|
||||
+{-# LANGUAGE DeriveDataTypeable, ImpredicativeTypes #-}
|
||||
#if __GLASGOW_HASKELL__ >= 704
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
#endif
|
||||
@@ -554,7 +554,7 @@ GOX(Monoid w, Strict.WriterT w)
|
||||
--
|
||||
-- Since 0.3.0
|
||||
resourceForkIO :: MonadBaseControl IO m => ResourceT m () -> ResourceT m ThreadId
|
||||
-resourceForkIO (ResourceT f) = ResourceT $ \r -> L.mask $ \restore ->
|
||||
+resourceForkIO (ResourceT f) = ResourceT $ \r ->
|
||||
-- We need to make sure the counter is incremented before this call
|
||||
-- returns. Otherwise, the parent thread may call runResourceT before
|
||||
-- the child thread increments, and all resources will be freed
|
||||
@@ -565,7 +565,7 @@ resourceForkIO (ResourceT f) = ResourceT $ \r -> L.mask $ \restore ->
|
||||
(liftBaseDiscard forkIO $ bracket_
|
||||
(return ())
|
||||
(stateCleanup r)
|
||||
- (restore $ f r))
|
||||
+ (return ()))
|
||||
|
||||
-- | A @Monad@ based on some monad which allows running of some 'IO' actions,
|
||||
-- via unsafe calls. This applies to 'IO' and 'ST', for instance.
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,15 +1,13 @@
|
|||
From 8f058e84892a8c4202275f524f74bd6a7097ad40 Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Wed, 8 May 2013 02:07:15 -0400
|
||||
From 05d0b6e6d2f84cd8ff53b8ee3e42021fa02fe8e4 Mon Sep 17 00:00:00 2001
|
||||
From: foo <foo@bar>
|
||||
Date: Sat, 21 Sep 2013 23:21:52 +0000
|
||||
Subject: [PATCH] remove TH
|
||||
|
||||
---
|
||||
Text/Cassius.hs | 23 --------------
|
||||
Text/Css.hs | 84 -------------------------------------------------
|
||||
Text/CssCommon.hs | 4 ---
|
||||
Text/Lucius.hs | 30 +-----------------
|
||||
shakespeare-css.cabal | 2 +-
|
||||
5 files changed, 2 insertions(+), 141 deletions(-)
|
||||
Text/Cassius.hs | 23 -----------------------
|
||||
Text/CssCommon.hs | 4 ----
|
||||
Text/Lucius.hs | 30 +-----------------------------
|
||||
3 files changed, 1 insertion(+), 56 deletions(-)
|
||||
|
||||
diff --git a/Text/Cassius.hs b/Text/Cassius.hs
|
||||
index ce05374..ae56b0a 100644
|
||||
|
@ -64,117 +62,6 @@ index ce05374..ae56b0a 100644
|
|||
-- | Determine which identifiers are used by the given template, useful for
|
||||
-- creating systems like yesod devel.
|
||||
cassiusUsedIdentifiers :: String -> [(Deref, VarType)]
|
||||
diff --git a/Text/Css.hs b/Text/Css.hs
|
||||
index 8e6fc09..401a166 100644
|
||||
--- a/Text/Css.hs
|
||||
+++ b/Text/Css.hs
|
||||
@@ -108,19 +108,6 @@ cssUsedIdentifiers toi2b parseBlocks s' =
|
||||
(scope, rest') = go rest
|
||||
go' (k, v) = k ++ v
|
||||
|
||||
-cssFileDebug :: Bool -- ^ perform the indent-to-brace conversion
|
||||
- -> Q Exp -> Parser [TopLevel] -> FilePath -> Q Exp
|
||||
-cssFileDebug toi2b parseBlocks' parseBlocks fp = do
|
||||
- s <- fmap TL.unpack $ qRunIO $ readUtf8File fp
|
||||
-#ifdef GHC_7_4
|
||||
- qAddDependentFile fp
|
||||
-#endif
|
||||
- let vs = cssUsedIdentifiers toi2b parseBlocks s
|
||||
- c <- mapM vtToExp vs
|
||||
- cr <- [|cssRuntime toi2b|]
|
||||
- parseBlocks'' <- parseBlocks'
|
||||
- return $ cr `AppE` parseBlocks'' `AppE` (LitE $ StringL fp) `AppE` ListE c
|
||||
-
|
||||
combineSelectors :: Selector -> Selector -> Selector
|
||||
combineSelectors a b = do
|
||||
a' <- a
|
||||
@@ -202,17 +189,6 @@ cssRuntime toi2b parseBlocks fp cd render' = unsafePerformIO $ do
|
||||
|
||||
addScope scope = map (DerefIdent . Ident *** CDPlain . fromString) scope ++ cd
|
||||
|
||||
-vtToExp :: (Deref, VarType) -> Q Exp
|
||||
-vtToExp (d, vt) = do
|
||||
- d' <- lift d
|
||||
- c' <- c vt
|
||||
- return $ TupE [d', c' `AppE` derefToExp [] d]
|
||||
- where
|
||||
- c :: VarType -> Q Exp
|
||||
- c VTPlain = [|CDPlain . toCss|]
|
||||
- c VTUrl = [|CDUrl|]
|
||||
- c VTUrlParam = [|CDUrlParam|]
|
||||
-
|
||||
getVars :: Monad m => [(String, String)] -> Content -> m [(Deref, VarType)]
|
||||
getVars _ ContentRaw{} = return []
|
||||
getVars scope (ContentVar d) =
|
||||
@@ -268,68 +244,8 @@ compressBlock (Block x y blocks) =
|
||||
cc (ContentRaw a:ContentRaw b:c) = cc $ ContentRaw (a ++ b) : c
|
||||
cc (a:b) = a : cc b
|
||||
|
||||
-blockToCss :: Name -> Scope -> Block -> Q Exp
|
||||
-blockToCss r scope (Block sel props subblocks) =
|
||||
- [|(:) (Css' $(selectorToBuilder r scope sel) $(listE $ map go props))
|
||||
- . foldr (.) id $(listE $ map subGo subblocks)
|
||||
- |]
|
||||
- where
|
||||
- go (x, y) = tupE [contentsToBuilder r scope x, contentsToBuilder r scope y]
|
||||
- subGo (Block sel' b c) =
|
||||
- blockToCss r scope $ Block sel'' b c
|
||||
- where
|
||||
- sel'' = combineSelectors sel sel'
|
||||
-
|
||||
-selectorToBuilder :: Name -> Scope -> Selector -> Q Exp
|
||||
-selectorToBuilder r scope sels =
|
||||
- contentsToBuilder r scope $ intercalate [ContentRaw ","] sels
|
||||
-
|
||||
-contentsToBuilder :: Name -> Scope -> [Content] -> Q Exp
|
||||
-contentsToBuilder r scope contents =
|
||||
- appE [|mconcat|] $ listE $ map (contentToBuilder r scope) contents
|
||||
-
|
||||
-contentToBuilder :: Name -> Scope -> Content -> Q Exp
|
||||
-contentToBuilder _ _ (ContentRaw x) =
|
||||
- [|fromText . pack|] `appE` litE (StringL x)
|
||||
-contentToBuilder _ scope (ContentVar d) =
|
||||
- case d of
|
||||
- DerefIdent (Ident s)
|
||||
- | Just val <- lookup s scope -> [|fromText . pack|] `appE` litE (StringL val)
|
||||
- _ -> [|toCss|] `appE` return (derefToExp [] d)
|
||||
-contentToBuilder r _ (ContentUrl u) =
|
||||
- [|fromText|] `appE`
|
||||
- (varE r `appE` return (derefToExp [] u) `appE` listE [])
|
||||
-contentToBuilder r _ (ContentUrlParam u) =
|
||||
- [|fromText|] `appE`
|
||||
- ([|uncurry|] `appE` varE r `appE` return (derefToExp [] u))
|
||||
-
|
||||
type Scope = [(String, String)]
|
||||
|
||||
-topLevelsToCassius :: [TopLevel] -> Q Exp
|
||||
-topLevelsToCassius a = do
|
||||
- r <- newName "_render"
|
||||
- lamE [varP r] $ appE [|CssNoWhitespace . foldr ($) []|] $ fmap ListE $ go r [] a
|
||||
- where
|
||||
- go _ _ [] = return []
|
||||
- go r scope (TopBlock b:rest) = do
|
||||
- e <- [|(++) $ map Css ($(blockToCss r scope b) [])|]
|
||||
- es <- go r scope rest
|
||||
- return $ e : es
|
||||
- go r scope (TopAtBlock name s b:rest) = do
|
||||
- let s' = contentsToBuilder r scope s
|
||||
- e <- [|(:) $ AtBlock $(lift name) $(s') $(blocksToCassius r scope b)|]
|
||||
- es <- go r scope rest
|
||||
- return $ e : es
|
||||
- go r scope (TopAtDecl dec cs:rest) = do
|
||||
- e <- [|(:) $ AtDecl $(lift dec) $(contentsToBuilder r scope cs)|]
|
||||
- es <- go r scope rest
|
||||
- return $ e : es
|
||||
- go r scope (TopVar k v:rest) = go r ((k, v) : scope) rest
|
||||
-
|
||||
-blocksToCassius :: Name -> Scope -> [Block] -> Q Exp
|
||||
-blocksToCassius r scope a = do
|
||||
- appE [|foldr ($) []|] $ listE $ map (blockToCss r scope) a
|
||||
-
|
||||
renderCss :: Css -> TL.Text
|
||||
renderCss css =
|
||||
toLazyText $ mconcat $ map go tops-- FIXME use a foldr
|
||||
diff --git a/Text/CssCommon.hs b/Text/CssCommon.hs
|
||||
index 719e0a8..8c40e8c 100644
|
||||
--- a/Text/CssCommon.hs
|
||||
|
@ -192,10 +79,10 @@ index 719e0a8..8c40e8c 100644
|
|||
-mkSizeType "ExSize" "ex"
|
||||
-mkSizeType "PixelSize" "px"
|
||||
diff --git a/Text/Lucius.hs b/Text/Lucius.hs
|
||||
index b71614e..a902e1c 100644
|
||||
index 89328bd..0a1cf5e 100644
|
||||
--- a/Text/Lucius.hs
|
||||
+++ b/Text/Lucius.hs
|
||||
@@ -6,12 +6,8 @@
|
||||
@@ -8,12 +8,8 @@
|
||||
{-# OPTIONS_GHC -fno-warn-missing-fields #-}
|
||||
module Text.Lucius
|
||||
( -- * Parsing
|
||||
|
@ -203,13 +90,13 @@ index b71614e..a902e1c 100644
|
|||
- , luciusFile
|
||||
- , luciusFileDebug
|
||||
- , luciusFileReload
|
||||
-- ** Mixins
|
||||
- , luciusMixin
|
||||
+ luciusMixin
|
||||
, Mixin
|
||||
-- ** Runtime
|
||||
- , luciusRT
|
||||
+ luciusRT
|
||||
, luciusRT'
|
||||
, -- * Datatypes
|
||||
Css
|
||||
@@ -31,11 +27,8 @@ module Text.Lucius
|
||||
, luciusRT
|
||||
@@ -40,11 +36,8 @@ module Text.Lucius
|
||||
, AbsoluteUnit (..)
|
||||
, AbsoluteSize (..)
|
||||
, absoluteSize
|
||||
|
@ -221,9 +108,9 @@ index b71614e..a902e1c 100644
|
|||
-- * Internal
|
||||
, parseTopLevels
|
||||
, luciusUsedIdentifiers
|
||||
@@ -57,18 +50,6 @@ import Data.Either (partitionEithers)
|
||||
import Data.Monoid (mconcat)
|
||||
@@ -66,18 +59,6 @@ import Data.Monoid (mconcat)
|
||||
import Data.List (isSuffixOf)
|
||||
import Control.Arrow (second)
|
||||
|
||||
--- |
|
||||
---
|
||||
|
@ -240,7 +127,7 @@ index b71614e..a902e1c 100644
|
|||
whiteSpace :: Parser ()
|
||||
whiteSpace = many whiteSpace1 >> return ()
|
||||
|
||||
@@ -179,15 +160,6 @@ parseComment = do
|
||||
@@ -217,15 +198,6 @@ parseComment = do
|
||||
_ <- manyTill anyChar $ try $ string "*/"
|
||||
return $ ContentRaw ""
|
||||
|
||||
|
@ -253,22 +140,9 @@ index b71614e..a902e1c 100644
|
|||
-luciusFileDebug = cssFileDebug False [|parseTopLevels|] parseTopLevels
|
||||
-luciusFileReload = luciusFileDebug
|
||||
-
|
||||
parseTopLevels :: Parser [TopLevel]
|
||||
parseTopLevels :: Parser [TopLevel Unresolved]
|
||||
parseTopLevels =
|
||||
go id
|
||||
diff --git a/shakespeare-css.cabal b/shakespeare-css.cabal
|
||||
index de2497b..874a3b5 100644
|
||||
--- a/shakespeare-css.cabal
|
||||
+++ b/shakespeare-css.cabal
|
||||
@@ -33,7 +33,7 @@ library
|
||||
, shakespeare >= 1.0 && < 1.1
|
||||
, template-haskell
|
||||
, text >= 0.11.1.1 && < 0.12
|
||||
- , process >= 1.0 && < 1.2
|
||||
+ , process >= 1.0 && < 1.3
|
||||
, parsec >= 2 && < 4
|
||||
, transformers
|
||||
|
||||
--
|
||||
1.7.10.4
|
||||
|
||||
|
|
|
@ -1,162 +0,0 @@
|
|||
From b128412ecee9677b788abecbbf1fd1edd447eea2 Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Thu, 28 Feb 2013 23:35:59 -0400
|
||||
Subject: [PATCH] remove TH
|
||||
|
||||
---
|
||||
Text/Shakespeare/I18N.hs | 130 +---------------------------------------------
|
||||
1 file changed, 1 insertion(+), 129 deletions(-)
|
||||
|
||||
diff --git a/Text/Shakespeare/I18N.hs b/Text/Shakespeare/I18N.hs
|
||||
index 1b486ed..aa5e358 100644
|
||||
--- a/Text/Shakespeare/I18N.hs
|
||||
+++ b/Text/Shakespeare/I18N.hs
|
||||
@@ -51,10 +51,7 @@
|
||||
--
|
||||
-- You can also adapt those instructions for use with other systems.
|
||||
module Text.Shakespeare.I18N
|
||||
- ( mkMessage
|
||||
- , mkMessageFor
|
||||
- , mkMessageVariant
|
||||
- , RenderMessage (..)
|
||||
+ ( RenderMessage (..)
|
||||
, ToMessage (..)
|
||||
, SomeMessage (..)
|
||||
, Lang
|
||||
@@ -115,133 +112,8 @@ type Lang = Text
|
||||
--
|
||||
-- 3. create a 'RenderMessage' instance
|
||||
--
|
||||
-mkMessage :: String -- ^ base name to use for translation type
|
||||
- -> FilePath -- ^ subdirectory which contains the translation files
|
||||
- -> Lang -- ^ default translation language
|
||||
- -> Q [Dec]
|
||||
-mkMessage dt folder lang =
|
||||
- mkMessageCommon True "Msg" "Message" dt dt folder lang
|
||||
|
||||
|
||||
--- | create 'RenderMessage' instance for an existing data-type
|
||||
-mkMessageFor :: String -- ^ master translation data type
|
||||
- -> String -- ^ existing type to add translations for
|
||||
- -> FilePath -- ^ path to translation folder
|
||||
- -> Lang -- ^ default language
|
||||
- -> Q [Dec]
|
||||
-mkMessageFor master dt folder lang = mkMessageCommon False "" "" master dt folder lang
|
||||
-
|
||||
--- | create an additional set of translations for a type created by `mkMessage`
|
||||
-mkMessageVariant :: String -- ^ master translation data type
|
||||
- -> String -- ^ existing type to add translations for
|
||||
- -> FilePath -- ^ path to translation folder
|
||||
- -> Lang -- ^ default language
|
||||
- -> Q [Dec]
|
||||
-mkMessageVariant master dt folder lang = mkMessageCommon False "Msg" "Message" master dt folder lang
|
||||
-
|
||||
--- |used by 'mkMessage' and 'mkMessageFor' to generate a 'RenderMessage' and possibly a message data type
|
||||
-mkMessageCommon :: Bool -- ^ generate a new datatype from the constructors found in the .msg files
|
||||
- -> String -- ^ string to append to constructor names
|
||||
- -> String -- ^ string to append to datatype name
|
||||
- -> String -- ^ base name of master datatype
|
||||
- -> String -- ^ base name of translation datatype
|
||||
- -> FilePath -- ^ path to translation folder
|
||||
- -> Lang -- ^ default lang
|
||||
- -> Q [Dec]
|
||||
-mkMessageCommon genType prefix postfix master dt folder lang = do
|
||||
- files <- qRunIO $ getDirectoryContents folder
|
||||
- (_files', contents) <- qRunIO $ fmap (unzip . catMaybes) $ mapM (loadLang folder) files
|
||||
-#ifdef GHC_7_4
|
||||
- mapM_ qAddDependentFile _files'
|
||||
-#endif
|
||||
- sdef <-
|
||||
- case lookup lang contents of
|
||||
- Nothing -> error $ "Did not find main language file: " ++ unpack lang
|
||||
- Just def -> toSDefs def
|
||||
- mapM_ (checkDef sdef) $ map snd contents
|
||||
- let mname = mkName $ dt ++ postfix
|
||||
- c1 <- fmap concat $ mapM (toClauses prefix dt) contents
|
||||
- c2 <- mapM (sToClause prefix dt) sdef
|
||||
- c3 <- defClause
|
||||
- return $
|
||||
- ( if genType
|
||||
- then ((DataD [] mname [] (map (toCon dt) sdef) []) :)
|
||||
- else id)
|
||||
- [ InstanceD
|
||||
- []
|
||||
- (ConT ''RenderMessage `AppT` (ConT $ mkName master) `AppT` ConT mname)
|
||||
- [ FunD (mkName "renderMessage") $ c1 ++ c2 ++ [c3]
|
||||
- ]
|
||||
- ]
|
||||
-
|
||||
-toClauses :: String -> String -> (Lang, [Def]) -> Q [Clause]
|
||||
-toClauses prefix dt (lang, defs) =
|
||||
- mapM go defs
|
||||
- where
|
||||
- go def = do
|
||||
- a <- newName "lang"
|
||||
- (pat, bod) <- mkBody dt (prefix ++ constr def) (map fst $ vars def) (content def)
|
||||
- guard <- fmap NormalG [|$(return $ VarE a) == pack $(lift $ unpack lang)|]
|
||||
- return $ Clause
|
||||
- [WildP, ConP (mkName ":") [VarP a, WildP], pat]
|
||||
- (GuardedB [(guard, bod)])
|
||||
- []
|
||||
-
|
||||
-mkBody :: String -- ^ datatype
|
||||
- -> String -- ^ constructor
|
||||
- -> [String] -- ^ variable names
|
||||
- -> [Content]
|
||||
- -> Q (Pat, Exp)
|
||||
-mkBody dt cs vs ct = do
|
||||
- vp <- mapM go vs
|
||||
- let pat = RecP (mkName cs) (map (varName dt *** VarP) vp)
|
||||
- let ct' = map (fixVars vp) ct
|
||||
- pack' <- [|Data.Text.pack|]
|
||||
- tomsg <- [|toMessage|]
|
||||
- let ct'' = map (toH pack' tomsg) ct'
|
||||
- mapp <- [|mappend|]
|
||||
- let app a b = InfixE (Just a) mapp (Just b)
|
||||
- e <-
|
||||
- case ct'' of
|
||||
- [] -> [|mempty|]
|
||||
- [x] -> return x
|
||||
- (x:xs) -> return $ foldl' app x xs
|
||||
- return (pat, e)
|
||||
- where
|
||||
- toH pack' _ (Raw s) = pack' `AppE` SigE (LitE (StringL s)) (ConT ''String)
|
||||
- toH _ tomsg (Var d) = tomsg `AppE` derefToExp [] d
|
||||
- go x = do
|
||||
- let y = mkName $ '_' : x
|
||||
- return (x, y)
|
||||
- fixVars vp (Var d) = Var $ fixDeref vp d
|
||||
- fixVars _ (Raw s) = Raw s
|
||||
- fixDeref vp (DerefIdent (Ident i)) = DerefIdent $ Ident $ fixIdent vp i
|
||||
- fixDeref vp (DerefBranch a b) = DerefBranch (fixDeref vp a) (fixDeref vp b)
|
||||
- fixDeref _ d = d
|
||||
- fixIdent vp i =
|
||||
- case lookup i vp of
|
||||
- Nothing -> i
|
||||
- Just y -> nameBase y
|
||||
-
|
||||
-sToClause :: String -> String -> SDef -> Q Clause
|
||||
-sToClause prefix dt sdef = do
|
||||
- (pat, bod) <- mkBody dt (prefix ++ sconstr sdef) (map fst $ svars sdef) (scontent sdef)
|
||||
- return $ Clause
|
||||
- [WildP, ConP (mkName "[]") [], pat]
|
||||
- (NormalB bod)
|
||||
- []
|
||||
-
|
||||
-defClause :: Q Clause
|
||||
-defClause = do
|
||||
- a <- newName "sub"
|
||||
- c <- newName "langs"
|
||||
- d <- newName "msg"
|
||||
- rm <- [|renderMessage|]
|
||||
- return $ Clause
|
||||
- [VarP a, ConP (mkName ":") [WildP, VarP c], VarP d]
|
||||
- (NormalB $ rm `AppE` VarE a `AppE` VarE c `AppE` VarE d)
|
||||
- []
|
||||
-
|
||||
toCon :: String -> SDef -> Con
|
||||
toCon dt (SDef c vs _) =
|
||||
RecC (mkName $ "Msg" ++ c) $ map go vs
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,308 +0,0 @@
|
|||
From 332c71b3f6bc4786b914e675020a23c492beee5a Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Tue, 7 May 2013 19:28:06 -0400
|
||||
Subject: [PATCH] remove TH
|
||||
|
||||
---
|
||||
Text/Coffee.hs | 54 -------------------------------------------------
|
||||
Text/Julius.hs | 56 ++++-----------------------------------------------
|
||||
Text/Roy.hs | 54 -------------------------------------------------
|
||||
Text/TypeScript.hs | 57 +---------------------------------------------------
|
||||
4 files changed, 5 insertions(+), 216 deletions(-)
|
||||
|
||||
diff --git a/Text/Coffee.hs b/Text/Coffee.hs
|
||||
index 2481936..3f7f9c3 100644
|
||||
--- a/Text/Coffee.hs
|
||||
+++ b/Text/Coffee.hs
|
||||
@@ -51,14 +51,6 @@ module Text.Coffee
|
||||
-- ** Template-Reading Functions
|
||||
-- | These QuasiQuoter and Template Haskell methods return values of
|
||||
-- type @'JavascriptUrl' url@. See the Yesod book for details.
|
||||
- coffee
|
||||
- , coffeeFile
|
||||
- , coffeeFileReload
|
||||
- , coffeeFileDebug
|
||||
-
|
||||
-#ifdef TEST_EXPORT
|
||||
- , coffeeSettings
|
||||
-#endif
|
||||
) where
|
||||
|
||||
import Language.Haskell.TH.Quote (QuasiQuoter (..))
|
||||
@@ -66,49 +58,3 @@ import Language.Haskell.TH.Syntax
|
||||
import Text.Shakespeare
|
||||
import Text.Julius
|
||||
|
||||
-coffeeSettings :: Q ShakespeareSettings
|
||||
-coffeeSettings = do
|
||||
- jsettings <- javascriptSettings
|
||||
- return $ jsettings { varChar = '%'
|
||||
- , preConversion = Just PreConvert {
|
||||
- preConvert = ReadProcess "coffee" ["-spb"]
|
||||
- , preEscapeIgnoreBalanced = "'\"`" -- don't insert backtacks for variable already inside strings or backticks.
|
||||
- , preEscapeIgnoreLine = "#" -- ignore commented lines
|
||||
- , wrapInsertion = Just WrapInsertion {
|
||||
- wrapInsertionIndent = Just " "
|
||||
- , wrapInsertionStartBegin = "(("
|
||||
- , wrapInsertionSeparator = ", "
|
||||
- , wrapInsertionStartClose = ") =>"
|
||||
- , wrapInsertionEnd = ")"
|
||||
- , wrapInsertionApplyBegin = "("
|
||||
- , wrapInsertionApplyClose = ")\n"
|
||||
- }
|
||||
- }
|
||||
- }
|
||||
-
|
||||
--- | Read inline, quasiquoted CoffeeScript.
|
||||
-coffee :: QuasiQuoter
|
||||
-coffee = QuasiQuoter { quoteExp = \s -> do
|
||||
- rs <- coffeeSettings
|
||||
- quoteExp (shakespeare rs) s
|
||||
- }
|
||||
-
|
||||
--- | Read in a CoffeeScript template file. This function reads the file once, at
|
||||
--- compile time.
|
||||
-coffeeFile :: FilePath -> Q Exp
|
||||
-coffeeFile fp = do
|
||||
- rs <- coffeeSettings
|
||||
- shakespeareFile rs fp
|
||||
-
|
||||
--- | Read in a CoffeeScript template file. This impure function uses
|
||||
--- unsafePerformIO to re-read the file on every call, allowing for rapid
|
||||
--- iteration.
|
||||
-coffeeFileReload :: FilePath -> Q Exp
|
||||
-coffeeFileReload fp = do
|
||||
- rs <- coffeeSettings
|
||||
- shakespeareFileReload rs fp
|
||||
-
|
||||
--- | Deprecated synonym for 'coffeeFileReload'
|
||||
-coffeeFileDebug :: FilePath -> Q Exp
|
||||
-coffeeFileDebug = coffeeFileReload
|
||||
-{-# DEPRECATED coffeeFileDebug "Please use coffeeFileReload instead." #-}
|
||||
diff --git a/Text/Julius.hs b/Text/Julius.hs
|
||||
index 230eac3..1a0376f 100644
|
||||
--- a/Text/Julius.hs
|
||||
+++ b/Text/Julius.hs
|
||||
@@ -14,17 +14,8 @@ module Text.Julius
|
||||
-- ** Template-Reading Functions
|
||||
-- | These QuasiQuoter and Template Haskell methods return values of
|
||||
-- type @'JavascriptUrl' url@. See the Yesod book for details.
|
||||
- js
|
||||
- , julius
|
||||
- , juliusFile
|
||||
- , jsFile
|
||||
- , juliusFileDebug
|
||||
- , jsFileDebug
|
||||
- , juliusFileReload
|
||||
- , jsFileReload
|
||||
-
|
||||
-- * Datatypes
|
||||
- , JavascriptUrl
|
||||
+ JavascriptUrl
|
||||
, Javascript (..)
|
||||
, RawJavascript (..)
|
||||
|
||||
@@ -37,9 +28,11 @@ module Text.Julius
|
||||
, renderJavascriptUrl
|
||||
|
||||
-- ** internal, used by 'Text.Coffee'
|
||||
- , javascriptSettings
|
||||
-- ** internal
|
||||
, juliusUsedIdentifiers
|
||||
+
|
||||
+ -- used by TH splices
|
||||
+ , asJavascriptUrl
|
||||
) where
|
||||
|
||||
import Language.Haskell.TH.Quote (QuasiQuoter (..))
|
||||
@@ -101,47 +94,6 @@ instance RawJS TL.Text where rawJS = RawJavascript . fromLazyText
|
||||
instance RawJS Builder where rawJS = RawJavascript
|
||||
instance RawJS Bool where rawJS = RawJavascript . toJavascript
|
||||
|
||||
-javascriptSettings :: Q ShakespeareSettings
|
||||
-javascriptSettings = do
|
||||
- toJExp <- [|toJavascript|]
|
||||
- wrapExp <- [|Javascript|]
|
||||
- unWrapExp <- [|unJavascript|]
|
||||
- asJavascriptUrl' <- [|asJavascriptUrl|]
|
||||
- return $ defaultShakespeareSettings { toBuilder = toJExp
|
||||
- , wrap = wrapExp
|
||||
- , unwrap = unWrapExp
|
||||
- , modifyFinalValue = Just asJavascriptUrl'
|
||||
- }
|
||||
-
|
||||
-js, julius :: QuasiQuoter
|
||||
-js = QuasiQuoter { quoteExp = \s -> do
|
||||
- rs <- javascriptSettings
|
||||
- quoteExp (shakespeare rs) s
|
||||
- }
|
||||
-
|
||||
-julius = js
|
||||
-
|
||||
-jsFile, juliusFile :: FilePath -> Q Exp
|
||||
-jsFile fp = do
|
||||
- rs <- javascriptSettings
|
||||
- shakespeareFile rs fp
|
||||
-
|
||||
-juliusFile = jsFile
|
||||
-
|
||||
-
|
||||
-jsFileReload, juliusFileReload :: FilePath -> Q Exp
|
||||
-jsFileReload fp = do
|
||||
- rs <- javascriptSettings
|
||||
- shakespeareFileReload rs fp
|
||||
-
|
||||
-juliusFileReload = jsFileReload
|
||||
-
|
||||
-jsFileDebug, juliusFileDebug :: FilePath -> Q Exp
|
||||
-juliusFileDebug = jsFileReload
|
||||
-{-# DEPRECATED juliusFileDebug "Please use juliusFileReload instead." #-}
|
||||
-jsFileDebug = jsFileReload
|
||||
-{-# DEPRECATED jsFileDebug "Please use jsFileReload instead." #-}
|
||||
-
|
||||
-- | Determine which identifiers are used by the given template, useful for
|
||||
-- creating systems like yesod devel.
|
||||
juliusUsedIdentifiers :: String -> [(Deref, VarType)]
|
||||
diff --git a/Text/Roy.hs b/Text/Roy.hs
|
||||
index cf09cec..870c9f6 100644
|
||||
--- a/Text/Roy.hs
|
||||
+++ b/Text/Roy.hs
|
||||
@@ -23,13 +23,6 @@ module Text.Roy
|
||||
-- ** Template-Reading Functions
|
||||
-- | These QuasiQuoter and Template Haskell methods return values of
|
||||
-- type @'JavascriptUrl' url@. See the Yesod book for details.
|
||||
- roy
|
||||
- , royFile
|
||||
- , royFileReload
|
||||
-
|
||||
-#ifdef TEST_EXPORT
|
||||
- , roySettings
|
||||
-#endif
|
||||
) where
|
||||
|
||||
import Language.Haskell.TH.Quote (QuasiQuoter (..))
|
||||
@@ -37,50 +30,3 @@ import Language.Haskell.TH.Syntax
|
||||
import Text.Shakespeare
|
||||
import Text.Julius
|
||||
|
||||
--- | The Roy language compiles down to Javascript.
|
||||
--- We do this compilation once at compile time to avoid needing to do it during the request.
|
||||
--- We call this a preConversion because other shakespeare modules like Lucius use Haskell to compile during the request instead rather than a system call.
|
||||
-roySettings :: Q ShakespeareSettings
|
||||
-roySettings = do
|
||||
- jsettings <- javascriptSettings
|
||||
- return $ jsettings { varChar = '#'
|
||||
- , preConversion = Just PreConvert {
|
||||
- preConvert = ReadProcess "roy" ["--stdio"]
|
||||
- , preEscapeIgnoreBalanced = "'\""
|
||||
- , preEscapeIgnoreLine = "//"
|
||||
- , wrapInsertion = Nothing
|
||||
- {-
|
||||
- Just WrapInsertion {
|
||||
- wrapInsertionIndent = Just " "
|
||||
- , wrapInsertionStartBegin = "(\\"
|
||||
- , wrapInsertionSeparator = " "
|
||||
- , wrapInsertionStartClose = " ->\n"
|
||||
- , wrapInsertionEnd = ")"
|
||||
- , wrapInsertionApplyBegin = " "
|
||||
- , wrapInsertionApplyClose = ")\n"
|
||||
- }
|
||||
- -}
|
||||
- }
|
||||
- }
|
||||
-
|
||||
--- | Read inline, quasiquoted Roy.
|
||||
-roy :: QuasiQuoter
|
||||
-roy = QuasiQuoter { quoteExp = \s -> do
|
||||
- rs <- roySettings
|
||||
- quoteExp (shakespeare rs) s
|
||||
- }
|
||||
-
|
||||
--- | Read in a Roy template file. This function reads the file once, at
|
||||
--- compile time.
|
||||
-royFile :: FilePath -> Q Exp
|
||||
-royFile fp = do
|
||||
- rs <- roySettings
|
||||
- shakespeareFile rs fp
|
||||
-
|
||||
--- | Read in a Roy template file. This impure function uses
|
||||
--- unsafePerformIO to re-read the file on every call, allowing for rapid
|
||||
--- iteration.
|
||||
-royFileReload :: FilePath -> Q Exp
|
||||
-royFileReload fp = do
|
||||
- rs <- roySettings
|
||||
- shakespeareFileReload rs fp
|
||||
diff --git a/Text/TypeScript.hs b/Text/TypeScript.hs
|
||||
index 34bf4bf..30c5388 100644
|
||||
--- a/Text/TypeScript.hs
|
||||
+++ b/Text/TypeScript.hs
|
||||
@@ -53,65 +53,10 @@
|
||||
--
|
||||
-- 2. TypeScript: <http://typescript.codeplex.com/>
|
||||
module Text.TypeScript
|
||||
- ( -- * Functions
|
||||
- -- ** Template-Reading Functions
|
||||
- -- | These QuasiQuoter and Template Haskell methods return values of
|
||||
- -- type @'JavascriptUrl' url@. See the Yesod book for details.
|
||||
- tsc
|
||||
- , typeScriptFile
|
||||
- , typeScriptFileReload
|
||||
-
|
||||
-#ifdef TEST_EXPORT
|
||||
- , typeScriptSettings
|
||||
-#endif
|
||||
+ (
|
||||
) where
|
||||
|
||||
import Language.Haskell.TH.Quote (QuasiQuoter (..))
|
||||
import Language.Haskell.TH.Syntax
|
||||
import Text.Shakespeare
|
||||
import Text.Julius
|
||||
-
|
||||
--- | The TypeScript language compiles down to Javascript.
|
||||
--- We do this compilation once at compile time to avoid needing to do it during the request.
|
||||
--- We call this a preConversion because other shakespeare modules like Lucius use Haskell to compile during the request instead rather than a system call.
|
||||
-typeScriptSettings :: Q ShakespeareSettings
|
||||
-typeScriptSettings = do
|
||||
- jsettings <- javascriptSettings
|
||||
- return $ jsettings { varChar = '#'
|
||||
- , preConversion = Just PreConvert {
|
||||
- preConvert = ReadProcess "sh" ["-c", "TMP_IN=$(mktemp XXXXXXXXXX.ts); TMP_OUT=$(mktemp XXXXXXXXXX.js); cat /dev/stdin > ${TMP_IN} && tsc --out ${TMP_OUT} ${TMP_IN} && cat ${TMP_OUT}; rm ${TMP_IN} && rm ${TMP_OUT}"]
|
||||
- , preEscapeIgnoreBalanced = "'\""
|
||||
- , preEscapeIgnoreLine = "//"
|
||||
- , wrapInsertion = Just WrapInsertion {
|
||||
- wrapInsertionIndent = Nothing
|
||||
- , wrapInsertionStartBegin = ";(function("
|
||||
- , wrapInsertionSeparator = ", "
|
||||
- , wrapInsertionStartClose = "){"
|
||||
- , wrapInsertionEnd = "})"
|
||||
- , wrapInsertionApplyBegin = "("
|
||||
- , wrapInsertionApplyClose = ");\n"
|
||||
- }
|
||||
- }
|
||||
- }
|
||||
-
|
||||
--- | Read inline, quasiquoted TypeScript
|
||||
-tsc :: QuasiQuoter
|
||||
-tsc = QuasiQuoter { quoteExp = \s -> do
|
||||
- rs <- typeScriptSettings
|
||||
- quoteExp (shakespeare rs) s
|
||||
- }
|
||||
-
|
||||
--- | Read in a Roy template file. This function reads the file once, at
|
||||
--- compile time.
|
||||
-typeScriptFile :: FilePath -> Q Exp
|
||||
-typeScriptFile fp = do
|
||||
- rs <- typeScriptSettings
|
||||
- shakespeareFile rs fp
|
||||
-
|
||||
--- | Read in a Roy template file. This impure function uses
|
||||
--- unsafePerformIO to re-read the file on every call, allowing for rapid
|
||||
--- iteration.
|
||||
-typeScriptFileReload :: FilePath -> Q Exp
|
||||
-typeScriptFileReload fp = do
|
||||
- rs <- typeScriptSettings
|
||||
- shakespeareFileReload rs fp
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -0,0 +1,25 @@
|
|||
From 40182bfb77ba16beab0da95b664d2c052d5fcad6 Mon Sep 17 00:00:00 2001
|
||||
From: foo <foo@bar>
|
||||
Date: Sun, 22 Sep 2013 04:53:30 +0000
|
||||
Subject: [PATCH] TH exports
|
||||
|
||||
---
|
||||
Text/Julius.hs | 2 ++
|
||||
1 file changed, 2 insertions(+)
|
||||
|
||||
diff --git a/Text/Julius.hs b/Text/Julius.hs
|
||||
index 3a9f83e..2b98f30 100644
|
||||
--- a/Text/Julius.hs
|
||||
+++ b/Text/Julius.hs
|
||||
@@ -40,6 +40,8 @@ module Text.Julius
|
||||
, javascriptSettings
|
||||
-- ** internal
|
||||
, juliusUsedIdentifiers
|
||||
+ -- used by TH
|
||||
+ , asJavascriptUrl
|
||||
) where
|
||||
|
||||
import Language.Haskell.TH.Quote (QuasiQuoter (..))
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,139 +1,26 @@
|
|||
From 3cb1056782c29b0b68bdcff8fa49d3ea92126956 Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Mon, 15 Apr 2013 16:46:15 -0400
|
||||
Subject: [PATCH] export symbol used by TH splices
|
||||
From 4a75a2f0d77168aa3115b991284a5120484e18f0 Mon Sep 17 00:00:00 2001
|
||||
From: foo <foo@bar>
|
||||
Date: Sun, 22 Sep 2013 04:59:21 +0000
|
||||
Subject: [PATCH] TH exports
|
||||
|
||||
---
|
||||
Text/.Shakespeare.hs.swp | Bin 24576 -> 0 bytes
|
||||
Text/Shakespeare.hs | 2 ++
|
||||
2 files changed, 2 insertions(+)
|
||||
delete mode 100644 Text/.Shakespeare.hs.swp
|
||||
|
||||
diff --git a/Text/.Shakespeare.hs.swp b/Text/.Shakespeare.hs.swp
|
||||
deleted file mode 100644
|
||||
index 4d6cd6a0295fdfb59f32a66b4af556c0630dd5b0..0000000000000000000000000000000000000000
|
||||
GIT binary patch
|
||||
literal 0
|
||||
HcmV?d00001
|
||||
|
||||
literal 24576
|
||||
zcmeI4e~et$RmWd`KnqD)L_(BS5xTW4?M$;fu@g0M7u$*LtdmXsW9?l#wDxBEJo9Gf
|
||||
z#WU|s-h1QO^^dk7RGJp46wwy`NCj0Y(S!!1AgEe}NKk}8ErJRNG@z(KqJ@T13Q|#9
|
||||
zR6ghact2*x>kWSanvuTVnRm}U_uO;OJ@?*o&-2-xr{<5SdmDFqe16RHu3haOfAZ_E
|
||||
z_a3<Dd5^`xx;(zxXEhpJjYOBfM;P9j_4;?F9sgXA_5(i&W_C4pHtxQ2DOk(yTr3_p
|
||||
zI_Z{pPKYKNm}p=N8W?2lncX*eci**Z=k{%HQ8)ki$t_fxkW4f%(ZECl6Aer>Fwww7
|
||||
z0}~BQG%(S?|0fM({p-CS(4lL=qu?5g>-pOOzWx0}{5=c)#QwgHzc+z9s33JFpNR%0
|
||||
z8klHcqJfD9CK{M%V4{JE1|}MqXkem&i3TPb_}{AmzvX$m5$_9fi0A%aVgN6{(es`I
|
||||
zzX&dZcYzu3y*GH??}AT&_ks{CfP2BM;5zUML4hxWFM!X2XTa0o<KXAP`#=U#umonn
|
||||
zH*WO2=fM+T70iL#!MASkynh0}2c7~Kz&pX+;8ySx;0HhIc`t#lfM>xI;GN(`@b5q3
|
||||
zdEW+q1)c*R0v`lD@F2Ja+zkHk^`6%R`@wf#=Xt*dj)L33^FQo)>);_U2fj-n<a6LW
|
||||
zI1H`<&k-!?f&<__@MVG{?*jitQ04pJW$--sD0mzk0{4Uaz?;FV=w9^yS?~$)BrqSv
|
||||
zXIc#tzds+PL6U`Ww3zuxb|5I1l)qQ0R>Mfm&Z@;M38Pg{=v0;4eAEh}Oh1S2h`)X|
|
||||
zaMUe7^VK8erq$k&-{go$)yw+d5jmw@!>_`_lJ=8eE^Ye#V16}<li+X|1ybSk!H%CS
|
||||
zkEc1{cm1dtv_|MIDtH}?qw}aoiWc0j6lHn36ZxZz9uz+?z8R^!L6D)JD!<jDsVr8Z
|
||||
z7Em?gUJp&Bsy6I|&5lB`2jg}-2-0Q}_A_-h5M2+$tfPE2wSB5C%$sG3Vc6}ej^FQx
|
||||
z-F3$`>jZGhf}|gJeHq<!TKQ2+o%NgNvaoqBRl|7DZK)`h7F3o5euh}cN4tKXK@~x=
|
||||
zj-SyMeAcqYm`>%I3sW^nO}B(&sBOwLMuVwp$B8=cC!v3~8z{d^Yb`{L(y$e%RNGLh
|
||||
zAjzeZ#-zQ6{PbKv@6P+(K>$gF-lS_ukPf=ptg3Cl=wH?vSz7N0i$-HjKN78?4mw5;
|
||||
zOwXx?8hL_1s6wHyZrIeiQE^+iN`qM^PJ>+3lor~9s3{7pl~RjV=*x;<zo;6GhT8C4
|
||||
zo?4-7n<7!a>o-N7V6;={*;lR=J&F23q6JsMS|4#z5o|G5(pQD1n;kz|g;l(<X`y^z
|
||||
zAahc;gbmIxd|0s9tn|JeCTXU6aVu=EGZ5We7&ByIC`JuIuc4MY(i*a3A+4B+q^;16
|
||||
zW2(+Y@em_1L&6+d9r&w(wv#2g*-v6dyC;G~BDQorZ$(sI9o$(FFABs6RVQZXuo*-V
|
||||
zX()&zY+IMo9QvV9bG8F*hml#Vo1bq>OBq%sbz3nkM^ph9XCf`ziHH63zL|5=(x`Mn
|
||||
zie|KtTKTh}$2ewz>J3mMYOzdOnp9L#a8WHY5CQ66$6_DHg3T-nGbNrt&#s}ru6lkb
|
||||
z-IGZY_?REM327$~zo2`jJM~D%8MJ5<9Wdo_Co1*Z*bC;I#D23gt@Z4;&imBGN+6XP
|
||||
zsb?pa)=zw_xf#q#7j=VczBC0NJ;&&fxCMG<hDzqNIDv{wGOokv4>wcpwjF=k?Vx@c
|
||||
z^g<ZTs%&+3UJrw$)S$LeE#Tn*zu1%tuwxA4G%MM&bOEP(K8yz`>SLsbekfjS5M^Ok
|
||||
zH?374L@iuErXM8y2=x3&wR$SnL?fnCh0-rodOocRH)Fg?Oa~L?Y~R(#Rc*AYhUbaj
|
||||
zJH#lS%-XwEyU(K0?)iPSbht5y`r?;%U?+Y{iiHf4Y86%?dA{JY7|iTb^T*thiY9vT
|
||||
zdF>O*sg4J*ru&L!kDE3hKQV}?YT7D^lecwTmb-F8$G6r_-%qe!=~gm`7UW05uhYw(
|
||||
zDS)YZFmMG~d`_MAcP%rnbY(FfB+cNc-wWi|X$qI+%N)xdOf;{#Bw>R1GU}J40Wk>E
|
||||
zhFu)7@r2bxrYAG#wAq_1dl@T(;gHBGEmfMfKLwFyx_@g7Jtk+&o?vku7t?DjBylrH
|
||||
zS-)lI><_&p$@IeQU{lTmv$Hi-B`LKrI#RCi@qynB+aZSh06V3IrakOmz+b1B$|h8r
|
||||
zV9^m+@#c>;PDbJ*RBfRDE*S4Qf2{5(bu&leC=OedM|sPQ1B0;3yiqm#Wm>h9xF_Xx
|
||||
zZ#z>eY`cnw-7;Xkdt>RL#^O4@Xst0X`;o}+rr!3jt=@8E{^-i7xf6@?$BwQzzq-;f
|
||||
z3x4gc>D|*ia{;f+bdzRP4WBr-DUaiW7-Oj&ANXmgzth7;qn_8%3NRMKFo!)=Gb<-s
|
||||
z<t&)Cwls!1IT-iOhLNAeN!qX$*9lv)EZ1a5I&BQia!7IxdLU${s%l}nzuWKlM+d!W
|
||||
zoZlkeA*hla4q1U}dXGoGGe%uEd*-?tGGzicEbOA$=wpV=XVfpMZv}0&G`G04GWXL9
|
||||
z$4)GnYEBlrMScJlZTtO{pNQMDzfNcmdNS$S-=*!(Nw$FVvh5e^O;Sz3#Cogh#>1H|
|
||||
z>!7QH1U~z>(gauxvJCZ@I>=JqYwIzwtyQ-C<$}BhN?`~!c}<OJ!4xx&101X#;1ZE>
|
||||
zE{B-7?AFeS8}V5SGZd#He3NYVwAbM~&%z7LQMb8*_TfP{9Hb5J;>>n+Y+(t*UR-(b
|
||||
zp@V9s9mO+4KZ$0-NEVnbm1p|Cu#Hl+edh8eHF{y1qL>*p+HDoYhxZ?S@Z|mn=hTUy
|
||||
z87Hkrn4SmyWE{c4g@wF{yw;&^uokjAn`f6KXP+^Q@zg<rBchK-gP}N4Y$7}_HtZzM
|
||||
z*)7>^k=xM;ft>&Uh%@+2oZaR8&sXp3ob|s5J`T=;IZy}Jf|sECb?^k}fd_!py%9`4
|
||||
z6Aer>Fwww70}~BQG%(S?L<18IOf)djz(fQ8M>L>HpA`x01v;3wgBy%^s9NfdJJhyW
|
||||
zx$X#>62P5160U{OHhqY9H6NCUd(D)nUR{{<h?Yt?cPb}rO8C4R$L9upxHemy;C0z*
|
||||
ztZE149xKXVty*=pH?JcNY(*wQ9)xoIUR5lq?P6g%q^bo{1J(DW$bGEzjt8+gf--gK
|
||||
zh381NAbVc@f7*en?1fNjpcOi{BgAiCn}|lea{hl4=J_SLbLRXnIsbpdIsdo8hruei
|
||||
z54;`h2CoDE%31$a@D1?K;Pc>9;KN`YoCT5>um`*e{2M`qFM*!{_kdf#8^BHACGPou
|
||||
z1AGkp97w=%@HTKOxCPt{zQ$euv*118GB^YFfZM@$xa)rryZ}B0o&uM^Nw5TN0sqN8
|
||||
z|I6S>@KMkK?*O-gf8gH#x4_dN0Y|_bxB<LO4!|eD$G{Qbfp3uq@B;WCcmmuHzDXXy
|
||||
zzkpZ4?|}D%E_esH9lSzbz_XwO_JZrdSFb~N;Aepk-VDA;KEOYM-v<{!1m?l_7@t1_
|
||||
zGEQHVu^Rhv7Ql6d1TeYLC6+#jy83&A8>~K08cP4p&4sIOn+8zRrWWd)0Op?18#c8w
|
||||
zQbi`SDO7v*X(n~$Lc(LX9p%<V;!t}>iA>~EWHsD^mWxa&Bf&6~)(g3Ij7?e?hPu%W
|
||||
zJjS+Lv?=YnPo3y<t3~8ARlQ*-7s_1O$<;&4geD!G`Fo<cIglHup4`;?$!aQkDcvem
|
||||
z%DgHI`8D4%6|zARDODoi;!odquU7?nx7<FxTh+AZF}D<%^Oyy9Beo10BwU!Q)g&JD
|
||||
zO{BJ<(mmwjM{Yau!HN7XNl*}0zY)NefN^P{P}evWRjaAdksmEC|E}pC;QkRUs|Ju|
|
||||
zY>17Q8zeZZYNm_RrW;~1!6FNlzJW^d@|vON+Tb$7Tv6&MeJ+{YH%2H#kA|~m6?9V*
|
||||
zNmqo6S<z_y{#q$`?S^56HAz%atPsxnv`ti)YDx4U!p-zk-}kfl@xTQB$A-c$lBiI~
|
||||
zySGHmU0o?G?xOQzUgla&z7^Mx<_badVN}fx#uQ3J6j^ak_(Nq)4a;8NrD_q$1jo3d
|
||||
z!${<|V_FT8uKB`!hJ0BrMnrSu>PQ#{<~p#%*M5~n-8SLqaRHiDA)Cn8G$OH(sv5V#
|
||||
zOUWRR;k9gv_0<z%_Zg{lh%2m-TB_waV)CH${fqmp<$>{d`Ae+J@{4=}qZ2iCU$MW@
|
||||
z%$UUEnb}@YUQvepwwkt5j*(C^-E(Q589^;?{!42=|0UyNB+}B@M#q|qwlA~Os?c89
|
||||
zx)#JoCT=_s*N9rKoibj=jvCh7%$RyrqOG=Jyp&dq+|7_#l-e$FrMot}F6ObOX2thb
|
||||
z3)ihO#i&M#cDN3R>DSg|dkddgb>Rxl*an4qZMO7def9#)kFRuk8Nuw{Y=Z!FKJNrG
|
||||
z)qRIkG4vZM?HK3fRPH@xDyJ$*>nc^L*EC8$#5J(>2&`}n&6t7}wQZY`bz`L~k5b`h
|
||||
zPFwMpJ+JJBb9YcPhY88ViidT@C3cyN7B*%PG{t{4Nf?#f0H+<1F>gxo;b>tlylUe8
|
||||
zr`6o!g<Fzx@(?V&_@Cm+RF_rCnNL`@-@6*orsXn^O(QMIptMaRwf!dMW3*;FR`THD
|
||||
zO`yy#Z}o3<VDIydBC4f(IiyetqT>THn6&(I>#27oON%-$p>8UU5}?SMrNGBpQikuc
|
||||
zCzsLY4*d}K<K0t|*N0qoZPUfoHLP0p7)vH<z#$cxja1hjSy#4BpJ!8#ij&Hh7I|{N
|
||||
zaa-0G%9HI=-j(m7At-4uUjr|0R%N_Bn>9#!uau<f1b)Q+wLR$Cb8ru*L$VfE$Ckom
|
||||
zSdoS0vMR|XvDt&#WVvjX%qkAd;;$sPk3^<U(Cy<H&yk%*=Bs1%sM=3@ryr%T=$Sk@
|
||||
zo%+Zzn>xa!EhACl)lf%Bv|=O3jF)t>(74Dk14nO7ChpvtIqvFA1I*D~isu9iZex;Z
|
||||
zxu(_Fk%as}9J?%mK{O;uSaOjH_8XsMu}e;=5IRHPp)6RoRSa5w3D5lLMYlNSPxbT~
|
||||
zH}qo-g7Z>kv#s3c5*zZ7JYhXlG7a-gA-A8()0MQO##BZUpZAlox_+=L3986%XSy^t
|
||||
zj_!a?8{U*|j#I{_1f;nn*%lgH3|M+4*+rH3$@!lny7#o4DLMb2<<DPo#$N-sfxn>e
|
||||
z&%v|cBj8bR8~6@q_s@Y}1-}B;z%rNyH-OJ@X8#57UJ!s5m<BI#UjGXCG<X8+15@A)
|
||||
z;3jYlc$xG1AAny5LvRSpft}!1@O{qguYk{h$3O`7fWPOw{&zs~`9BHX4^D&K;9hVo
|
||||
z_+!rRAFyZnDgM65+5NA<=fN}JLm&e^&;|E^w}BhMw>iiEDR>HGK=S|PeE(MPM(`qM
|
||||
z`ric4fEDm|@HNi#zXU!4?ganAS^jUq3*ZCbeV_^M0Y3?@1z%+>WIR4CW0HTwgxqH<
|
||||
zfv|-x`Kn_hNxDR_LtxP;PJdenY{}A=$FxepI$6?SN1mijH{<ZddZKeBO#=|iWH!4I
|
||||
zY1gf2<*klAgzd<WuzbU_P<IELH+@JM*~oaJkW}r_dHnVSB^#W~coP0fnViifPtxXd
|
||||
zdTH_BOp;@ng=8~Qi9}B#kv3FGUq;gKkf9Zit15G|V3@Bz^ikS$NuZ}|dQUK|&>?<O
|
||||
z7WTT%oh;RrhrAh6FdNC#QmIY9LOS%pA^(V|Cy=!^C9JbiN3OzVOs_1z@m(@nW$7i!
|
||||
ztiCKMSWOfw>0m0=DV8ZAAy&2ZAdN}1mOL_@WPFL;5c`0h1d!~z6GieF@e{jxo?X|g
|
||||
z+-i89<G4GAvoA;kS%6s;t0zPm_)9hdt=RbG|DUMVtS80g52PpE=1%rY(_^<jBl|`e
|
||||
zn0k6(^m0>-9%C?PCXzE{&yB=r44bw%#GYEx;c`?rN|#F}bITFChvVt>G%S&hp>mVe
|
||||
zQE6dIbapZ_cQ0O+W(&EhGj+_^o8^)Q#1^P~YRPEg65o&;t?9pJFD*ZG&pnsyD2aDR
|
||||
zkIf%FJb!eKvtjexl+INflWw|})pky+UAv~$U3CtQLb=y@7W-SwSHGGfc4{}VRa2=(
|
||||
zGisZJGvoxwdCR=$!*}!UPfDh#vn5v0G|)%ug3wZx?kY5uK8{PMO)~#ZgsUCiKH9T~
|
||||
z{=$JWE41AJRU1Hu($TS1DYI1vSBX4~t<Ip?>gP>Vr`j^bQ{t&>jNO<7?7G{}<h2x1
|
||||
z>L}L^GBEY)W==6B601}3#WEPUQX5)|f}sSMOQePggeLaXEY>HZdNVpwNi`+JfKOKT
|
||||
zW0~=A+nMAHOJ816)<n$=MVcit*-DARs&)pI=wlOwv+}*J_U)5|aoa)Bm<dnH3R4(G
|
||||
zh5g~6o#|qwM^IOVx)4UBHGPo?jYJkVynr_H%)P&r_orY{QpZRots<g98!KtU99yF8
|
||||
zZfuFRi*kv)45Mv?Z2fBAa&?(`ad4JbROAIR=F@5WXt^TP3ZvbW?Y=Fo6xzxgEax?{
|
||||
z(yz+}EiJKYr))hY-jcU$`%q)xrWwp)s5x*U3JzT7mgn?JZ&Yd-ZxA)it9iDq`snz&
|
||||
zvDE4)lvrqlCfz*QCHtOE%zHp;hi=MF0UaUN$02Kt#j#D9Se{Ia4K=DUb#v3QB9oxP
|
||||
zwzU1w@6WNRu*bx!Fm!?M5q`vZteUtpl5-)+%;rs24mL%JOcA9&qh!VLrXZ-fOO729
|
||||
zKPK3rQ|qhji{p;jMqasN`rfA);}JIIeOp|cZr)uN8TD0FD!Q+0X5s+sdf+Oou)><h
|
||||
z@^6Kg)7(m_yy$C1XT{;NAb4%c(0;9`ypg*;l3D_HPgH9qao@bzRy$*&a%wMunV*_c
|
||||
zmoB*%A5@d;G*^Q@+GSJ180JQ6>pIJ;jMG|PctyQ!GSmbiv3Qr)u&ouEmum^pkkc@$
|
||||
zw#m&VrMmx{u&J%gPF<Xum0rTGOo$t96J~@>TffSIcHAo>@*W5;6-uS6@+S&5%ay{F
|
||||
cT45AdikYcun%oMsfwvWjb+Ig{u-NAPH%ay)TmS$7
|
||||
Text/Shakespeare.hs | 3 +++
|
||||
1 file changed, 3 insertions(+)
|
||||
|
||||
diff --git a/Text/Shakespeare.hs b/Text/Shakespeare.hs
|
||||
index d300951..fabbf66 100644
|
||||
index 9eb06a2..1290ab1 100644
|
||||
--- a/Text/Shakespeare.hs
|
||||
+++ b/Text/Shakespeare.hs
|
||||
@@ -22,6 +22,8 @@ module Text.Shakespeare
|
||||
@@ -23,6 +23,9 @@ module Text.Shakespeare
|
||||
, Deref
|
||||
, Parser
|
||||
|
||||
+ -- used by TH
|
||||
+ , pack'
|
||||
+
|
||||
#ifdef TEST_EXPORT
|
||||
, preFilter
|
||||
#endif
|
||||
+ -- used by TH splices
|
||||
+ , pack'
|
||||
) where
|
||||
|
||||
import Data.List (intersperse)
|
||||
--
|
||||
1.8.2.rc3
|
||||
1.7.10.4
|
||||
|
||||
|
|
|
@ -1,208 +0,0 @@
|
|||
From 10484c5f68431349b249f07517c392c4a90bdb05 Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Wed, 8 May 2013 01:47:19 -0400
|
||||
Subject: [PATCH] remove TH
|
||||
|
||||
---
|
||||
Text/Shakespeare.hs | 109 ----------------------------------------------
|
||||
Text/Shakespeare/Base.hs | 28 ------------
|
||||
shakespeare.cabal | 2 +-
|
||||
3 files changed, 1 insertion(+), 138 deletions(-)
|
||||
|
||||
diff --git a/Text/Shakespeare.hs b/Text/Shakespeare.hs
|
||||
index 7750135..fabbf66 100644
|
||||
--- a/Text/Shakespeare.hs
|
||||
+++ b/Text/Shakespeare.hs
|
||||
@@ -12,11 +12,7 @@ module Text.Shakespeare
|
||||
, WrapInsertion (..)
|
||||
, PreConversion (..)
|
||||
, defaultShakespeareSettings
|
||||
- , shakespeare
|
||||
- , shakespeareFile
|
||||
- , shakespeareFileReload
|
||||
-- * low-level
|
||||
- , shakespeareFromString
|
||||
, shakespeareUsedIdentifiers
|
||||
, RenderUrl
|
||||
, VarType
|
||||
@@ -135,39 +131,6 @@ defaultShakespeareSettings = ShakespeareSettings {
|
||||
, modifyFinalValue = Nothing
|
||||
}
|
||||
|
||||
-instance Lift PreConvert where
|
||||
- lift (PreConvert convert ignore comment wrapInsertion) =
|
||||
- [|PreConvert $(lift convert) $(lift ignore) $(lift comment) $(lift wrapInsertion)|]
|
||||
-
|
||||
-instance Lift WrapInsertion where
|
||||
- lift (WrapInsertion indent sb sep sc e ab ac) =
|
||||
- [|WrapInsertion $(lift indent) $(lift sb) $(lift sep) $(lift sc) $(lift e) $(lift ab) $(lift ac)|]
|
||||
-
|
||||
-instance Lift PreConversion where
|
||||
- lift (ReadProcess command args) =
|
||||
- [|ReadProcess $(lift command) $(lift args)|]
|
||||
- lift Id = [|Id|]
|
||||
-
|
||||
-instance Lift ShakespeareSettings where
|
||||
- lift (ShakespeareSettings x1 x2 x3 x4 x5 x6 x7 x8 x9) =
|
||||
- [|ShakespeareSettings
|
||||
- $(lift x1) $(lift x2) $(lift x3)
|
||||
- $(liftExp x4) $(liftExp x5) $(liftExp x6) $(lift x7) $(lift x8) $(liftMExp x9)|]
|
||||
- where
|
||||
- liftExp (VarE n) = [|VarE $(liftName n)|]
|
||||
- liftExp (ConE n) = [|ConE $(liftName n)|]
|
||||
- liftExp _ = error "liftExp only supports VarE and ConE"
|
||||
- liftMExp Nothing = [|Nothing|]
|
||||
- liftMExp (Just e) = [|Just|] `appE` liftExp e
|
||||
- liftName (Name (OccName a) b) = [|Name (OccName $(lift a)) $(liftFlavour b)|]
|
||||
- liftFlavour NameS = [|NameS|]
|
||||
- liftFlavour (NameQ (ModName a)) = [|NameQ (ModName $(lift a))|]
|
||||
- liftFlavour (NameU _) = error "liftFlavour NameU" -- [|NameU $(lift $ fromIntegral a)|]
|
||||
- liftFlavour (NameL _) = error "liftFlavour NameL" -- [|NameU $(lift $ fromIntegral a)|]
|
||||
- liftFlavour (NameG ns (PkgName p) (ModName m)) = [|NameG $(liftNS ns) (PkgName $(lift p)) (ModName $(lift m))|]
|
||||
- liftNS VarName = [|VarName|]
|
||||
- liftNS DataName = [|DataName|]
|
||||
-
|
||||
type QueryParameters = [(TS.Text, TS.Text)]
|
||||
type RenderUrl url = (url -> QueryParameters -> TS.Text)
|
||||
type Shakespeare url = RenderUrl url -> Builder
|
||||
@@ -302,54 +265,6 @@ pack' = TS.pack
|
||||
{-# NOINLINE pack' #-}
|
||||
#endif
|
||||
|
||||
-contentsToShakespeare :: ShakespeareSettings -> [Content] -> Q Exp
|
||||
-contentsToShakespeare rs a = do
|
||||
- r <- newName "_render"
|
||||
- c <- mapM (contentToBuilder r) a
|
||||
- compiledTemplate <- case c of
|
||||
- -- Make sure we convert this mempty using toBuilder to pin down the
|
||||
- -- type appropriately
|
||||
- [] -> fmap (AppE $ wrap rs) [|mempty|]
|
||||
- [x] -> return x
|
||||
- _ -> do
|
||||
- mc <- [|mconcat|]
|
||||
- return $ mc `AppE` ListE c
|
||||
- fmap (maybe id AppE $ modifyFinalValue rs) $
|
||||
- if justVarInterpolation rs
|
||||
- then return compiledTemplate
|
||||
- else return $ LamE [VarP r] compiledTemplate
|
||||
- where
|
||||
- contentToBuilder :: Name -> Content -> Q Exp
|
||||
- contentToBuilder _ (ContentRaw s') = do
|
||||
- ts <- [|fromText . pack'|]
|
||||
- return $ wrap rs `AppE` (ts `AppE` LitE (StringL s'))
|
||||
- contentToBuilder _ (ContentVar d) =
|
||||
- return $ wrap rs `AppE` (toBuilder rs `AppE` derefToExp [] d)
|
||||
- contentToBuilder r (ContentUrl d) = do
|
||||
- ts <- [|fromText|]
|
||||
- return $ wrap rs `AppE` (ts `AppE` (VarE r `AppE` derefToExp [] d `AppE` ListE []))
|
||||
- contentToBuilder r (ContentUrlParam d) = do
|
||||
- ts <- [|fromText|]
|
||||
- up <- [|\r' (u, p) -> r' u p|]
|
||||
- return $ wrap rs `AppE` (ts `AppE` (up `AppE` VarE r `AppE` derefToExp [] d))
|
||||
- contentToBuilder r (ContentMix d) =
|
||||
- return $ derefToExp [] d `AppE` VarE r
|
||||
-
|
||||
-shakespeare :: ShakespeareSettings -> QuasiQuoter
|
||||
-shakespeare r = QuasiQuoter { quoteExp = shakespeareFromString r }
|
||||
-
|
||||
-shakespeareFromString :: ShakespeareSettings -> String -> Q Exp
|
||||
-shakespeareFromString r str = do
|
||||
- s <- qRunIO $ preFilter r str
|
||||
- contentsToShakespeare r $ contentFromString r s
|
||||
-
|
||||
-shakespeareFile :: ShakespeareSettings -> FilePath -> Q Exp
|
||||
-shakespeareFile r fp = do
|
||||
-#ifdef GHC_7_4
|
||||
- qAddDependentFile fp
|
||||
-#endif
|
||||
- readFileQ fp >>= shakespeareFromString r
|
||||
-
|
||||
data VarType = VTPlain | VTUrl | VTUrlParam | VTMixin
|
||||
|
||||
getVars :: Content -> [(Deref, VarType)]
|
||||
@@ -369,30 +284,6 @@ data VarExp url = EPlain Builder
|
||||
shakespeareUsedIdentifiers :: ShakespeareSettings -> String -> [(Deref, VarType)]
|
||||
shakespeareUsedIdentifiers settings = concatMap getVars . contentFromString settings
|
||||
|
||||
-shakespeareFileReload :: ShakespeareSettings -> FilePath -> Q Exp
|
||||
-shakespeareFileReload rs fp = do
|
||||
- str <- readFileQ fp
|
||||
- s <- qRunIO $ preFilter rs str
|
||||
- let b = shakespeareUsedIdentifiers rs s
|
||||
- c <- mapM vtToExp b
|
||||
- rt <- [|shakespeareRuntime|]
|
||||
- wrap' <- [|\x -> $(return $ wrap rs) . x|]
|
||||
- r' <- lift rs
|
||||
- return $ wrap' `AppE` (rt `AppE` r' `AppE` (LitE $ StringL fp) `AppE` ListE c)
|
||||
- where
|
||||
- vtToExp :: (Deref, VarType) -> Q Exp
|
||||
- vtToExp (d, vt) = do
|
||||
- d' <- lift d
|
||||
- c' <- c vt
|
||||
- return $ TupE [d', c' `AppE` derefToExp [] d]
|
||||
- where
|
||||
- c :: VarType -> Q Exp
|
||||
- c VTPlain = [|EPlain . $(return $ toBuilder rs)|]
|
||||
- c VTUrl = [|EUrl|]
|
||||
- c VTUrlParam = [|EUrlParam|]
|
||||
- c VTMixin = [|\x -> EMixin $ \r -> $(return $ unwrap rs) $ x r|]
|
||||
-
|
||||
-
|
||||
shakespeareRuntime :: ShakespeareSettings -> FilePath -> [(Deref, VarExp url)] -> Shakespeare url
|
||||
shakespeareRuntime rs fp cd render' = unsafePerformIO $ do
|
||||
str <- readFileUtf8 fp
|
||||
diff --git a/Text/Shakespeare/Base.hs b/Text/Shakespeare/Base.hs
|
||||
index 7c96898..ef769b1 100644
|
||||
--- a/Text/Shakespeare/Base.hs
|
||||
+++ b/Text/Shakespeare/Base.hs
|
||||
@@ -52,34 +52,6 @@ data Deref = DerefModulesIdent [String] Ident
|
||||
| DerefTuple [Deref]
|
||||
deriving (Show, Eq, Read, Data, Typeable, Ord)
|
||||
|
||||
-instance Lift Ident where
|
||||
- lift (Ident s) = [|Ident|] `appE` lift s
|
||||
-instance Lift Deref where
|
||||
- lift (DerefModulesIdent v s) = do
|
||||
- dl <- [|DerefModulesIdent|]
|
||||
- v' <- lift v
|
||||
- s' <- lift s
|
||||
- return $ dl `AppE` v' `AppE` s'
|
||||
- lift (DerefIdent s) = do
|
||||
- dl <- [|DerefIdent|]
|
||||
- s' <- lift s
|
||||
- return $ dl `AppE` s'
|
||||
- lift (DerefBranch x y) = do
|
||||
- x' <- lift x
|
||||
- y' <- lift y
|
||||
- db <- [|DerefBranch|]
|
||||
- return $ db `AppE` x' `AppE` y'
|
||||
- lift (DerefIntegral i) = [|DerefIntegral|] `appE` lift i
|
||||
- lift (DerefRational r) = do
|
||||
- n <- lift $ numerator r
|
||||
- d <- lift $ denominator r
|
||||
- per <- [|(%) :: Int -> Int -> Ratio Int|]
|
||||
- dr <- [|DerefRational|]
|
||||
- return $ dr `AppE` InfixE (Just n) per (Just d)
|
||||
- lift (DerefString s) = [|DerefString|] `appE` lift s
|
||||
- lift (DerefList x) = [|DerefList $(lift x)|]
|
||||
- lift (DerefTuple x) = [|DerefTuple $(lift x)|]
|
||||
-
|
||||
derefParens, derefCurlyBrackets :: UserParser a Deref
|
||||
derefParens = between (char '(') (char ')') parseDeref
|
||||
derefCurlyBrackets = between (char '{') (char '}') parseDeref
|
||||
diff --git a/shakespeare.cabal b/shakespeare.cabal
|
||||
index 01c8d5d..0fff966 100644
|
||||
--- a/shakespeare.cabal
|
||||
+++ b/shakespeare.cabal
|
||||
@@ -27,7 +27,7 @@ library
|
||||
, template-haskell
|
||||
, parsec >= 2 && < 4
|
||||
, text >= 0.7 && < 0.12
|
||||
- , process >= 1.0 && < 1.2
|
||||
+ , process >= 1.0 && < 1.3
|
||||
|
||||
exposed-modules:
|
||||
Text.Shakespeare
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -0,0 +1,24 @@
|
|||
From 3a04b41ffce4e4e87b0fedd3a1e3434a3f06cc76 Mon Sep 17 00:00:00 2001
|
||||
From: foo <foo@bar>
|
||||
Date: Sun, 22 Sep 2013 00:18:12 +0000
|
||||
Subject: [PATCH] hardcode little endian
|
||||
|
||||
---
|
||||
c_impl/optimized/skein_port.h | 1 +
|
||||
1 file changed, 1 insertion(+)
|
||||
|
||||
diff --git a/c_impl/optimized/skein_port.h b/c_impl/optimized/skein_port.h
|
||||
index a2d0fc2..6929bb0 100644
|
||||
--- a/c_impl/optimized/skein_port.h
|
||||
+++ b/c_impl/optimized/skein_port.h
|
||||
@@ -45,6 +45,7 @@ typedef uint64_t u64b_t; /* 64-bit unsigned integer */
|
||||
* platform-specific code instead (e.g., for big-endian CPUs).
|
||||
*
|
||||
*/
|
||||
+#define SKEIN_NEED_SWAP (0)
|
||||
#ifndef SKEIN_NEED_SWAP /* compile-time "override" for endianness? */
|
||||
|
||||
#include "brg_endian.h" /* get endianness selection */
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,43 +1,29 @@
|
|||
From abab0f8202998a3e88c5dc5f67a8245da6c174b3 Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Thu, 28 Feb 2013 23:36:20 -0400
|
||||
From 28e6a6599ee91e15aa7b2f9d25433490f192f22e Mon Sep 17 00:00:00 2001
|
||||
From: foo <foo@bar>
|
||||
Date: Sat, 21 Sep 2013 23:17:29 +0000
|
||||
Subject: [PATCH] remove IPv6 stuff
|
||||
|
||||
---
|
||||
Network/Socks5.hs | 1 -
|
||||
Network/Socks5/Command.hs | 16 ++--------------
|
||||
Network/Socks5/Types.hs | 3 +--
|
||||
Network/Socks5/Wire.hs | 2 --
|
||||
4 files changed, 3 insertions(+), 19 deletions(-)
|
||||
Network/Socks5/Command.hs | 8 +-------
|
||||
Network/Socks5/Conf.hs | 1 -
|
||||
Network/Socks5/Lowlevel.hs | 1 -
|
||||
Network/Socks5/Types.hs | 18 +-----------------
|
||||
Network/Socks5/Wire.hs | 2 --
|
||||
5 files changed, 2 insertions(+), 28 deletions(-)
|
||||
|
||||
diff --git a/Network/Socks5.hs b/Network/Socks5.hs
|
||||
index 67b0060..80efb9c 100644
|
||||
--- a/Network/Socks5.hs
|
||||
+++ b/Network/Socks5.hs
|
||||
@@ -54,7 +54,6 @@ socksConnectAddr :: Socket -> SockAddr -> SockAddr -> IO ()
|
||||
socksConnectAddr sock sockserver destaddr = withSocks sock sockserver $ do
|
||||
case destaddr of
|
||||
SockAddrInet p h -> socks5ConnectIPV4 sock h p >> return ()
|
||||
- SockAddrInet6 p _ h _ -> socks5ConnectIPV6 sock h p >> return ()
|
||||
_ -> error "unsupported unix sockaddr type"
|
||||
|
||||
-- | connect a new socket to the socks server, and connect the stream to a FQDN
|
||||
diff --git a/Network/Socks5/Command.hs b/Network/Socks5/Command.hs
|
||||
index 2952706..db994c9 100644
|
||||
index 8ce06ec..222d954 100644
|
||||
--- a/Network/Socks5/Command.hs
|
||||
+++ b/Network/Socks5/Command.hs
|
||||
@@ -9,9 +9,8 @@
|
||||
--
|
||||
module Network.Socks5.Command
|
||||
( socks5Establish
|
||||
- , socks5ConnectIPV4
|
||||
- , socks5ConnectIPV6
|
||||
, socks5ConnectDomainName
|
||||
+ , socks5ConnectIPV4
|
||||
-- * lowlevel interface
|
||||
, socks5Rpc
|
||||
) where
|
||||
@@ -23,7 +22,7 @@ import qualified Data.ByteString as B
|
||||
@@ -12,7 +12,6 @@ module Network.Socks5.Command
|
||||
, Connect(..)
|
||||
, Command(..)
|
||||
, connectIPV4
|
||||
- , connectIPV6
|
||||
, connectDomainName
|
||||
-- * lowlevel interface
|
||||
, rpc
|
||||
@@ -28,7 +27,7 @@ import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString.Char8 as BC
|
||||
import Data.Serialize
|
||||
|
||||
|
@ -46,50 +32,92 @@ index 2952706..db994c9 100644
|
|||
import Network.Socket.ByteString
|
||||
|
||||
import Network.Socks5.Types
|
||||
@@ -46,17 +45,6 @@ socks5ConnectIPV4 socket hostaddr port = onReply <$> socks5Rpc socket request
|
||||
onReply (SocksAddrIPV4 h, p) = (h, p)
|
||||
onReply _ = error "ipv4 requested, got something different"
|
||||
@@ -64,11 +63,6 @@ connectIPV4 socket hostaddr port = onReply <$> rpc_ socket (Connect $ SocksAddre
|
||||
where onReply (SocksAddrIPV4 h, p) = (h, p)
|
||||
onReply _ = error "ipv4 requested, got something different"
|
||||
|
||||
-socks5ConnectIPV6 :: Socket -> HostAddress6 -> PortNumber -> IO (HostAddress6, PortNumber)
|
||||
-socks5ConnectIPV6 socket hostaddr6 port = onReply <$> socks5Rpc socket request
|
||||
- where
|
||||
- request = SocksRequest
|
||||
- { requestCommand = SocksCommandConnect
|
||||
- , requestDstAddr = SocksAddrIPV6 hostaddr6
|
||||
- , requestDstPort = fromIntegral port
|
||||
- }
|
||||
- onReply (SocksAddrIPV6 h, p) = (h, p)
|
||||
- onReply _ = error "ipv6 requested, got something different"
|
||||
-connectIPV6 :: Socket -> HostAddress6 -> PortNumber -> IO (HostAddress6, PortNumber)
|
||||
-connectIPV6 socket hostaddr6 port = onReply <$> rpc_ socket (Connect $ SocksAddress (SocksAddrIPV6 hostaddr6) port)
|
||||
- where onReply (SocksAddrIPV6 h, p) = (h, p)
|
||||
- onReply _ = error "ipv6 requested, got something different"
|
||||
-
|
||||
-- TODO: FQDN should only be ascii, maybe putting a "fqdn" data type
|
||||
-- in front to make sure and make the BC.pack safe.
|
||||
socks5ConnectDomainName :: Socket -> String -> PortNumber -> IO (SocksAddr, PortNumber)
|
||||
connectDomainName :: Socket -> String -> PortNumber -> IO (SocksHostAddress, PortNumber)
|
||||
diff --git a/Network/Socks5/Conf.hs b/Network/Socks5/Conf.hs
|
||||
index c29ff7b..007d382 100644
|
||||
--- a/Network/Socks5/Conf.hs
|
||||
+++ b/Network/Socks5/Conf.hs
|
||||
@@ -47,5 +47,4 @@ defaultSocksConfFromSockAddr sockaddr = SocksConf server SocksVer5
|
||||
where server = SocksAddress haddr port
|
||||
(haddr,port) = case sockaddr of
|
||||
SockAddrInet p h -> (SocksAddrIPV4 h, p)
|
||||
- SockAddrInet6 p _ h _ -> (SocksAddrIPV6 h, p)
|
||||
_ -> error "unsupported unix sockaddr type"
|
||||
diff --git a/Network/Socks5/Lowlevel.hs b/Network/Socks5/Lowlevel.hs
|
||||
index c10d9b9..2c3d59c 100644
|
||||
--- a/Network/Socks5/Lowlevel.hs
|
||||
+++ b/Network/Socks5/Lowlevel.hs
|
||||
@@ -17,7 +17,6 @@ resolveToSockAddr :: SocksAddress -> IO SockAddr
|
||||
resolveToSockAddr (SocksAddress sockHostAddr port) =
|
||||
case sockHostAddr of
|
||||
SocksAddrIPV4 ha -> return $ SockAddrInet port ha
|
||||
- SocksAddrIPV6 ha6 -> return $ SockAddrInet6 port 0 ha6 0
|
||||
SocksAddrDomainName bs -> do he <- getHostByName (BC.unpack bs)
|
||||
return $ SockAddrInet port (hostAddress he)
|
||||
|
||||
diff --git a/Network/Socks5/Types.hs b/Network/Socks5/Types.hs
|
||||
index 5dc7d5e..12dea99 100644
|
||||
index 7fbec25..17c7c83 100644
|
||||
--- a/Network/Socks5/Types.hs
|
||||
+++ b/Network/Socks5/Types.hs
|
||||
@@ -17,7 +17,7 @@ module Network.Socks5.Types
|
||||
@@ -19,7 +19,7 @@ module Network.Socks5.Types
|
||||
import Data.ByteString (ByteString)
|
||||
import Data.Word
|
||||
import Data.Data
|
||||
-import Network.Socket (HostAddress, HostAddress6)
|
||||
+import Network.Socket (HostAddress)
|
||||
-import Network.Socket (HostAddress, HostAddress6, PortNumber)
|
||||
+import Network.Socket (HostAddress, PortNumber)
|
||||
import Control.Exception
|
||||
import qualified Data.ByteString.Char8 as BC
|
||||
import Numeric (showHex)
|
||||
@@ -53,12 +53,10 @@ data SocksMethod =
|
||||
data SocksHostAddress =
|
||||
SocksAddrIPV4 !HostAddress
|
||||
| SocksAddrDomainName !ByteString
|
||||
- | SocksAddrIPV6 !HostAddress6
|
||||
deriving (Eq,Ord)
|
||||
|
||||
data SocksCommand =
|
||||
@@ -38,7 +38,6 @@ data SocksMethod =
|
||||
data SocksAddr =
|
||||
SocksAddrIPV4 HostAddress
|
||||
| SocksAddrDomainName ByteString
|
||||
- | SocksAddrIPV6 HostAddress6
|
||||
deriving (Show,Eq)
|
||||
instance Show SocksHostAddress where
|
||||
show (SocksAddrIPV4 ha) = "SocksAddrIPV4(" ++ showHostAddress ha ++ ")"
|
||||
- show (SocksAddrIPV6 ha6) = "SocksAddrIPV6(" ++ showHostAddress6 ha6 ++ ")"
|
||||
show (SocksAddrDomainName dn) = "SocksAddrDomainName(" ++ BC.unpack dn ++ ")"
|
||||
|
||||
data SocksReply =
|
||||
-- | Converts a HostAddress to a String in dot-decimal notation
|
||||
@@ -69,20 +67,6 @@ showHostAddress num = concat [show q1, ".", show q2, ".", show q3, ".", show q4]
|
||||
(num''',q3) = num'' `quotRem` 256
|
||||
(_,q4) = num''' `quotRem` 256
|
||||
|
||||
--- | Converts a IPv6 HostAddress6 to standard hex notation
|
||||
-showHostAddress6 :: HostAddress6 -> String
|
||||
-showHostAddress6 (a,b,c,d) =
|
||||
- (concat . intersperse ":" . map (flip showHex ""))
|
||||
- [p1,p2,p3,p4,p5,p6,p7,p8]
|
||||
- where (a',p2) = a `quotRem` 65536
|
||||
- (_,p1) = a' `quotRem` 65536
|
||||
- (b',p4) = b `quotRem` 65536
|
||||
- (_,p3) = b' `quotRem` 65536
|
||||
- (c',p6) = c `quotRem` 65536
|
||||
- (_,p5) = c' `quotRem` 65536
|
||||
- (d',p8) = d `quotRem` 65536
|
||||
- (_,p7) = d' `quotRem` 65536
|
||||
-
|
||||
-- | Describe a Socket address on the SOCKS protocol
|
||||
data SocksAddress = SocksAddress !SocksHostAddress !PortNumber
|
||||
deriving (Show,Eq,Ord)
|
||||
diff --git a/Network/Socks5/Wire.hs b/Network/Socks5/Wire.hs
|
||||
index 2cfed52..d3bd9c5 100644
|
||||
index 3ab95a8..2881988 100644
|
||||
--- a/Network/Socks5/Wire.hs
|
||||
+++ b/Network/Socks5/Wire.hs
|
||||
@@ -41,12 +41,10 @@ data SocksResponse = SocksResponse
|
||||
@@ -46,12 +46,10 @@ data SocksResponse = SocksResponse
|
||||
|
||||
getAddr 1 = SocksAddrIPV4 <$> getWord32be
|
||||
getAddr 3 = SocksAddrDomainName <$> (getWord8 >>= getByteString . fromIntegral)
|
||||
|
@ -101,7 +129,7 @@ index 2cfed52..d3bd9c5 100644
|
|||
-putAddr (SocksAddrIPV6 (a,b,c,d)) = putWord8 4 >> mapM_ putWord32host [a,b,c,d]
|
||||
|
||||
getSocksRequest 5 = do
|
||||
cmd <- toEnum . fromIntegral <$> getWord8
|
||||
cmd <- toEnum . fromIntegral <$> getWord8
|
||||
--
|
||||
1.7.10.4
|
||||
|
||||
|
|
|
@ -1,25 +0,0 @@
|
|||
From 2feaef797641587a3da83753ee17d20e712c79cf Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Thu, 28 Feb 2013 23:36:30 -0400
|
||||
Subject: [PATCH] modify to build with unreleased ghc
|
||||
|
||||
---
|
||||
split.cabal | 2 +-
|
||||
1 file changed, 1 insertion(+), 1 deletion(-)
|
||||
|
||||
diff --git a/split.cabal b/split.cabal
|
||||
index 2183c3e..29b9b32 100644
|
||||
--- a/split.cabal
|
||||
+++ b/split.cabal
|
||||
@@ -51,7 +51,7 @@ Source-repository head
|
||||
|
||||
Library
|
||||
ghc-options: -Wall
|
||||
- build-depends: base <4.7
|
||||
+ build-depends: base <4.8
|
||||
exposed-modules: Data.List.Split, Data.List.Split.Internals
|
||||
default-language: Haskell2010
|
||||
Hs-source-dirs: src
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,25 +0,0 @@
|
|||
From c40fe2c484096c5de4cac8ca14a0ca5d892999f7 Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Thu, 28 Feb 2013 23:36:43 -0400
|
||||
Subject: [PATCH] hack for cross-compiling
|
||||
|
||||
---
|
||||
syb.cabal | 2 +-
|
||||
1 file changed, 1 insertion(+), 1 deletion(-)
|
||||
|
||||
diff --git a/syb.cabal b/syb.cabal
|
||||
index 0aee93d..0a645c6 100644
|
||||
--- a/syb.cabal
|
||||
+++ b/syb.cabal
|
||||
@@ -17,7 +17,7 @@ description:
|
||||
|
||||
category: Generics
|
||||
stability: provisional
|
||||
-build-type: Custom
|
||||
+build-type: Simple
|
||||
cabal-version: >= 1.6
|
||||
|
||||
extra-source-files: tests/*.hs,
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,81 +0,0 @@
|
|||
From 4023b952871ad2bc248db887716d06932ac0dbb9 Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Wed, 8 May 2013 14:00:19 -0400
|
||||
Subject: [PATCH] hacks for android
|
||||
|
||||
---
|
||||
cbits/conv.c | 4 +---
|
||||
unix-time.cabal | 28 ++--------------------------
|
||||
2 files changed, 3 insertions(+), 29 deletions(-)
|
||||
|
||||
diff --git a/cbits/conv.c b/cbits/conv.c
|
||||
index 3b6a129..5a68f91 100644
|
||||
--- a/cbits/conv.c
|
||||
+++ b/cbits/conv.c
|
||||
@@ -1,5 +1,3 @@
|
||||
-#include "config.h"
|
||||
-
|
||||
#if IS_LINUX
|
||||
/* Linux cheats AC_CHECK_FUNCS(strptime_l), sigh. */
|
||||
#define THREAD_SAFE 0
|
||||
@@ -51,7 +49,7 @@ time_t c_parse_unix_time_gmt(char *fmt, char *src) {
|
||||
#else
|
||||
strptime(src, fmt, &dst);
|
||||
#endif
|
||||
- return timegm(&dst);
|
||||
+ return NULL; /* timegm(&dst); */
|
||||
}
|
||||
|
||||
void c_format_unix_time(char *fmt, time_t src, char* dst, int siz) {
|
||||
diff --git a/unix-time.cabal b/unix-time.cabal
|
||||
index a905d63..f32d952 100644
|
||||
--- a/unix-time.cabal
|
||||
+++ b/unix-time.cabal
|
||||
@@ -8,7 +8,7 @@ Synopsis: Unix time parser/formatter and utilities
|
||||
Description: Fast parser\/formatter\/utilities for Unix time
|
||||
Category: Data
|
||||
Cabal-Version: >= 1.10
|
||||
-Build-Type: Configure
|
||||
+Build-Type: Simple
|
||||
Extra-Source-Files: cbits/conv.c cbits/config.h.in configure configure.ac
|
||||
Extra-Tmp-Files: config.log config.status autom4te.cache cbits/config.h
|
||||
|
||||
@@ -21,34 +21,10 @@ Library
|
||||
Data.UnixTime.Types
|
||||
Data.UnixTime.Sys
|
||||
Build-Depends: base >= 4 && < 5
|
||||
- , bytestring
|
||||
+ , bytestring (>= 0.10.3.0)
|
||||
, old-time
|
||||
C-Sources: cbits/conv.c
|
||||
|
||||
-Test-Suite doctests
|
||||
- Type: exitcode-stdio-1.0
|
||||
- HS-Source-Dirs: test
|
||||
- Ghc-Options: -threaded -Wall
|
||||
- Main-Is: doctests.hs
|
||||
- Build-Depends: base
|
||||
- , doctest >= 0.9.3
|
||||
-
|
||||
-Test-Suite spec
|
||||
- Type: exitcode-stdio-1.0
|
||||
- Default-Language: Haskell2010
|
||||
- Hs-Source-Dirs: test
|
||||
- Ghc-Options: -Wall
|
||||
- Main-Is: Spec.hs
|
||||
- Other-Modules: UnixTimeSpec
|
||||
- Build-Depends: base
|
||||
- , bytestring
|
||||
- , hspec
|
||||
- , old-locale
|
||||
- , old-time
|
||||
- , QuickCheck
|
||||
- , time
|
||||
- , unix-time
|
||||
-
|
||||
Source-Repository head
|
||||
Type: git
|
||||
Location: https://github.com/kazu-yamamoto/unix-time
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -0,0 +1,25 @@
|
|||
From eff7034f0c9f80fd30c9d8952b3fd0a343adccc8 Mon Sep 17 00:00:00 2001
|
||||
From: foo <bar>
|
||||
Date: Mon, 23 Sep 2013 00:12:35 +0000
|
||||
Subject: [PATCH] hack for Bionic
|
||||
|
||||
---
|
||||
cbits/conv.c | 2 +-
|
||||
1 file changed, 1 insertion(+), 1 deletion(-)
|
||||
|
||||
diff --git a/cbits/conv.c b/cbits/conv.c
|
||||
index 7ff7b87..2e4c870 100644
|
||||
--- a/cbits/conv.c
|
||||
+++ b/cbits/conv.c
|
||||
@@ -55,7 +55,7 @@ time_t c_parse_unix_time_gmt(char *fmt, char *src) {
|
||||
#else
|
||||
strptime(src, fmt, &dst);
|
||||
#endif
|
||||
- return timegm(&dst);
|
||||
+ return NULL; /* timegm(&dst); (not in Bionic) */
|
||||
}
|
||||
|
||||
size_t c_format_unix_time(char *fmt, time_t src, char* dst, int siz) {
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,91 +0,0 @@
|
|||
From abca378462337ca0eb13a7e4d3073cb96a50d36c Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Thu, 28 Feb 2013 23:37:23 -0400
|
||||
Subject: [PATCH] remove stuff not available on Android
|
||||
|
||||
---
|
||||
System/Posix/Resource.hsc | 4 ++++
|
||||
System/Posix/Terminal/Common.hsc | 29 +++--------------------------
|
||||
2 files changed, 7 insertions(+), 26 deletions(-)
|
||||
|
||||
diff --git a/System/Posix/Resource.hsc b/System/Posix/Resource.hsc
|
||||
index 6651998..2615b1e 100644
|
||||
--- a/System/Posix/Resource.hsc
|
||||
+++ b/System/Posix/Resource.hsc
|
||||
@@ -101,7 +101,9 @@ packResource ResourceTotalMemory = (#const RLIMIT_AS)
|
||||
#endif
|
||||
|
||||
unpackRLimit :: CRLim -> ResourceLimit
|
||||
+#if 0
|
||||
unpackRLimit (#const RLIM_INFINITY) = ResourceLimitInfinity
|
||||
+#endif
|
||||
#ifdef RLIM_SAVED_MAX
|
||||
unpackRLimit (#const RLIM_SAVED_MAX) = ResourceLimitUnknown
|
||||
unpackRLimit (#const RLIM_SAVED_CUR) = ResourceLimitUnknown
|
||||
@@ -109,7 +111,9 @@ unpackRLimit (#const RLIM_SAVED_CUR) = ResourceLimitUnknown
|
||||
unpackRLimit other = ResourceLimit (fromIntegral other)
|
||||
|
||||
packRLimit :: ResourceLimit -> Bool -> CRLim
|
||||
+#if 0
|
||||
packRLimit ResourceLimitInfinity _ = (#const RLIM_INFINITY)
|
||||
+#endif
|
||||
#ifdef RLIM_SAVED_MAX
|
||||
packRLimit ResourceLimitUnknown True = (#const RLIM_SAVED_CUR)
|
||||
packRLimit ResourceLimitUnknown False = (#const RLIM_SAVED_MAX)
|
||||
diff --git a/System/Posix/Terminal/Common.hsc b/System/Posix/Terminal/Common.hsc
|
||||
index 3a6254d..32a22f2 100644
|
||||
--- a/System/Posix/Terminal/Common.hsc
|
||||
+++ b/System/Posix/Terminal/Common.hsc
|
||||
@@ -419,11 +419,7 @@ foreign import ccall unsafe "tcsendbreak"
|
||||
-- | @drainOutput fd@ calls @tcdrain@ to block until all output
|
||||
-- written to @Fd@ @fd@ has been transmitted.
|
||||
drainOutput :: Fd -> IO ()
|
||||
-drainOutput (Fd fd) = throwErrnoIfMinus1_ "drainOutput" (c_tcdrain fd)
|
||||
-
|
||||
-foreign import ccall unsafe "tcdrain"
|
||||
- c_tcdrain :: CInt -> IO CInt
|
||||
-
|
||||
+drainOutput (Fd fd) = error "drainOutput not implemented"
|
||||
|
||||
data QueueSelector
|
||||
= InputQueue -- TCIFLUSH
|
||||
@@ -434,16 +430,7 @@ data QueueSelector
|
||||
-- pending input and\/or output for @Fd@ @fd@,
|
||||
-- as indicated by the @QueueSelector@ @queues@.
|
||||
discardData :: Fd -> QueueSelector -> IO ()
|
||||
-discardData (Fd fd) queue =
|
||||
- throwErrnoIfMinus1_ "discardData" (c_tcflush fd (queue2Int queue))
|
||||
- where
|
||||
- queue2Int :: QueueSelector -> CInt
|
||||
- queue2Int InputQueue = (#const TCIFLUSH)
|
||||
- queue2Int OutputQueue = (#const TCOFLUSH)
|
||||
- queue2Int BothQueues = (#const TCIOFLUSH)
|
||||
-
|
||||
-foreign import ccall unsafe "tcflush"
|
||||
- c_tcflush :: CInt -> CInt -> IO CInt
|
||||
+discardData (Fd fd) queue = error "discardData not implemented"
|
||||
|
||||
data FlowAction
|
||||
= SuspendOutput -- ^ TCOOFF
|
||||
@@ -455,17 +442,7 @@ data FlowAction
|
||||
-- flow of data on @Fd@ @fd@, as indicated by
|
||||
-- @action@.
|
||||
controlFlow :: Fd -> FlowAction -> IO ()
|
||||
-controlFlow (Fd fd) action =
|
||||
- throwErrnoIfMinus1_ "controlFlow" (c_tcflow fd (action2Int action))
|
||||
- where
|
||||
- action2Int :: FlowAction -> CInt
|
||||
- action2Int SuspendOutput = (#const TCOOFF)
|
||||
- action2Int RestartOutput = (#const TCOON)
|
||||
- action2Int TransmitStop = (#const TCIOFF)
|
||||
- action2Int TransmitStart = (#const TCION)
|
||||
-
|
||||
-foreign import ccall unsafe "tcflow"
|
||||
- c_tcflow :: CInt -> CInt -> IO CInt
|
||||
+controlFlow (Fd fd) action = error "controlFlow not implemented"
|
||||
|
||||
-- | @getTerminalProcessGroupID fd@ calls @tcgetpgrp@ to
|
||||
-- obtain the @ProcessGroupID@ of the foreground process group
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -0,0 +1,32 @@
|
|||
From 2d1f0027ae1ca56bbf4449887cf3bc61dc1c8e84 Mon Sep 17 00:00:00 2001
|
||||
From: foo <foo@bar>
|
||||
Date: Sat, 21 Sep 2013 22:32:01 +0000
|
||||
Subject: [PATCH] fix build with new ghc
|
||||
|
||||
---
|
||||
Data/HashMap/Base.hs | 4 ++--
|
||||
1 file changed, 2 insertions(+), 2 deletions(-)
|
||||
|
||||
diff --git a/Data/HashMap/Base.hs b/Data/HashMap/Base.hs
|
||||
index 6a77df4..93a384d 100644
|
||||
--- a/Data/HashMap/Base.hs
|
||||
+++ b/Data/HashMap/Base.hs
|
||||
@@ -86,7 +86,7 @@ import qualified Data.List as L
|
||||
import Data.Monoid (Monoid(mempty, mappend))
|
||||
import Data.Traversable (Traversable(..))
|
||||
import Data.Word (Word)
|
||||
-import GHC.Exts ((==#), build, reallyUnsafePtrEquality#)
|
||||
+import GHC.Exts ((==#), build, reallyUnsafePtrEquality#, tagToEnum#)
|
||||
import Prelude hiding (filter, foldr, lookup, map, null, pred)
|
||||
|
||||
import qualified Data.HashMap.Array as A
|
||||
@@ -1072,5 +1072,5 @@ fullNodeMask = complement (complement 0 `unsafeShiftL` maxChildren)
|
||||
-- | Check if two the two arguments are the same value. N.B. This
|
||||
-- function might give false negatives (due to GC moving objects.)
|
||||
ptrEq :: a -> a -> Bool
|
||||
-ptrEq x y = reallyUnsafePtrEquality# x y ==# 1#
|
||||
+ptrEq x y = tagToEnum# (reallyUnsafePtrEquality# x y ==# 1#)
|
||||
{-# INLINE ptrEq #-}
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,25 +0,0 @@
|
|||
From 3a4ee8091ba9da44f9f4a04522a5ff45fabe70d9 Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Thu, 28 Feb 2013 23:37:56 -0400
|
||||
Subject: [PATCH] disable optimisation that breaks when cross-compiling
|
||||
|
||||
This needs TH to work actually.
|
||||
---
|
||||
Data/Vector/Fusion/Stream/Monadic.hs | 1 -
|
||||
1 file changed, 1 deletion(-)
|
||||
|
||||
diff --git a/Data/Vector/Fusion/Stream/Monadic.hs b/Data/Vector/Fusion/Stream/Monadic.hs
|
||||
index 51fec75..b089b3d 100644
|
||||
--- a/Data/Vector/Fusion/Stream/Monadic.hs
|
||||
+++ b/Data/Vector/Fusion/Stream/Monadic.hs
|
||||
@@ -101,7 +101,6 @@ import GHC.Exts ( SpecConstrAnnotation(..) )
|
||||
|
||||
data SPEC = SPEC | SPEC2
|
||||
#if __GLASGOW_HASKELL__ >= 700
|
||||
-{-# ANN type SPEC ForceSpecConstr #-}
|
||||
#endif
|
||||
|
||||
emptyStream :: String
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -0,0 +1,130 @@
|
|||
From af259b521574b734a7a0b1b3e9e6868df33ebdb9 Mon Sep 17 00:00:00 2001
|
||||
From: foo <foo@bar>
|
||||
Date: Sat, 21 Sep 2013 23:47:47 +0000
|
||||
Subject: [PATCH] hack to build with new ghc
|
||||
|
||||
---
|
||||
Data/Vector.hs | 1 -
|
||||
Data/Vector/Fusion/Stream/Monadic.hs | 1 -
|
||||
Data/Vector/Generic.hs | 10 ++--------
|
||||
Data/Vector/Primitive.hs | 1 -
|
||||
Data/Vector/Storable.hs | 1 -
|
||||
Data/Vector/Unboxed/Base.hs | 15 +--------------
|
||||
6 files changed, 3 insertions(+), 26 deletions(-)
|
||||
|
||||
diff --git a/Data/Vector.hs b/Data/Vector.hs
|
||||
index 138b2db..92c4387 100644
|
||||
--- a/Data/Vector.hs
|
||||
+++ b/Data/Vector.hs
|
||||
@@ -215,7 +215,6 @@ instance Data a => Data (Vector a) where
|
||||
toConstr _ = error "toConstr"
|
||||
gunfold _ _ = error "gunfold"
|
||||
dataTypeOf _ = G.mkType "Data.Vector.Vector"
|
||||
- dataCast1 = G.dataCast
|
||||
|
||||
type instance G.Mutable Vector = MVector
|
||||
|
||||
diff --git a/Data/Vector/Fusion/Stream/Monadic.hs b/Data/Vector/Fusion/Stream/Monadic.hs
|
||||
index 51fec75..b089b3d 100644
|
||||
--- a/Data/Vector/Fusion/Stream/Monadic.hs
|
||||
+++ b/Data/Vector/Fusion/Stream/Monadic.hs
|
||||
@@ -101,7 +101,6 @@ import GHC.Exts ( SpecConstrAnnotation(..) )
|
||||
|
||||
data SPEC = SPEC | SPEC2
|
||||
#if __GLASGOW_HASKELL__ >= 700
|
||||
-{-# ANN type SPEC ForceSpecConstr #-}
|
||||
#endif
|
||||
|
||||
emptyStream :: String
|
||||
diff --git a/Data/Vector/Generic.hs b/Data/Vector/Generic.hs
|
||||
index 78f7260..f4ea80a 100644
|
||||
--- a/Data/Vector/Generic.hs
|
||||
+++ b/Data/Vector/Generic.hs
|
||||
@@ -157,7 +157,7 @@ module Data.Vector.Generic (
|
||||
showsPrec, readPrec,
|
||||
|
||||
-- ** @Data@ and @Typeable@
|
||||
- gfoldl, dataCast, mkType
|
||||
+ gfoldl, mkType
|
||||
) where
|
||||
|
||||
import Data.Vector.Generic.Base
|
||||
@@ -194,7 +194,7 @@ import Prelude hiding ( length, null,
|
||||
showsPrec )
|
||||
|
||||
import qualified Text.Read as Read
|
||||
-import Data.Typeable ( Typeable1, gcast1 )
|
||||
+import Data.Typeable ( gcast1 )
|
||||
|
||||
#include "vector.h"
|
||||
|
||||
@@ -2019,9 +2019,3 @@ gfoldl f z v = z fromList `f` toList v
|
||||
mkType :: String -> DataType
|
||||
{-# INLINE mkType #-}
|
||||
mkType = mkNoRepType
|
||||
-
|
||||
-dataCast :: (Vector v a, Data a, Typeable1 v, Typeable1 t)
|
||||
- => (forall d. Data d => c (t d)) -> Maybe (c (v a))
|
||||
-{-# INLINE dataCast #-}
|
||||
-dataCast f = gcast1 f
|
||||
-
|
||||
diff --git a/Data/Vector/Primitive.hs b/Data/Vector/Primitive.hs
|
||||
index 5f59bae..06e84c3 100644
|
||||
--- a/Data/Vector/Primitive.hs
|
||||
+++ b/Data/Vector/Primitive.hs
|
||||
@@ -188,7 +188,6 @@ instance (Data a, Prim a) => Data (Vector a) where
|
||||
toConstr _ = error "toConstr"
|
||||
gunfold _ _ = error "gunfold"
|
||||
dataTypeOf _ = G.mkType "Data.Vector.Primitive.Vector"
|
||||
- dataCast1 = G.dataCast
|
||||
|
||||
|
||||
type instance G.Mutable Vector = MVector
|
||||
diff --git a/Data/Vector/Storable.hs b/Data/Vector/Storable.hs
|
||||
index f9928e4..a17e3d6 100644
|
||||
--- a/Data/Vector/Storable.hs
|
||||
+++ b/Data/Vector/Storable.hs
|
||||
@@ -194,7 +194,6 @@ instance (Data a, Storable a) => Data (Vector a) where
|
||||
toConstr _ = error "toConstr"
|
||||
gunfold _ _ = error "gunfold"
|
||||
dataTypeOf _ = G.mkType "Data.Vector.Storable.Vector"
|
||||
- dataCast1 = G.dataCast
|
||||
|
||||
type instance G.Mutable Vector = MVector
|
||||
|
||||
diff --git a/Data/Vector/Unboxed/Base.hs b/Data/Vector/Unboxed/Base.hs
|
||||
index 00350cb..c13ea20 100644
|
||||
--- a/Data/Vector/Unboxed/Base.hs
|
||||
+++ b/Data/Vector/Unboxed/Base.hs
|
||||
@@ -31,7 +31,7 @@ import Data.Word ( Word, Word8, Word16, Word32, Word64 )
|
||||
import Data.Int ( Int8, Int16, Int32, Int64 )
|
||||
import Data.Complex
|
||||
|
||||
-import Data.Typeable ( Typeable1(..), Typeable2(..), mkTyConApp,
|
||||
+import Data.Typeable ( mkTyConApp,
|
||||
#if MIN_VERSION_base(4,4,0)
|
||||
mkTyCon3
|
||||
#else
|
||||
@@ -65,19 +65,6 @@ vectorTyCon = mkTyCon3 "vector"
|
||||
vectorTyCon m s = mkTyCon $ m ++ "." ++ s
|
||||
#endif
|
||||
|
||||
-instance Typeable1 Vector where
|
||||
- typeOf1 _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed" "Vector") []
|
||||
-
|
||||
-instance Typeable2 MVector where
|
||||
- typeOf2 _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed.Mutable" "MVector") []
|
||||
-
|
||||
-instance (Data a, Unbox a) => Data (Vector a) where
|
||||
- gfoldl = G.gfoldl
|
||||
- toConstr _ = error "toConstr"
|
||||
- gunfold _ _ = error "gunfold"
|
||||
- dataTypeOf _ = G.mkType "Data.Vector.Unboxed.Vector"
|
||||
- dataCast1 = G.dataCast
|
||||
-
|
||||
-- ----
|
||||
-- Unit
|
||||
-- ----
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,16 +1,19 @@
|
|||
From c18ae75852b1340ca502528138bf421659f61a3d Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Mon, 15 Apr 2013 12:44:15 -0400
|
||||
Subject: [PATCH] remove TH
|
||||
From 432a8fc47bb11cf8fd0a832e033cfb94a6332dbe Mon Sep 17 00:00:00 2001
|
||||
From: foo <foo@bar>
|
||||
Date: Sun, 22 Sep 2013 07:29:39 +0000
|
||||
Subject: [PATCH] deal with TH
|
||||
|
||||
Export modules referenced by it.
|
||||
|
||||
Should not need these icons in git-annex, so not worth using the Evil
|
||||
Splicer.
|
||||
---
|
||||
Network/Wai/Application/Static.hs | 4 ----
|
||||
1 file changed, 4 deletions(-)
|
||||
Network/Wai/Application/Static.hs | 4 ----
|
||||
wai-app-static.cabal | 2 +-
|
||||
2 files changed, 1 insertion(+), 5 deletions(-)
|
||||
|
||||
diff --git a/Network/Wai/Application/Static.hs b/Network/Wai/Application/Static.hs
|
||||
index 3195fbb..b48aa01 100644
|
||||
index 3f07391..75709b7 100644
|
||||
--- a/Network/Wai/Application/Static.hs
|
||||
+++ b/Network/Wai/Application/Static.hs
|
||||
@@ -33,8 +33,6 @@ import Control.Monad.IO.Class (liftIO)
|
||||
|
@ -31,6 +34,21 @@ index 3195fbb..b48aa01 100644
|
|||
staticAppPieces ss rawPieces req = liftIO $ do
|
||||
case toPieces rawPieces of
|
||||
Just pieces -> checkPieces ss pieces req >>= response
|
||||
diff --git a/wai-app-static.cabal b/wai-app-static.cabal
|
||||
index ec22813..e944caa 100644
|
||||
--- a/wai-app-static.cabal
|
||||
+++ b/wai-app-static.cabal
|
||||
@@ -56,9 +56,9 @@ library
|
||||
WaiAppStatic.Storage.Embedded
|
||||
WaiAppStatic.Listing
|
||||
WaiAppStatic.Types
|
||||
- other-modules: Util
|
||||
WaiAppStatic.Storage.Embedded.Runtime
|
||||
WaiAppStatic.Storage.Embedded.TH
|
||||
+ other-modules: Util
|
||||
ghc-options: -Wall
|
||||
extensions: CPP
|
||||
|
||||
--
|
||||
1.8.2.rc3
|
||||
1.7.10.4
|
||||
|
|
@ -1,26 +0,0 @@
|
|||
From dc6d0128e666dcab07ddee56a22a4177ebfc0c7b Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Thu, 28 Feb 2013 23:38:33 -0400
|
||||
Subject: [PATCH] disable CGI module
|
||||
|
||||
I don't need it and it failed to build.
|
||||
---
|
||||
wai-extra.cabal | 2 +-
|
||||
1 file changed, 1 insertion(+), 1 deletion(-)
|
||||
|
||||
diff --git a/wai-extra.cabal b/wai-extra.cabal
|
||||
index 9e9f0fc..007dd0f 100644
|
||||
--- a/wai-extra.cabal
|
||||
+++ b/wai-extra.cabal
|
||||
@@ -44,7 +44,7 @@ Library
|
||||
, void >= 0.5 && < 0.6
|
||||
, stringsearch >= 0.3 && < 0.4
|
||||
|
||||
- Exposed-modules: Network.Wai.Handler.CGI
|
||||
+ Exposed-modules:
|
||||
Network.Wai.Middleware.AcceptOverride
|
||||
Network.Wai.Middleware.Autohead
|
||||
Network.Wai.Middleware.CleanPath
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,108 +0,0 @@
|
|||
From 3e988dec5ea248611d07d59914e3eb131dc6a165 Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Thu, 18 Apr 2013 17:44:46 -0400
|
||||
Subject: [PATCH] remove TH code
|
||||
|
||||
---
|
||||
Text/Hamlet/XML.hs | 81 +-----------------------------------------------------
|
||||
1 file changed, 1 insertion(+), 80 deletions(-)
|
||||
|
||||
diff --git a/Text/Hamlet/XML.hs b/Text/Hamlet/XML.hs
|
||||
index f587410..bf8ce9e 100644
|
||||
--- a/Text/Hamlet/XML.hs
|
||||
+++ b/Text/Hamlet/XML.hs
|
||||
@@ -1,8 +1,7 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# OPTIONS_GHC -fno-warn-missing-fields #-}
|
||||
module Text.Hamlet.XML
|
||||
- ( xml
|
||||
- , xmlFile
|
||||
+ (
|
||||
) where
|
||||
|
||||
import Language.Haskell.TH.Syntax
|
||||
@@ -18,81 +17,3 @@ import Data.String (fromString)
|
||||
import qualified Data.Foldable as F
|
||||
import Data.Maybe (fromMaybe)
|
||||
import qualified Data.Map as Map
|
||||
-
|
||||
-xml :: QuasiQuoter
|
||||
-xml = QuasiQuoter { quoteExp = strToExp }
|
||||
-
|
||||
-xmlFile :: FilePath -> Q Exp
|
||||
-xmlFile = strToExp . TL.unpack <=< qRunIO . readUtf8File
|
||||
-
|
||||
-strToExp :: String -> Q Exp
|
||||
-strToExp s =
|
||||
- case parseDoc s of
|
||||
- Error e -> error e
|
||||
- Ok x -> docsToExp [] x
|
||||
-
|
||||
-docsToExp :: Scope -> [Doc] -> Q Exp
|
||||
-docsToExp scope docs = [| concat $(fmap ListE $ mapM (docToExp scope) docs) |]
|
||||
-
|
||||
-docToExp :: Scope -> Doc -> Q Exp
|
||||
-docToExp scope (DocTag name attrs cs) =
|
||||
- [| [ X.NodeElement (X.Element ($(liftName name)) $(mkAttrs scope attrs) $(docsToExp scope cs))
|
||||
- ] |]
|
||||
-docToExp _ (DocContent (ContentRaw s)) = [| [ X.NodeContent (pack $(lift s)) ] |]
|
||||
-docToExp scope (DocContent (ContentVar d)) = [| [ X.NodeContent $(return $ derefToExp scope d) ] |]
|
||||
-docToExp scope (DocContent (ContentEmbed d)) = return $ derefToExp scope d
|
||||
-docToExp scope (DocForall deref ident@(Ident ident') inside) = do
|
||||
- let list' = derefToExp scope deref
|
||||
- name <- newName ident'
|
||||
- let scope' = (ident, VarE name) : scope
|
||||
- inside' <- docsToExp scope' inside
|
||||
- let lam = LamE [VarP name] inside'
|
||||
- [| F.concatMap $(return lam) $(return list') |]
|
||||
-docToExp scope (DocWith [] inside) = docsToExp scope inside
|
||||
-docToExp scope (DocWith ((deref, ident@(Ident name)):dis) inside) = do
|
||||
- let deref' = derefToExp scope deref
|
||||
- name' <- newName name
|
||||
- let scope' = (ident, VarE name') : scope
|
||||
- inside' <- docToExp scope' (DocWith dis inside)
|
||||
- let lam = LamE [VarP name'] inside'
|
||||
- return $ lam `AppE` deref'
|
||||
-docToExp scope (DocMaybe deref ident@(Ident name) just nothing) = do
|
||||
- let deref' = derefToExp scope deref
|
||||
- name' <- newName name
|
||||
- let scope' = (ident, VarE name') : scope
|
||||
- inside' <- docsToExp scope' just
|
||||
- let inside'' = LamE [VarP name'] inside'
|
||||
- nothing' <-
|
||||
- case nothing of
|
||||
- Nothing -> [| [] |]
|
||||
- Just n -> docsToExp scope n
|
||||
- [| maybe $(return nothing') $(return inside'') $(return deref') |]
|
||||
-docToExp scope (DocCond conds final) = do
|
||||
- unit <- [| () |]
|
||||
- body <- fmap GuardedB $ mapM go $ conds ++ [(DerefIdent $ Ident "otherwise", fromMaybe [] final)]
|
||||
- return $ CaseE unit [Match (TupP []) body []]
|
||||
- where
|
||||
- go (deref, inside) = do
|
||||
- inside' <- docsToExp scope inside
|
||||
- return (NormalG $ derefToExp scope deref, inside')
|
||||
-
|
||||
-mkAttrs :: Scope -> [(Maybe Deref, String, [Content])] -> Q Exp
|
||||
-mkAttrs _ [] = [| Map.empty |]
|
||||
-mkAttrs scope ((mderef, name, value):rest) = do
|
||||
- rest' <- mkAttrs scope rest
|
||||
- this <- [| Map.insert $(liftName name) (T.concat $(fmap ListE $ mapM go value)) |]
|
||||
- let with = [| $(return this) $(return rest') |]
|
||||
- case mderef of
|
||||
- Nothing -> with
|
||||
- Just deref -> [| if $(return $ derefToExp scope deref) then $(with) else $(return rest') |]
|
||||
- where
|
||||
- go (ContentRaw s) = [| pack $(lift s) |]
|
||||
- go (ContentVar d) = return $ derefToExp scope d
|
||||
- go ContentEmbed{} = error "Cannot use embed interpolation in attribute value"
|
||||
-
|
||||
-liftName :: String -> Q Exp
|
||||
-liftName s = do
|
||||
- X.Name local mns _ <- return $ fromString s
|
||||
- case mns of
|
||||
- Nothing -> [| X.Name (pack $(lift $ unpack local)) Nothing Nothing |]
|
||||
- Just ns -> [| X.Name (pack $(lift $ unpack local)) (Just $ pack $(lift $ unpack ns)) Nothing |]
|
||||
--
|
||||
1.8.2.rc3
|
||||
|
|
@ -0,0 +1,34 @@
|
|||
From 3eb7b0a42099721dc19363ac41319efeed4ac5f9 Mon Sep 17 00:00:00 2001
|
||||
From: foo <foo@bar>
|
||||
Date: Sun, 22 Sep 2013 05:19:53 +0000
|
||||
Subject: [PATCH] don't really build
|
||||
|
||||
---
|
||||
yesod-auth.cabal | 11 +----------
|
||||
1 file changed, 1 insertion(+), 10 deletions(-)
|
||||
|
||||
diff --git a/yesod-auth.cabal b/yesod-auth.cabal
|
||||
index 591ced5..11217be 100644
|
||||
--- a/yesod-auth.cabal
|
||||
+++ b/yesod-auth.cabal
|
||||
@@ -52,16 +52,7 @@ library
|
||||
, safe
|
||||
, time
|
||||
|
||||
- exposed-modules: Yesod.Auth
|
||||
- Yesod.Auth.BrowserId
|
||||
- Yesod.Auth.Dummy
|
||||
- Yesod.Auth.Email
|
||||
- Yesod.Auth.OpenId
|
||||
- Yesod.Auth.Rpxnow
|
||||
- Yesod.Auth.HashDB
|
||||
- Yesod.Auth.Message
|
||||
- Yesod.Auth.GoogleEmail
|
||||
- other-modules: Yesod.Auth.Routes
|
||||
+ exposed-modules:
|
||||
ghc-options: -Wall
|
||||
|
||||
source-repository head
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,476 +0,0 @@
|
|||
From 801f6dea3be43113400e41aabb443456fffcd227 Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Thu, 28 Feb 2013 23:39:40 -0400
|
||||
Subject: [PATCH 1/2] remove TH
|
||||
|
||||
---
|
||||
Yesod/Core.hs | 10 ----
|
||||
Yesod/Dispatch.hs | 119 +----------------------------------------------
|
||||
Yesod/Handler.hs | 27 +----------
|
||||
Yesod/Internal/Cache.hs | 5 --
|
||||
Yesod/Internal/Core.hs | 119 +++++------------------------------------------
|
||||
Yesod/Widget.hs | 29 ------------
|
||||
6 files changed, 13 insertions(+), 296 deletions(-)
|
||||
|
||||
diff --git a/Yesod/Core.hs b/Yesod/Core.hs
|
||||
index 7268d6c..ce04b7d 100644
|
||||
--- a/Yesod/Core.hs
|
||||
+++ b/Yesod/Core.hs
|
||||
@@ -21,16 +21,6 @@ module Yesod.Core
|
||||
, unauthorizedI
|
||||
-- * Logging
|
||||
, LogLevel (..)
|
||||
- , logDebug
|
||||
- , logInfo
|
||||
- , logWarn
|
||||
- , logError
|
||||
- , logOther
|
||||
- , logDebugS
|
||||
- , logInfoS
|
||||
- , logWarnS
|
||||
- , logErrorS
|
||||
- , logOtherS
|
||||
-- * Sessions
|
||||
, SessionBackend (..)
|
||||
, defaultClientSessionBackend
|
||||
diff --git a/Yesod/Dispatch.hs b/Yesod/Dispatch.hs
|
||||
index 1e19388..dd37475 100644
|
||||
--- a/Yesod/Dispatch.hs
|
||||
+++ b/Yesod/Dispatch.hs
|
||||
@@ -6,20 +6,9 @@
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
module Yesod.Dispatch
|
||||
( -- * Quasi-quoted routing
|
||||
- parseRoutes
|
||||
- , parseRoutesNoCheck
|
||||
- , parseRoutesFile
|
||||
- , parseRoutesFileNoCheck
|
||||
- , mkYesod
|
||||
- , mkYesodSub
|
||||
-- ** More fine-grained
|
||||
- , mkYesodData
|
||||
- , mkYesodSubData
|
||||
- , mkYesodDispatch
|
||||
- , mkYesodSubDispatch
|
||||
- , mkDispatchInstance
|
||||
-- ** Path pieces
|
||||
- , PathPiece (..)
|
||||
+ PathPiece (..)
|
||||
, PathMultiPiece (..)
|
||||
, Texts
|
||||
-- * Convert to WAI
|
||||
@@ -52,117 +41,11 @@ import Data.Monoid (mappend)
|
||||
import qualified Data.ByteString as S
|
||||
import qualified Blaze.ByteString.Builder
|
||||
import Network.HTTP.Types (status301)
|
||||
-import Yesod.Routes.TH
|
||||
import Yesod.Content (chooseRep)
|
||||
-import Yesod.Routes.Parse
|
||||
import System.Log.FastLogger (Logger)
|
||||
|
||||
type Texts = [Text]
|
||||
|
||||
--- | Generates URL datatype and site function for the given 'Resource's. This
|
||||
--- is used for creating sites, /not/ subsites. See 'mkYesodSub' for the latter.
|
||||
--- Use 'parseRoutes' to create the 'Resource's.
|
||||
-mkYesod :: String -- ^ name of the argument datatype
|
||||
- -> [ResourceTree String]
|
||||
- -> Q [Dec]
|
||||
-mkYesod name = fmap (uncurry (++)) . mkYesodGeneral name [] [] False
|
||||
-
|
||||
--- | Generates URL datatype and site function for the given 'Resource's. This
|
||||
--- is used for creating subsites, /not/ sites. See 'mkYesod' for the latter.
|
||||
--- Use 'parseRoutes' to create the 'Resource's. In general, a subsite is not
|
||||
--- executable by itself, but instead provides functionality to
|
||||
--- be embedded in other sites.
|
||||
-mkYesodSub :: String -- ^ name of the argument datatype
|
||||
- -> Cxt
|
||||
- -> [ResourceTree String]
|
||||
- -> Q [Dec]
|
||||
-mkYesodSub name clazzes =
|
||||
- fmap (uncurry (++)) . mkYesodGeneral name' rest clazzes True
|
||||
- where
|
||||
- (name':rest) = words name
|
||||
-
|
||||
--- | Sometimes, you will want to declare your routes in one file and define
|
||||
--- your handlers elsewhere. For example, this is the only way to break up a
|
||||
--- monolithic file into smaller parts. Use this function, paired with
|
||||
--- 'mkYesodDispatch', to do just that.
|
||||
-mkYesodData :: String -> [ResourceTree String] -> Q [Dec]
|
||||
-mkYesodData name res = mkYesodDataGeneral name [] False res
|
||||
-
|
||||
-mkYesodSubData :: String -> Cxt -> [ResourceTree String] -> Q [Dec]
|
||||
-mkYesodSubData name clazzes res = mkYesodDataGeneral name clazzes True res
|
||||
-
|
||||
-mkYesodDataGeneral :: String -> Cxt -> Bool -> [ResourceTree String] -> Q [Dec]
|
||||
-mkYesodDataGeneral name clazzes isSub res = do
|
||||
- let (name':rest) = words name
|
||||
- (x, _) <- mkYesodGeneral name' rest clazzes isSub res
|
||||
- let rname = mkName $ "resources" ++ name
|
||||
- eres <- lift res
|
||||
- let y = [ SigD rname $ ListT `AppT` (ConT ''ResourceTree `AppT` ConT ''String)
|
||||
- , FunD rname [Clause [] (NormalB eres) []]
|
||||
- ]
|
||||
- return $ x ++ y
|
||||
-
|
||||
--- | See 'mkYesodData'.
|
||||
-mkYesodDispatch :: String -> [ResourceTree String] -> Q [Dec]
|
||||
-mkYesodDispatch name = fmap snd . mkYesodGeneral name [] [] False
|
||||
-
|
||||
-mkYesodSubDispatch :: String -> Cxt -> [ResourceTree String] -> Q [Dec]
|
||||
-mkYesodSubDispatch name clazzes = fmap snd . mkYesodGeneral name' rest clazzes True
|
||||
- where (name':rest) = words name
|
||||
-
|
||||
-mkYesodGeneral :: String -- ^ foundation type
|
||||
- -> [String] -- ^ arguments for the type
|
||||
- -> Cxt -- ^ the type constraints
|
||||
- -> Bool -- ^ it this a subsite
|
||||
- -> [ResourceTree String]
|
||||
- -> Q([Dec],[Dec])
|
||||
-mkYesodGeneral name args clazzes isSub resS = do
|
||||
- subsite <- sub
|
||||
- masterTypeSyns <- if isSub then return []
|
||||
- else sequence [handler, widget]
|
||||
- renderRouteDec <- mkRenderRouteInstance subsite res
|
||||
- dispatchDec <- mkDispatchInstance context sub master res
|
||||
- return (renderRouteDec ++ masterTypeSyns, dispatchDec)
|
||||
- where sub = foldl appT subCons subArgs
|
||||
- master = if isSub then (varT $ mkName "master") else sub
|
||||
- context = if isSub then cxt $ yesod : map return clazzes
|
||||
- else return []
|
||||
- yesod = classP ''Yesod [master]
|
||||
- handler = tySynD (mkName "Handler") [] [t| GHandler $master $master |]
|
||||
- widget = tySynD (mkName "Widget") [] [t| GWidget $master $master () |]
|
||||
- res = map (fmap parseType) resS
|
||||
- subCons = conT $ mkName name
|
||||
- subArgs = map (varT. mkName) args
|
||||
-
|
||||
--- | If the generation of @'YesodDispatch'@ instance require finer
|
||||
--- control of the types, contexts etc. using this combinator. You will
|
||||
--- hardly need this generality. However, in certain situations, like
|
||||
--- when writing library/plugin for yesod, this combinator becomes
|
||||
--- handy.
|
||||
-mkDispatchInstance :: CxtQ -- ^ The context
|
||||
- -> TypeQ -- ^ The subsite type
|
||||
- -> TypeQ -- ^ The master site type
|
||||
- -> [ResourceTree a] -- ^ The resource
|
||||
- -> DecsQ
|
||||
-mkDispatchInstance context sub master res = do
|
||||
- logger <- newName "logger"
|
||||
- let loggerE = varE logger
|
||||
- loggerP = VarP logger
|
||||
- yDispatch = conT ''YesodDispatch `appT` sub `appT` master
|
||||
- thisDispatch = do
|
||||
- Clause pat body decs <- mkDispatchClause
|
||||
- [|yesodRunner $loggerE |]
|
||||
- [|yesodDispatch $loggerE |]
|
||||
- [|fmap chooseRep|]
|
||||
- res
|
||||
- return $ FunD 'yesodDispatch
|
||||
- [ Clause (loggerP:pat)
|
||||
- body
|
||||
- decs
|
||||
- ]
|
||||
- in sequence [instanceD context yDispatch [thisDispatch]]
|
||||
-
|
||||
-
|
||||
-- | Convert the given argument into a WAI application, executable with any WAI
|
||||
-- handler. This is the same as 'toWaiAppPlain', except it includes two
|
||||
-- middlewares: GZIP compression and autohead. This is the
|
||||
diff --git a/Yesod/Handler.hs b/Yesod/Handler.hs
|
||||
index 1997bdb..98c915c 100644
|
||||
--- a/Yesod/Handler.hs
|
||||
+++ b/Yesod/Handler.hs
|
||||
@@ -42,7 +42,6 @@ module Yesod.Handler
|
||||
, RedirectUrl (..)
|
||||
, redirect
|
||||
, redirectWith
|
||||
- , redirectToPost
|
||||
-- ** Errors
|
||||
, notFound
|
||||
, badMethod
|
||||
@@ -100,7 +99,6 @@ module Yesod.Handler
|
||||
, getMessageRender
|
||||
-- * Per-request caching
|
||||
, CacheKey
|
||||
- , mkCacheKey
|
||||
, cacheLookup
|
||||
, cacheInsert
|
||||
, cacheDelete
|
||||
@@ -172,7 +170,7 @@ import System.Log.FastLogger
|
||||
import Control.Monad.Logger
|
||||
|
||||
import qualified Yesod.Internal.Cache as Cache
|
||||
-import Yesod.Internal.Cache (mkCacheKey, CacheKey)
|
||||
+import Yesod.Internal.Cache (CacheKey)
|
||||
import qualified Data.IORef as I
|
||||
import Control.Exception.Lifted (catch)
|
||||
import Control.Monad.Trans.Control
|
||||
@@ -937,29 +935,6 @@ newIdent = do
|
||||
put x { ghsIdent = i' }
|
||||
return $ T.pack $ 'h' : show i'
|
||||
|
||||
--- | Redirect to a POST resource.
|
||||
---
|
||||
--- This is not technically a redirect; instead, it returns an HTML page with a
|
||||
--- POST form, and some Javascript to automatically submit the form. This can be
|
||||
--- useful when you need to post a plain link somewhere that needs to cause
|
||||
--- changes on the server.
|
||||
-redirectToPost :: RedirectUrl master url => url -> GHandler sub master a
|
||||
-redirectToPost url = do
|
||||
- urlText <- toTextUrl url
|
||||
- hamletToRepHtml [hamlet|
|
||||
-$newline never
|
||||
-$doctype 5
|
||||
-
|
||||
-<html>
|
||||
- <head>
|
||||
- <title>Redirecting...
|
||||
- <body onload="document.getElementById('form').submit()">
|
||||
- <form id="form" method="post" action=#{urlText}>
|
||||
- <noscript>
|
||||
- <p>Javascript has been disabled; please click on the button below to be redirected.
|
||||
- <input type="submit" value="Continue">
|
||||
-|] >>= sendResponse
|
||||
-
|
||||
-- | Converts the given Hamlet template into 'Content', which can be used in a
|
||||
-- Yesod 'Response'.
|
||||
hamletToContent :: HtmlUrl (Route master) -> GHandler sub master Content
|
||||
diff --git a/Yesod/Internal/Cache.hs b/Yesod/Internal/Cache.hs
|
||||
index 4aec0d2..fdef9d7 100644
|
||||
--- a/Yesod/Internal/Cache.hs
|
||||
+++ b/Yesod/Internal/Cache.hs
|
||||
@@ -3,7 +3,6 @@
|
||||
module Yesod.Internal.Cache
|
||||
( Cache
|
||||
, CacheKey
|
||||
- , mkCacheKey
|
||||
, lookup
|
||||
, insert
|
||||
, delete
|
||||
@@ -24,10 +23,6 @@ newtype Cache = Cache (Map.IntMap Any)
|
||||
|
||||
newtype CacheKey a = CacheKey Int
|
||||
|
||||
--- | Generate a new 'CacheKey'. Be sure to give a full type signature.
|
||||
-mkCacheKey :: Q Exp
|
||||
-mkCacheKey = [|CacheKey|] `appE` (LitE . IntegerL . fromIntegral . hashUnique <$> runIO newUnique)
|
||||
-
|
||||
lookup :: CacheKey a -> Cache -> Maybe a
|
||||
lookup (CacheKey i) (Cache m) = unsafeCoerce <$> Map.lookup i m
|
||||
|
||||
diff --git a/Yesod/Internal/Core.hs b/Yesod/Internal/Core.hs
|
||||
index c4a9796..90c05fc 100644
|
||||
--- a/Yesod/Internal/Core.hs
|
||||
+++ b/Yesod/Internal/Core.hs
|
||||
@@ -44,7 +44,6 @@ module Yesod.Internal.Core
|
||||
|
||||
import Yesod.Content
|
||||
import Yesod.Handler hiding (lift, getExpires)
|
||||
-import Control.Monad.Logger (logErrorS)
|
||||
|
||||
import Yesod.Routes.Class
|
||||
import Data.Time (UTCTime, addUTCTime, getCurrentTime)
|
||||
@@ -165,22 +164,7 @@ class RenderRoute a => Yesod a where
|
||||
|
||||
-- | Applies some form of layout to the contents of a page.
|
||||
defaultLayout :: GWidget sub a () -> GHandler sub a RepHtml
|
||||
- defaultLayout w = do
|
||||
- p <- widgetToPageContent w
|
||||
- mmsg <- getMessage
|
||||
- hamletToRepHtml [hamlet|
|
||||
-$newline never
|
||||
-$doctype 5
|
||||
-
|
||||
-<html>
|
||||
- <head>
|
||||
- <title>#{pageTitle p}
|
||||
- ^{pageHead p}
|
||||
- <body>
|
||||
- $maybe msg <- mmsg
|
||||
- <p .message>#{msg}
|
||||
- ^{pageBody p}
|
||||
-|]
|
||||
+ defaultLayout w = error "defaultLayout not implemented"
|
||||
|
||||
-- | Override the rendering function for a particular URL. One use case for
|
||||
-- this is to offload static hosting to a different domain name to avoid
|
||||
@@ -521,46 +505,11 @@ applyLayout' title body = fmap chooseRep $ defaultLayout $ do
|
||||
|
||||
-- | The default error handler for 'errorHandler'.
|
||||
defaultErrorHandler :: Yesod y => ErrorResponse -> GHandler sub y ChooseRep
|
||||
-defaultErrorHandler NotFound = do
|
||||
- r <- waiRequest
|
||||
- let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r
|
||||
- applyLayout' "Not Found"
|
||||
- [hamlet|
|
||||
-$newline never
|
||||
-<h1>Not Found
|
||||
-<p>#{path'}
|
||||
-|]
|
||||
-defaultErrorHandler (PermissionDenied msg) =
|
||||
- applyLayout' "Permission Denied"
|
||||
- [hamlet|
|
||||
-$newline never
|
||||
-<h1>Permission denied
|
||||
-<p>#{msg}
|
||||
-|]
|
||||
-defaultErrorHandler (InvalidArgs ia) =
|
||||
- applyLayout' "Invalid Arguments"
|
||||
- [hamlet|
|
||||
-$newline never
|
||||
-<h1>Invalid Arguments
|
||||
-<ul>
|
||||
- $forall msg <- ia
|
||||
- <li>#{msg}
|
||||
-|]
|
||||
-defaultErrorHandler (InternalError e) = do
|
||||
- $logErrorS "yesod-core" e
|
||||
- applyLayout' "Internal Server Error"
|
||||
- [hamlet|
|
||||
-$newline never
|
||||
-<h1>Internal Server Error
|
||||
-<pre>#{e}
|
||||
-|]
|
||||
-defaultErrorHandler (BadMethod m) =
|
||||
- applyLayout' "Bad Method"
|
||||
- [hamlet|
|
||||
-$newline never
|
||||
-<h1>Method Not Supported
|
||||
-<p>Method <code>#{S8.unpack m}</code> not supported
|
||||
-|]
|
||||
+defaultErrorHandler NotFound = error "Not Found"
|
||||
+defaultErrorHandler (PermissionDenied msg) = error "Permission Denied"
|
||||
+defaultErrorHandler (InvalidArgs ia) = error "Invalid Arguments"
|
||||
+defaultErrorHandler (InternalError e) = error "Internal Server Error"
|
||||
+defaultErrorHandler (BadMethod m) = error "Bad Method"
|
||||
|
||||
-- | Return the same URL if the user is authorized to see it.
|
||||
--
|
||||
@@ -616,45 +565,10 @@ widgetToPageContent w = do
|
||||
-- modernizr should be at the end of the <head> http://www.modernizr.com/docs/#installing
|
||||
-- the asynchronous loader means your page doesn't have to wait for all the js to load
|
||||
let (mcomplete, asyncScripts) = asyncHelper render scripts jscript jsLoc
|
||||
- regularScriptLoad = [hamlet|
|
||||
-$newline never
|
||||
-$forall s <- scripts
|
||||
- ^{mkScriptTag s}
|
||||
-$maybe j <- jscript
|
||||
- $maybe s <- jsLoc
|
||||
- <script src="#{s}">
|
||||
- $nothing
|
||||
- <script>^{jelper j}
|
||||
-|]
|
||||
-
|
||||
- headAll = [hamlet|
|
||||
-$newline never
|
||||
-\^{head'}
|
||||
-$forall s <- stylesheets
|
||||
- ^{mkLinkTag s}
|
||||
-$forall s <- css
|
||||
- $maybe t <- right $ snd s
|
||||
- $maybe media <- fst s
|
||||
- <link rel=stylesheet media=#{media} href=#{t}>
|
||||
- $nothing
|
||||
- <link rel=stylesheet href=#{t}>
|
||||
- $maybe content <- left $ snd s
|
||||
- $maybe media <- fst s
|
||||
- <style media=#{media}>#{content}
|
||||
- $nothing
|
||||
- <style>#{content}
|
||||
-$case jsLoader master
|
||||
- $of BottomOfBody
|
||||
- $of BottomOfHeadAsync asyncJsLoader
|
||||
- ^{asyncJsLoader asyncScripts mcomplete}
|
||||
- $of BottomOfHeadBlocking
|
||||
- ^{regularScriptLoad}
|
||||
-|]
|
||||
- let bodyScript = [hamlet|
|
||||
-$newline never
|
||||
-^{body}
|
||||
-^{regularScriptLoad}
|
||||
-|]
|
||||
+ regularScriptLoad = error "TODO"
|
||||
+
|
||||
+ headAll = error "TODO"
|
||||
+ let bodyScript = error "TODO"
|
||||
|
||||
return $ PageContent title headAll (case jsLoader master of
|
||||
BottomOfBody -> bodyScript
|
||||
@@ -696,18 +610,7 @@ jsonArray = unsafeLazyByteString . encode . Array . Vector.fromList . map String
|
||||
|
||||
-- | For use with setting 'jsLoader' to 'BottomOfHeadAsync'
|
||||
loadJsYepnope :: Yesod master => Either Text (Route master) -> [Text] -> Maybe (HtmlUrl (Route master)) -> (HtmlUrl (Route master))
|
||||
-loadJsYepnope eyn scripts mcomplete =
|
||||
- [hamlet|
|
||||
-$newline never
|
||||
- $maybe yn <- left eyn
|
||||
- <script src=#{yn}>
|
||||
- $maybe yn <- right eyn
|
||||
- <script src=@{yn}>
|
||||
- $maybe complete <- mcomplete
|
||||
- <script>yepnope({load:#{jsonArray scripts},complete:function(){^{complete}}});
|
||||
- $nothing
|
||||
- <script>yepnope({load:#{jsonArray scripts}});
|
||||
-|]
|
||||
+loadJsYepnope eyn scripts mcomplete = error "TODO"
|
||||
|
||||
asyncHelper :: (url -> [x] -> Text)
|
||||
-> [Script (url)]
|
||||
diff --git a/Yesod/Widget.hs b/Yesod/Widget.hs
|
||||
index bd94bd3..bf79150 100644
|
||||
--- a/Yesod/Widget.hs
|
||||
+++ b/Yesod/Widget.hs
|
||||
@@ -15,8 +15,6 @@ module Yesod.Widget
|
||||
GWidget
|
||||
, PageContent (..)
|
||||
-- * Special Hamlet quasiquoter/TH for Widgets
|
||||
- , whamlet
|
||||
- , whamletFile
|
||||
, ihamletToRepHtml
|
||||
-- * Convert to Widget
|
||||
, ToWidget (..)
|
||||
@@ -54,7 +52,6 @@ module Yesod.Widget
|
||||
, addScriptEither
|
||||
-- * Internal
|
||||
, unGWidget
|
||||
- , whamletFileWithSettings
|
||||
) where
|
||||
|
||||
import Data.Monoid
|
||||
@@ -274,32 +271,6 @@ data PageContent url = PageContent
|
||||
, pageBody :: HtmlUrl url
|
||||
}
|
||||
|
||||
-whamlet :: QuasiQuoter
|
||||
-whamlet = NP.hamletWithSettings rules NP.defaultHamletSettings
|
||||
-
|
||||
-whamletFile :: FilePath -> Q Exp
|
||||
-whamletFile = NP.hamletFileWithSettings rules NP.defaultHamletSettings
|
||||
-
|
||||
-whamletFileWithSettings :: NP.HamletSettings -> FilePath -> Q Exp
|
||||
-whamletFileWithSettings = NP.hamletFileWithSettings rules
|
||||
-
|
||||
-rules :: Q NP.HamletRules
|
||||
-rules = do
|
||||
- ah <- [|toWidget|]
|
||||
- let helper qg f = do
|
||||
- x <- newName "urender"
|
||||
- e <- f $ VarE x
|
||||
- let e' = LamE [VarP x] e
|
||||
- g <- qg
|
||||
- bind <- [|(>>=)|]
|
||||
- return $ InfixE (Just g) bind (Just e')
|
||||
- let ur f = do
|
||||
- let env = NP.Env
|
||||
- (Just $ helper [|liftW getUrlRenderParams|])
|
||||
- (Just $ helper [|liftM (toHtml .) $ liftW getMessageRender|])
|
||||
- f env
|
||||
- return $ NP.HamletRules ah ur $ \_ b -> return $ ah `AppE` b
|
||||
-
|
||||
-- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.
|
||||
ihamletToRepHtml :: RenderMessage master message
|
||||
=> HtmlUrlI18n message (Route master)
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,267 +0,0 @@
|
|||
From 9ae3db0b3292b53715232fecec3c5e2bf03b89cd Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Fri, 1 Mar 2013 01:02:53 -0400
|
||||
Subject: [PATCH 2/2] replaced TH in Yesod.Internal.Core
|
||||
|
||||
Done by running a build with -ddump-splices and manually pasting in the
|
||||
spliced code, and then modifying it until it compiles.
|
||||
|
||||
(This predated the Evil Splicer, and both this and the previous patch need
|
||||
to be redone to use it.)
|
||||
---
|
||||
Yesod/Internal/Core.hs | 211 +++++++++++++++++++++++++++++++++++++++++++++---
|
||||
1 file changed, 201 insertions(+), 10 deletions(-)
|
||||
|
||||
diff --git a/Yesod/Internal/Core.hs b/Yesod/Internal/Core.hs
|
||||
index 90c05fc..b9a0ae8 100644
|
||||
--- a/Yesod/Internal/Core.hs
|
||||
+++ b/Yesod/Internal/Core.hs
|
||||
@@ -96,6 +96,9 @@ import System.Log.FastLogger (Logger, mkLogger, loggerDate, LogStr (..), loggerP
|
||||
import Control.Monad.Logger (LogLevel (LevelInfo, LevelOther), LogSource)
|
||||
import System.Log.FastLogger.Date (ZonedDate)
|
||||
import System.IO (stdout)
|
||||
+import qualified Data.Foldable
|
||||
+import qualified Text.Blaze.Internal
|
||||
+import qualified Text.Hamlet
|
||||
|
||||
yesodVersion :: String
|
||||
yesodVersion = showVersion Paths_yesod_core.version
|
||||
@@ -164,7 +167,28 @@ class RenderRoute a => Yesod a where
|
||||
|
||||
-- | Applies some form of layout to the contents of a page.
|
||||
defaultLayout :: GWidget sub a () -> GHandler sub a RepHtml
|
||||
- defaultLayout w = error "defaultLayout not implemented"
|
||||
+ defaultLayout w = do
|
||||
+ p <- widgetToPageContent w
|
||||
+ mmsg <- getMessage
|
||||
+ hamletToRepHtml $ \ _render_ay88 -> do { id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "<!DOCTYPE html>\n<html><head><title>");
|
||||
+ id (TBH.toHtml (pageTitle p));
|
||||
+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</title>");
|
||||
+ id (pageHead p) _render_ay88;
|
||||
+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</head><body>");
|
||||
+ Text.Hamlet.maybeH
|
||||
+ mmsg
|
||||
+ (\ msg_ay89
|
||||
+ -> do { id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "<p class=\"message\">");
|
||||
+ id (TBH.toHtml msg_ay89);
|
||||
+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</p>") })
|
||||
+ Nothing;
|
||||
+ id (pageBody p) _render_ay88;
|
||||
+ id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "</body></html>") }
|
||||
|
||||
-- | Override the rendering function for a particular URL. One use case for
|
||||
-- this is to offload static hosting to a different domain name to avoid
|
||||
@@ -505,11 +529,45 @@ applyLayout' title body = fmap chooseRep $ defaultLayout $ do
|
||||
|
||||
-- | The default error handler for 'errorHandler'.
|
||||
defaultErrorHandler :: Yesod y => ErrorResponse -> GHandler sub y ChooseRep
|
||||
-defaultErrorHandler NotFound = error "Not Found"
|
||||
-defaultErrorHandler (PermissionDenied msg) = error "Permission Denied"
|
||||
-defaultErrorHandler (InvalidArgs ia) = error "Invalid Arguments"
|
||||
-defaultErrorHandler (InternalError e) = error "Internal Server Error"
|
||||
-defaultErrorHandler (BadMethod m) = error "Bad Method"
|
||||
+defaultErrorHandler NotFound = do
|
||||
+ r <- waiRequest
|
||||
+ let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r
|
||||
+ applyLayout' "Not Found" $ \ _render_ayac -> do { id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "<h1>Not Found</h1><p>");
|
||||
+ id (TBH.toHtml path');
|
||||
+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</p>") }
|
||||
+defaultErrorHandler (PermissionDenied msg) =
|
||||
+ applyLayout' "Permission Denied" $ \ _render_ayah -> do { id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "<h1>Permission denied</h1><p>");
|
||||
+ id (TBH.toHtml msg);
|
||||
+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</p>") }
|
||||
+defaultErrorHandler (InvalidArgs ia) =
|
||||
+ applyLayout' "Invalid Arguments" $ \ _render_ayam -> do { id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "<h1>Invalid Arguments</h1><ul>");
|
||||
+ Data.Foldable.mapM_
|
||||
+ (\ msg_ayan
|
||||
+ -> do { id ((Text.Blaze.Internal.preEscapedText . T.pack) "<li>");
|
||||
+ id (TBH.toHtml msg_ayan);
|
||||
+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</li>") })
|
||||
+ ia;
|
||||
+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</ul>") }
|
||||
+defaultErrorHandler (InternalError e) = do
|
||||
+ applyLayout' "Internal Server Error" $ \ _render_ayau -> do { id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "<h1>Internal Server Error</h1><pre>");
|
||||
+ id (TBH.toHtml e);
|
||||
+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</pre>") }
|
||||
+defaultErrorHandler (BadMethod m) =
|
||||
+ applyLayout' "Bad Method" $ \ _render_ayaz -> do { id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "<h1>Method Not Supported</h1><p>Method <code>");
|
||||
+ id (TBH.toHtml (S8.unpack m));
|
||||
+ id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "</code> not supported</p>") }
|
||||
|
||||
-- | Return the same URL if the user is authorized to see it.
|
||||
--
|
||||
@@ -565,10 +623,99 @@ widgetToPageContent w = do
|
||||
-- modernizr should be at the end of the <head> http://www.modernizr.com/docs/#installing
|
||||
-- the asynchronous loader means your page doesn't have to wait for all the js to load
|
||||
let (mcomplete, asyncScripts) = asyncHelper render scripts jscript jsLoc
|
||||
- regularScriptLoad = error "TODO"
|
||||
-
|
||||
- headAll = error "TODO"
|
||||
- let bodyScript = error "TODO"
|
||||
+ regularScriptLoad = \ _render_aybs -> do { Data.Foldable.mapM_
|
||||
+ (\ s_aybt
|
||||
+ -> id (mkScriptTag s_aybt) _render_aybs)
|
||||
+ scripts;
|
||||
+ Text.Hamlet.maybeH
|
||||
+ jscript
|
||||
+ (\ j_aybu
|
||||
+ -> Text.Hamlet.maybeH
|
||||
+ jsLoc
|
||||
+ (\ s_aybv
|
||||
+ -> do { id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "<script src=\"");
|
||||
+ id (TBH.toHtml s_aybv);
|
||||
+ id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "\"></script>") })
|
||||
+ (Just
|
||||
+ (do { id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "<script>");
|
||||
+ id (jelper j_aybu) _render_aybs;
|
||||
+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</script>") })))
|
||||
+ Nothing }
|
||||
+
|
||||
+ headAll = \ _render_aybz -> do
|
||||
+ { id head' _render_aybz;
|
||||
+ Data.Foldable.mapM_
|
||||
+ (\ s_aybA -> id (mkLinkTag s_aybA) _render_aybz)
|
||||
+ stylesheets;
|
||||
+ Data.Foldable.mapM_
|
||||
+ (\ s_aybB
|
||||
+ -> do { Text.Hamlet.maybeH
|
||||
+ (right (snd s_aybB))
|
||||
+ (\ t_aybC
|
||||
+ -> Text.Hamlet.maybeH
|
||||
+ (fst s_aybB)
|
||||
+ (\ media_aybD
|
||||
+ -> do { id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "<link rel=\"stylesheet\" media=\"");
|
||||
+ id (TBH.toHtml media_aybD);
|
||||
+ id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "\" href=\"");
|
||||
+ id (TBH.toHtml t_aybC);
|
||||
+ id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "\">") })
|
||||
+ (Just
|
||||
+ (do { id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "<link rel=\"stylesheet\" href=\"");
|
||||
+ id (TBH.toHtml t_aybC);
|
||||
+ id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "\">") })))
|
||||
+ Nothing;
|
||||
+ Text.Hamlet.maybeH
|
||||
+ (left (snd s_aybB))
|
||||
+ (\ content_aybE
|
||||
+ -> Text.Hamlet.maybeH
|
||||
+ (fst s_aybB)
|
||||
+ (\ media_aybF
|
||||
+ -> do { id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "<style media=\"");
|
||||
+ id (TBH.toHtml media_aybF);
|
||||
+ id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "\">");
|
||||
+ id (TBH.toHtml content_aybE);
|
||||
+ id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "</style>") })
|
||||
+ (Just
|
||||
+ (do { id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "<style>");
|
||||
+ id (TBH.toHtml content_aybE);
|
||||
+ id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "</style>") })))
|
||||
+ Nothing })
|
||||
+ css;
|
||||
+ case jsLoader master of
|
||||
+ BottomOfBody -> return ()
|
||||
+ BottomOfHeadAsync asyncJsLoader -> id (asyncJsLoader asyncScripts mcomplete) _render_aybz
|
||||
+ BottomOfHeadBlocking -> id regularScriptLoad _render_aybz
|
||||
+ }
|
||||
+
|
||||
+ let bodyScript = \ _render_aybL -> do {
|
||||
+ id body _render_aybL;
|
||||
+ id regularScriptLoad _render_aybL }
|
||||
|
||||
return $ PageContent title headAll (case jsLoader master of
|
||||
BottomOfBody -> bodyScript
|
||||
@@ -611,6 +758,50 @@ jsonArray = unsafeLazyByteString . encode . Array . Vector.fromList . map String
|
||||
-- | For use with setting 'jsLoader' to 'BottomOfHeadAsync'
|
||||
loadJsYepnope :: Yesod master => Either Text (Route master) -> [Text] -> Maybe (HtmlUrl (Route master)) -> (HtmlUrl (Route master))
|
||||
loadJsYepnope eyn scripts mcomplete = error "TODO"
|
||||
+{-
|
||||
+ \ _render_aybU
|
||||
+ -> do { Text.Hamlet.maybeH
|
||||
+ (left eyn)
|
||||
+ (\ yn_aybV
|
||||
+ -> do { id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "<script src=\"");
|
||||
+ id (TBH.toHtml yn_aybV);
|
||||
+ id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "\"></script>") })
|
||||
+ Nothing;
|
||||
+ Text.Hamlet.maybeH
|
||||
+ (right eyn)
|
||||
+ (\ yn_aybW
|
||||
+ -> do { id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "<script src=\"");
|
||||
+ id
|
||||
+ (TBH.toHtml
|
||||
+ (\ u_aybX -> _render_aybU u_aybX [] yn_aybW));
|
||||
+ id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "\"></script>") })
|
||||
+ Nothing;
|
||||
+ Text.Hamlet.maybeH
|
||||
+ mcomplete
|
||||
+ (\ complete_aybY
|
||||
+ -> do { id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "<script>yepnope({load:");
|
||||
+ id (TBH.toHtml (jsonArray scripts));
|
||||
+ id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ ",complete:function(){");
|
||||
+ id complete_aybY _render_aybU;
|
||||
+ id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "}});</script>") })
|
||||
+ (Just
|
||||
+ (do { id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "<script>yepnope({load:");
|
||||
+ id (TBH.toHtml (jsonArray scripts));
|
||||
+ id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "});</script>") })) }
|
||||
+-}
|
||||
|
||||
asyncHelper :: (url -> [x] -> Text)
|
||||
-> [Script (url)]
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,26 +0,0 @@
|
|||
From b7e01a2fded6575678db234e1f2de1f104f11376 Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Mon, 15 Apr 2013 15:25:07 -0400
|
||||
Subject: [PATCH 3/3] exports for TH splices
|
||||
|
||||
---
|
||||
Yesod/Widget.hs | 3 +++
|
||||
1 file changed, 3 insertions(+)
|
||||
|
||||
diff --git a/Yesod/Widget.hs b/Yesod/Widget.hs
|
||||
index bf79150..01ae294 100644
|
||||
--- a/Yesod/Widget.hs
|
||||
+++ b/Yesod/Widget.hs
|
||||
@@ -52,6 +52,9 @@ module Yesod.Widget
|
||||
, addScriptEither
|
||||
-- * Internal
|
||||
, unGWidget
|
||||
+
|
||||
+ -- used by TH code
|
||||
+ , liftW
|
||||
) where
|
||||
|
||||
import Data.Monoid
|
||||
--
|
||||
1.8.2.rc3
|
||||
|
427
standalone/android/haskell-patches/yesod-core_expand_TH.patch
Normal file
427
standalone/android/haskell-patches/yesod-core_expand_TH.patch
Normal file
|
@ -0,0 +1,427 @@
|
|||
From 9e15d4af1f53c76a402ec1782e0306a4bee7eec7 Mon Sep 17 00:00:00 2001
|
||||
From: foo <foo@bar>
|
||||
Date: Sun, 22 Sep 2013 04:03:56 +0000
|
||||
Subject: [PATCH] expad TH
|
||||
|
||||
used EvilSplicer
|
||||
Has to remove some logger TH splices which didn't come out.
|
||||
---
|
||||
Yesod/Core.hs | 2 -
|
||||
Yesod/Core/Class/Yesod.hs | 247 ++++++++++++++++++++++++++++++--------------
|
||||
Yesod/Core/Dispatch.hs | 7 --
|
||||
Yesod/Core/Handler.hs | 24 ++---
|
||||
Yesod/Core/Internal/Run.hs | 2 -
|
||||
Yesod/Core/Widget.hs | 2 +
|
||||
6 files changed, 181 insertions(+), 103 deletions(-)
|
||||
|
||||
diff --git a/Yesod/Core.hs b/Yesod/Core.hs
|
||||
index 12e59d5..f1ff21c 100644
|
||||
--- a/Yesod/Core.hs
|
||||
+++ b/Yesod/Core.hs
|
||||
@@ -94,8 +94,6 @@ module Yesod.Core
|
||||
, JavascriptUrl
|
||||
, renderJavascriptUrl
|
||||
-- ** Cassius/Lucius
|
||||
- , cassius
|
||||
- , lucius
|
||||
, CssUrl
|
||||
, renderCssUrl
|
||||
) where
|
||||
diff --git a/Yesod/Core/Class/Yesod.hs b/Yesod/Core/Class/Yesod.hs
|
||||
index cf02a1a..3f1e88e 100644
|
||||
--- a/Yesod/Core/Class/Yesod.hs
|
||||
+++ b/Yesod/Core/Class/Yesod.hs
|
||||
@@ -9,6 +9,10 @@ import Yesod.Core.Content
|
||||
import Yesod.Core.Handler
|
||||
|
||||
import Yesod.Routes.Class
|
||||
+import qualified Text.Blaze.Internal
|
||||
+import qualified Control.Monad.Logger
|
||||
+import qualified Text.Hamlet
|
||||
+import qualified Data.Foldable
|
||||
|
||||
import Blaze.ByteString.Builder (Builder)
|
||||
import Blaze.ByteString.Builder.Char.Utf8 (fromText)
|
||||
@@ -87,18 +91,27 @@ class RenderRoute site => Yesod site where
|
||||
defaultLayout w = do
|
||||
p <- widgetToPageContent w
|
||||
mmsg <- getMessage
|
||||
- giveUrlRenderer [hamlet|
|
||||
- $newline never
|
||||
- $doctype 5
|
||||
- <html>
|
||||
- <head>
|
||||
- <title>#{pageTitle p}
|
||||
- ^{pageHead p}
|
||||
- <body>
|
||||
- $maybe msg <- mmsg
|
||||
- <p .message>#{msg}
|
||||
- ^{pageBody p}
|
||||
- |]
|
||||
+ giveUrlRenderer $ \ _render_aHra
|
||||
+ -> do { id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "<!DOCTYPE html>\n<html><head><title>");
|
||||
+ id (TBH.toHtml (pageTitle p));
|
||||
+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</title>");
|
||||
+ Text.Hamlet.asHtmlUrl (pageHead p) _render_aHra;
|
||||
+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</head><body>");
|
||||
+ Text.Hamlet.maybeH
|
||||
+ mmsg
|
||||
+ (\ msg_aHrb
|
||||
+ -> do { id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "<p class=\"message\">");
|
||||
+ id (TBH.toHtml msg_aHrb);
|
||||
+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</p>") })
|
||||
+ Nothing;
|
||||
+ Text.Hamlet.asHtmlUrl (pageBody p) _render_aHra;
|
||||
+ id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "</body></html>") }
|
||||
+
|
||||
|
||||
-- | Override the rendering function for a particular URL. One use case for
|
||||
-- this is to offload static hosting to a different domain name to avoid
|
||||
@@ -356,45 +369,103 @@ widgetToPageContent w = do
|
||||
-- modernizr should be at the end of the <head> http://www.modernizr.com/docs/#installing
|
||||
-- the asynchronous loader means your page doesn't have to wait for all the js to load
|
||||
let (mcomplete, asyncScripts) = asyncHelper render scripts jscript jsLoc
|
||||
- regularScriptLoad = [hamlet|
|
||||
- $newline never
|
||||
- $forall s <- scripts
|
||||
- ^{mkScriptTag s}
|
||||
- $maybe j <- jscript
|
||||
- $maybe s <- jsLoc
|
||||
- <script src="#{s}">
|
||||
- $nothing
|
||||
- <script>^{jelper j}
|
||||
- |]
|
||||
-
|
||||
- headAll = [hamlet|
|
||||
- $newline never
|
||||
- \^{head'}
|
||||
- $forall s <- stylesheets
|
||||
- ^{mkLinkTag s}
|
||||
- $forall s <- css
|
||||
- $maybe t <- right $ snd s
|
||||
- $maybe media <- fst s
|
||||
- <link rel=stylesheet media=#{media} href=#{t}>
|
||||
- $nothing
|
||||
- <link rel=stylesheet href=#{t}>
|
||||
- $maybe content <- left $ snd s
|
||||
- $maybe media <- fst s
|
||||
- <style media=#{media}>#{content}
|
||||
- $nothing
|
||||
- <style>#{content}
|
||||
- $case jsLoader master
|
||||
- $of BottomOfBody
|
||||
- $of BottomOfHeadAsync asyncJsLoader
|
||||
- ^{asyncJsLoader asyncScripts mcomplete}
|
||||
- $of BottomOfHeadBlocking
|
||||
- ^{regularScriptLoad}
|
||||
- |]
|
||||
- let bodyScript = [hamlet|
|
||||
- $newline never
|
||||
- ^{body}
|
||||
- ^{regularScriptLoad}
|
||||
- |]
|
||||
+ regularScriptLoad = \ _render_aHsO
|
||||
+ -> do { Data.Foldable.mapM_
|
||||
+ (\ s_aHsP
|
||||
+ -> Text.Hamlet.asHtmlUrl (mkScriptTag s_aHsP) _render_aHsO)
|
||||
+ scripts;
|
||||
+ Text.Hamlet.maybeH
|
||||
+ jscript
|
||||
+ (\ j_aHsQ
|
||||
+ -> Text.Hamlet.maybeH
|
||||
+ jsLoc
|
||||
+ (\ s_aHsR
|
||||
+ -> do { id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "<script src=\"");
|
||||
+ id (TBH.toHtml s_aHsR);
|
||||
+ id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "\"></script>") })
|
||||
+ (Just
|
||||
+ (do { id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "<script>");
|
||||
+ Text.Hamlet.asHtmlUrl (jelper j_aHsQ) _render_aHsO;
|
||||
+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</script>") })))
|
||||
+ Nothing }
|
||||
+
|
||||
+
|
||||
+ headAll = \ _render_aHsW
|
||||
+ -> do { Text.Hamlet.asHtmlUrl head' _render_aHsW;
|
||||
+ Data.Foldable.mapM_
|
||||
+ (\ s_aHsX -> Text.Hamlet.asHtmlUrl (mkLinkTag s_aHsX) _render_aHsW)
|
||||
+ stylesheets;
|
||||
+ Data.Foldable.mapM_
|
||||
+ (\ s_aHsY
|
||||
+ -> do { Text.Hamlet.maybeH
|
||||
+ (right (snd s_aHsY))
|
||||
+ (\ t_aHsZ
|
||||
+ -> Text.Hamlet.maybeH
|
||||
+ (fst s_aHsY)
|
||||
+ (\ media_aHt0
|
||||
+ -> do { id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "<link rel=\"stylesheet\" media=\"");
|
||||
+ id (TBH.toHtml media_aHt0);
|
||||
+ id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "\" href=\"");
|
||||
+ id (TBH.toHtml t_aHsZ);
|
||||
+ id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "\">") })
|
||||
+ (Just
|
||||
+ (do { id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "<link rel=\"stylesheet\" href=\"");
|
||||
+ id (TBH.toHtml t_aHsZ);
|
||||
+ id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "\">") })))
|
||||
+ Nothing;
|
||||
+ Text.Hamlet.maybeH
|
||||
+ (left (snd s_aHsY))
|
||||
+ (\ content_aHt1
|
||||
+ -> Text.Hamlet.maybeH
|
||||
+ (fst s_aHsY)
|
||||
+ (\ media_aHt2
|
||||
+ -> do { id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "<style media=\"");
|
||||
+ id (TBH.toHtml media_aHt2);
|
||||
+ id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "\">");
|
||||
+ id (TBH.toHtml content_aHt1);
|
||||
+ id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "</style>") })
|
||||
+ (Just
|
||||
+ (do { id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "<style>");
|
||||
+ id (TBH.toHtml content_aHt1);
|
||||
+ id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "</style>") })))
|
||||
+ Nothing })
|
||||
+ css;
|
||||
+ case jsLoader master of {
|
||||
+ BottomOfBody -> return ()
|
||||
+ ; BottomOfHeadAsync asyncJsLoader_aHt3
|
||||
+ -> Text.Hamlet.asHtmlUrl
|
||||
+ (asyncJsLoader_aHt3 asyncScripts mcomplete) _render_aHsW
|
||||
+ ; BottomOfHeadBlocking
|
||||
+ -> Text.Hamlet.asHtmlUrl regularScriptLoad _render_aHsW } }
|
||||
+
|
||||
+ let bodyScript = \ _render_aHt8 -> do { Text.Hamlet.asHtmlUrl body _render_aHt8;
|
||||
+ Text.Hamlet.asHtmlUrl regularScriptLoad _render_aHt8 }
|
||||
+
|
||||
|
||||
return $ PageContent title headAll $
|
||||
case jsLoader master of
|
||||
@@ -424,10 +495,13 @@ defaultErrorHandler NotFound = selectRep $ do
|
||||
r <- waiRequest
|
||||
let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r
|
||||
setTitle "Not Found"
|
||||
- toWidget [hamlet|
|
||||
- <h1>Not Found
|
||||
- <p>#{path'}
|
||||
- |]
|
||||
+ toWidget $ \ _render_aHte
|
||||
+ -> do { id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "<h1>Not Found</h1>\n<p>");
|
||||
+ id (TBH.toHtml path');
|
||||
+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</p>") }
|
||||
+
|
||||
provideRep $ return $ object ["message" .= ("Not Found" :: Text)]
|
||||
|
||||
-- For API requests.
|
||||
@@ -437,10 +511,11 @@ defaultErrorHandler NotFound = selectRep $ do
|
||||
defaultErrorHandler NotAuthenticated = selectRep $ do
|
||||
provideRep $ defaultLayout $ do
|
||||
setTitle "Not logged in"
|
||||
- toWidget [hamlet|
|
||||
- <h1>Not logged in
|
||||
- <p style="display:none;">Set the authRoute and the user will be redirected there.
|
||||
- |]
|
||||
+ toWidget $ \ _render_aHti
|
||||
+ -> id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "<h1>Not logged in</h1>\n<p style=\"none;\">Set the authRoute and the user will be redirected there.</p>")
|
||||
+
|
||||
|
||||
provideRep $ do
|
||||
-- 401 *MUST* include a WWW-Authenticate header
|
||||
@@ -462,10 +537,13 @@ defaultErrorHandler NotAuthenticated = selectRep $ do
|
||||
defaultErrorHandler (PermissionDenied msg) = selectRep $ do
|
||||
provideRep $ defaultLayout $ do
|
||||
setTitle "Permission Denied"
|
||||
- toWidget [hamlet|
|
||||
- <h1>Permission denied
|
||||
- <p>#{msg}
|
||||
- |]
|
||||
+ toWidget $ \ _render_aHtq
|
||||
+ -> do { id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "<h1>Permission denied</h1>\n<p>");
|
||||
+ id (TBH.toHtml msg);
|
||||
+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</p>") }
|
||||
+
|
||||
provideRep $
|
||||
return $ object $ [
|
||||
"message" .= ("Permission Denied. " <> msg)
|
||||
@@ -474,30 +552,43 @@ defaultErrorHandler (PermissionDenied msg) = selectRep $ do
|
||||
defaultErrorHandler (InvalidArgs ia) = selectRep $ do
|
||||
provideRep $ defaultLayout $ do
|
||||
setTitle "Invalid Arguments"
|
||||
- toWidget [hamlet|
|
||||
- <h1>Invalid Arguments
|
||||
- <ul>
|
||||
- $forall msg <- ia
|
||||
- <li>#{msg}
|
||||
- |]
|
||||
+ toWidget $ \ _render_aHtv
|
||||
+ -> do { id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "<h1>Invalid Arguments</h1>\n<ul>");
|
||||
+ Data.Foldable.mapM_
|
||||
+ (\ msg_aHtw
|
||||
+ -> do { id ((Text.Blaze.Internal.preEscapedText . T.pack) "<li>");
|
||||
+ id (TBH.toHtml msg_aHtw);
|
||||
+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</li>") })
|
||||
+ ia;
|
||||
+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</ul>") }
|
||||
+
|
||||
provideRep $ return $ object ["message" .= ("Invalid Arguments" :: Text), "errors" .= ia]
|
||||
defaultErrorHandler (InternalError e) = do
|
||||
- $logErrorS "yesod-core" e
|
||||
selectRep $ do
|
||||
provideRep $ defaultLayout $ do
|
||||
setTitle "Internal Server Error"
|
||||
- toWidget [hamlet|
|
||||
- <h1>Internal Server Error
|
||||
- <pre>#{e}
|
||||
- |]
|
||||
+ toWidget $ \ _render_aHtC
|
||||
+ -> do { id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "<h1>Internal Server Error</h1>\n<pre>");
|
||||
+ id (TBH.toHtml e);
|
||||
+ id ((Text.Blaze.Internal.preEscapedText . T.pack) "</pre>") }
|
||||
+
|
||||
provideRep $ return $ object ["message" .= ("Internal Server Error" :: Text), "error" .= e]
|
||||
defaultErrorHandler (BadMethod m) = selectRep $ do
|
||||
provideRep $ defaultLayout $ do
|
||||
setTitle"Bad Method"
|
||||
- toWidget [hamlet|
|
||||
- <h1>Method Not Supported
|
||||
- <p>Method <code>#{S8.unpack m}</code> not supported
|
||||
- |]
|
||||
+ toWidget $ \ _render_aHtH
|
||||
+ -> do { id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "<h1>Method Not Supported</h1>\n<p>Method <code>");
|
||||
+ id (TBH.toHtml (S8.unpack m));
|
||||
+ id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "</code> not supported</p>") }
|
||||
+
|
||||
provideRep $ return $ object ["message" .= ("Bad method" :: Text), "method" .= m]
|
||||
|
||||
asyncHelper :: (url -> [x] -> Text)
|
||||
diff --git a/Yesod/Core/Dispatch.hs b/Yesod/Core/Dispatch.hs
|
||||
index 335a15c..4ca05da 100644
|
||||
--- a/Yesod/Core/Dispatch.hs
|
||||
+++ b/Yesod/Core/Dispatch.hs
|
||||
@@ -123,13 +123,6 @@ toWaiApp site = do
|
||||
, yreSite = site
|
||||
, yreSessionBackend = sb
|
||||
}
|
||||
- messageLoggerSource
|
||||
- site
|
||||
- logger
|
||||
- $(qLocation >>= liftLoc)
|
||||
- "yesod-core"
|
||||
- LevelInfo
|
||||
- (toLogStr ("Application launched" :: S.ByteString))
|
||||
middleware <- mkDefaultMiddlewares logger
|
||||
return $ middleware $ toWaiAppYre yre
|
||||
|
||||
diff --git a/Yesod/Core/Handler.hs b/Yesod/Core/Handler.hs
|
||||
index f3b1799..d819b04 100644
|
||||
--- a/Yesod/Core/Handler.hs
|
||||
+++ b/Yesod/Core/Handler.hs
|
||||
@@ -152,7 +152,7 @@ import qualified Control.Monad.Trans.Writer as Writer
|
||||
|
||||
import Control.Monad.IO.Class (MonadIO, liftIO)
|
||||
import Control.Monad.Trans.Resource (MonadResource, liftResourceT)
|
||||
-
|
||||
+import qualified Text.Blaze.Internal
|
||||
import qualified Network.HTTP.Types as H
|
||||
import qualified Network.Wai as W
|
||||
import Control.Monad.Trans.Class (lift)
|
||||
@@ -710,19 +710,15 @@ redirectToPost :: (MonadHandler m, RedirectUrl (HandlerSite m) url)
|
||||
-> m a
|
||||
redirectToPost url = do
|
||||
urlText <- toTextUrl url
|
||||
- giveUrlRenderer [hamlet|
|
||||
-$newline never
|
||||
-$doctype 5
|
||||
-
|
||||
-<html>
|
||||
- <head>
|
||||
- <title>Redirecting...
|
||||
- <body onload="document.getElementById('form').submit()">
|
||||
- <form id="form" method="post" action=#{urlText}>
|
||||
- <noscript>
|
||||
- <p>Javascript has been disabled; please click on the button below to be redirected.
|
||||
- <input type="submit" value="Continue">
|
||||
-|] >>= sendResponse
|
||||
+ giveUrlRenderer $ \ _render_awps
|
||||
+ -> do { id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "<!DOCTYPE html>\n<html><head><title>Redirecting...</title></head><body onload=\"document.getElementById('form').submit()\"><form id=\"form\" method=\"post\" action=\"");
|
||||
+ id (toHtml urlText);
|
||||
+ id
|
||||
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
|
||||
+ "\"><noscript><p>Javascript has been disabled; please click on the button below to be redirected.</p></noscript><input type=\"submit\" value=\"Continue\"></form></body></html>") }
|
||||
+ >>= sendResponse
|
||||
|
||||
-- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.
|
||||
hamletToRepHtml :: MonadHandler m => HtmlUrl (Route (HandlerSite m)) -> m Html
|
||||
diff --git a/Yesod/Core/Internal/Run.hs b/Yesod/Core/Internal/Run.hs
|
||||
index 35f1d3f..8b92e99 100644
|
||||
--- a/Yesod/Core/Internal/Run.hs
|
||||
+++ b/Yesod/Core/Internal/Run.hs
|
||||
@@ -122,8 +122,6 @@ safeEh :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
|
||||
-> ErrorResponse
|
||||
-> YesodApp
|
||||
safeEh log' er req = do
|
||||
- liftIO $ log' $(qLocation >>= liftLoc) "yesod-core" LevelError
|
||||
- $ toLogStr $ "Error handler errored out: " ++ show er
|
||||
return $ YRPlain
|
||||
H.status500
|
||||
[]
|
||||
diff --git a/Yesod/Core/Widget.hs b/Yesod/Core/Widget.hs
|
||||
index be97764..874f018 100644
|
||||
--- a/Yesod/Core/Widget.hs
|
||||
+++ b/Yesod/Core/Widget.hs
|
||||
@@ -47,6 +47,8 @@ module Yesod.Core.Widget
|
||||
, handlerToWidget
|
||||
-- * Internal
|
||||
, whamletFileWithSettings
|
||||
+ -- used by TH
|
||||
+ , asWidgetT
|
||||
) where
|
||||
|
||||
import Data.Monoid
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,102 +0,0 @@
|
|||
From 8ff7908799eb69d440168ff3df1fe3187879df33 Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Thu, 28 Feb 2013 23:39:57 -0400
|
||||
Subject: [PATCH] remove TH
|
||||
|
||||
---
|
||||
Yesod/Default/Util.hs | 61 +------------------------------------------------
|
||||
1 file changed, 1 insertion(+), 60 deletions(-)
|
||||
|
||||
diff --git a/Yesod/Default/Util.hs b/Yesod/Default/Util.hs
|
||||
index 578b9bc..178e342 100644
|
||||
--- a/Yesod/Default/Util.hs
|
||||
+++ b/Yesod/Default/Util.hs
|
||||
@@ -5,8 +5,6 @@
|
||||
module Yesod.Default.Util
|
||||
( addStaticContentExternal
|
||||
, globFile
|
||||
- , widgetFileNoReload
|
||||
- , widgetFileReload
|
||||
, TemplateLanguage (..)
|
||||
, defaultTemplateLanguages
|
||||
, WidgetFileSettings
|
||||
@@ -21,9 +19,6 @@ import Yesod.Core -- purposely using complete import so that Haddock will see ad
|
||||
import Control.Monad (when, unless)
|
||||
import System.Directory (doesFileExist, createDirectoryIfMissing)
|
||||
import Language.Haskell.TH.Syntax
|
||||
-import Text.Lucius (luciusFile, luciusFileReload)
|
||||
-import Text.Julius (juliusFile, juliusFileReload)
|
||||
-import Text.Cassius (cassiusFile, cassiusFileReload)
|
||||
import Text.Hamlet (HamletSettings, defaultHamletSettings)
|
||||
import Data.Maybe (catMaybes)
|
||||
import Data.Default (Default (def))
|
||||
@@ -72,13 +67,7 @@ data TemplateLanguage = TemplateLanguage
|
||||
|
||||
defaultTemplateLanguages :: HamletSettings -> [TemplateLanguage]
|
||||
defaultTemplateLanguages hset =
|
||||
- [ TemplateLanguage False "hamlet" whamletFile' whamletFile'
|
||||
- , TemplateLanguage True "cassius" cassiusFile cassiusFileReload
|
||||
- , TemplateLanguage True "julius" juliusFile juliusFileReload
|
||||
- , TemplateLanguage True "lucius" luciusFile luciusFileReload
|
||||
- ]
|
||||
- where
|
||||
- whamletFile' = whamletFileWithSettings hset
|
||||
+ [ ]
|
||||
|
||||
data WidgetFileSettings = WidgetFileSettings
|
||||
{ wfsLanguages :: HamletSettings -> [TemplateLanguage]
|
||||
@@ -87,51 +76,3 @@ data WidgetFileSettings = WidgetFileSettings
|
||||
|
||||
instance Default WidgetFileSettings where
|
||||
def = WidgetFileSettings defaultTemplateLanguages defaultHamletSettings
|
||||
-
|
||||
-widgetFileNoReload :: WidgetFileSettings -> FilePath -> Q Exp
|
||||
-widgetFileNoReload wfs x = combine "widgetFileNoReload" x False $ wfsLanguages wfs $ wfsHamletSettings wfs
|
||||
-
|
||||
-widgetFileReload :: WidgetFileSettings -> FilePath -> Q Exp
|
||||
-widgetFileReload wfs x = combine "widgetFileReload" x True $ wfsLanguages wfs $ wfsHamletSettings wfs
|
||||
-
|
||||
-combine :: String -> String -> Bool -> [TemplateLanguage] -> Q Exp
|
||||
-combine func file isReload tls = do
|
||||
- mexps <- qmexps
|
||||
- case catMaybes mexps of
|
||||
- [] -> error $ concat
|
||||
- [ "Called "
|
||||
- , func
|
||||
- , " on "
|
||||
- , show file
|
||||
- , ", but no template were found."
|
||||
- ]
|
||||
- exps -> return $ DoE $ map NoBindS exps
|
||||
- where
|
||||
- qmexps :: Q [Maybe Exp]
|
||||
- qmexps = mapM go tls
|
||||
-
|
||||
- go :: TemplateLanguage -> Q (Maybe Exp)
|
||||
- go tl = whenExists file (tlRequiresToWidget tl) (tlExtension tl) ((if isReload then tlReload else tlNoReload) tl)
|
||||
-
|
||||
-whenExists :: String
|
||||
- -> Bool -- ^ requires toWidget wrap
|
||||
- -> String -> (FilePath -> Q Exp) -> Q (Maybe Exp)
|
||||
-whenExists = warnUnlessExists False
|
||||
-
|
||||
-warnUnlessExists :: Bool
|
||||
- -> String
|
||||
- -> Bool -- ^ requires toWidget wrap
|
||||
- -> String -> (FilePath -> Q Exp) -> Q (Maybe Exp)
|
||||
-warnUnlessExists shouldWarn x wrap glob f = do
|
||||
- let fn = globFile glob x
|
||||
- e <- qRunIO $ doesFileExist fn
|
||||
- when (shouldWarn && not e) $ qRunIO $ putStrLn $ "widget file not found: " ++ fn
|
||||
- if e
|
||||
- then do
|
||||
- ex <- f fn
|
||||
- if wrap
|
||||
- then do
|
||||
- tw <- [|toWidget|]
|
||||
- return $ Just $ tw `AppE` ex
|
||||
- else return $ Just ex
|
||||
- else return Nothing
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,83 +0,0 @@
|
|||
From a603bac40f0a0f6232fbfb056a778860270101de Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Mon, 15 Apr 2013 15:59:56 -0400
|
||||
Subject: [PATCH 1/2] prepare for Evil Splicer
|
||||
|
||||
---
|
||||
Yesod/Form/Functions.hs | 3 +--
|
||||
evilsplicer-headers.hs | 9 +++++++++
|
||||
yesod-form.cabal | 5 +++--
|
||||
3 files changed, 13 insertions(+), 4 deletions(-)
|
||||
create mode 100644 evilsplicer-headers.hs
|
||||
|
||||
diff --git a/Yesod/Form/Functions.hs b/Yesod/Form/Functions.hs
|
||||
index db3e493..89eb1e8 100644
|
||||
--- a/Yesod/Form/Functions.hs
|
||||
+++ b/Yesod/Form/Functions.hs
|
||||
@@ -54,10 +54,9 @@ import Text.Blaze (Markup, toMarkup)
|
||||
#define toHtml toMarkup
|
||||
import Yesod.Handler (GHandler, getRequest, runRequestBody, newIdent, getYesod)
|
||||
import Yesod.Core (RenderMessage, SomeMessage (..))
|
||||
-import Yesod.Widget (GWidget, whamlet)
|
||||
+import Yesod.Widget (GWidget)
|
||||
import Yesod.Request (reqToken, reqWaiRequest, reqGetParams, languages)
|
||||
import Network.Wai (requestMethod)
|
||||
-import Text.Hamlet (shamlet)
|
||||
import Data.Monoid (mempty)
|
||||
import Data.Maybe (listToMaybe, fromMaybe)
|
||||
import Yesod.Message (RenderMessage (..))
|
||||
diff --git a/evilsplicer-headers.hs b/evilsplicer-headers.hs
|
||||
new file mode 100644
|
||||
index 0000000..865d043
|
||||
--- /dev/null
|
||||
+++ b/evilsplicer-headers.hs
|
||||
@@ -0,0 +1,9 @@
|
||||
+import qualified Data.Text.Lazy.Builder
|
||||
+import qualified Text.Shakespeare
|
||||
+import qualified Text.Hamlet
|
||||
+import qualified Data.Monoid
|
||||
+import qualified Text.Julius
|
||||
+import qualified "blaze-markup" Text.Blaze.Internal
|
||||
+import qualified "blaze-markup" Text.Blaze as Text.Blaze.Markup
|
||||
+import qualified Yesod.Widget
|
||||
+import qualified Data.Foldable
|
||||
diff --git a/yesod-form.cabal b/yesod-form.cabal
|
||||
index a0d2a80..ae99ddc 100644
|
||||
--- a/yesod-form.cabal
|
||||
+++ b/yesod-form.cabal
|
||||
@@ -18,7 +18,7 @@ library
|
||||
, yesod-persistent >= 1.1 && < 1.2
|
||||
, time >= 1.1.4
|
||||
, hamlet >= 1.1 && < 1.2
|
||||
- , shakespeare-css >= 1.0 && < 1.1
|
||||
+ , shakespeare-css == 1.0.2
|
||||
, shakespeare-js >= 1.0.2 && < 1.2
|
||||
, persistent >= 1.0 && < 1.2
|
||||
, template-haskell
|
||||
@@ -37,6 +37,7 @@ library
|
||||
, attoparsec >= 0.10 && < 0.11
|
||||
, crypto-api >= 0.8 && < 0.11
|
||||
, aeson
|
||||
+ , shakespeare
|
||||
|
||||
exposed-modules: Yesod.Form
|
||||
Yesod.Form.Class
|
||||
@@ -45,7 +46,6 @@ library
|
||||
Yesod.Form.Input
|
||||
Yesod.Form.Fields
|
||||
Yesod.Form.Jquery
|
||||
- Yesod.Form.Nic
|
||||
Yesod.Form.MassInput
|
||||
Yesod.Form.I18n.English
|
||||
Yesod.Form.I18n.Portuguese
|
||||
@@ -56,6 +56,7 @@ library
|
||||
Yesod.Form.I18n.Japanese
|
||||
-- FIXME Yesod.Helpers.Crud
|
||||
ghc-options: -Wall
|
||||
+ Extensions: PackageImports
|
||||
|
||||
test-suite test
|
||||
type: exitcode-stdio-1.0
|
||||
--
|
||||
1.8.2.rc3
|
||||
|
File diff suppressed because it is too large
Load diff
1746
standalone/android/haskell-patches/yesod-form_spliced-TH.patch
Normal file
1746
standalone/android/haskell-patches/yesod-form_spliced-TH.patch
Normal file
File diff suppressed because it is too large
Load diff
|
@ -1,41 +0,0 @@
|
|||
From 62cc9e3f70d8cea848d56efa198a68527fd07267 Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Thu, 28 Feb 2013 23:40:19 -0400
|
||||
Subject: [PATCH] avoid TH
|
||||
|
||||
---
|
||||
Yesod/Persist.hs | 2 --
|
||||
yesod-persistent.cabal | 1 -
|
||||
2 files changed, 3 deletions(-)
|
||||
|
||||
diff --git a/Yesod/Persist.hs b/Yesod/Persist.hs
|
||||
index 0646152..5130497 100644
|
||||
--- a/Yesod/Persist.hs
|
||||
+++ b/Yesod/Persist.hs
|
||||
@@ -7,11 +7,9 @@ module Yesod.Persist
|
||||
, get404
|
||||
, getBy404
|
||||
, module Database.Persist
|
||||
- , module Database.Persist.TH
|
||||
) where
|
||||
|
||||
import Database.Persist
|
||||
-import Database.Persist.TH
|
||||
import Control.Monad.Trans.Class (MonadTrans)
|
||||
|
||||
import Yesod.Handler
|
||||
diff --git a/yesod-persistent.cabal b/yesod-persistent.cabal
|
||||
index 111c1b9..07f6e17 100644
|
||||
--- a/yesod-persistent.cabal
|
||||
+++ b/yesod-persistent.cabal
|
||||
@@ -16,7 +16,6 @@ library
|
||||
build-depends: base >= 4 && < 5
|
||||
, yesod-core >= 1.1 && < 1.2
|
||||
, persistent >= 1.0 && < 1.2
|
||||
- , persistent-template >= 1.0 && < 1.2
|
||||
, transformers >= 0.2.2 && < 0.4
|
||||
exposed-modules: Yesod.Persist
|
||||
ghc-options: -Wall
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -0,0 +1,26 @@
|
|||
From 03819615edb1c5f7414768dae84234d6791bd758 Mon Sep 17 00:00:00 2001
|
||||
From: foo <foo@bar>
|
||||
Date: Sun, 22 Sep 2013 04:11:46 +0000
|
||||
Subject: [PATCH] do not really build
|
||||
|
||||
---
|
||||
yesod-persistent.cabal | 3 +--
|
||||
1 file changed, 1 insertion(+), 2 deletions(-)
|
||||
|
||||
diff --git a/yesod-persistent.cabal b/yesod-persistent.cabal
|
||||
index 98c2146..11960cf 100644
|
||||
--- a/yesod-persistent.cabal
|
||||
+++ b/yesod-persistent.cabal
|
||||
@@ -23,8 +23,7 @@ library
|
||||
, lifted-base
|
||||
, pool-conduit
|
||||
, resourcet
|
||||
- exposed-modules: Yesod.Persist
|
||||
- Yesod.Persist.Core
|
||||
+ exposed-modules:
|
||||
ghc-options: -Wall
|
||||
|
||||
test-suite test
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,674 +0,0 @@
|
|||
From 06176b0f3dbbe559490f0971e0db205287793286 Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Mon, 15 Apr 2013 21:01:12 -0400
|
||||
Subject: [PATCH] remove TH and export module used by TH splices
|
||||
|
||||
---
|
||||
Yesod/Routes/Overlap.hs | 74 ----------
|
||||
Yesod/Routes/Parse.hs | 115 ---------------
|
||||
Yesod/Routes/TH.hs | 12 --
|
||||
Yesod/Routes/TH/Dispatch.hs | 344 --------------------------------------------
|
||||
Yesod/Routes/TH/Types.hs | 16 ---
|
||||
yesod-routes.cabal | 21 ---
|
||||
6 files changed, 582 deletions(-)
|
||||
delete mode 100644 Yesod/Routes/Overlap.hs
|
||||
delete mode 100644 Yesod/Routes/Parse.hs
|
||||
delete mode 100644 Yesod/Routes/TH.hs
|
||||
delete mode 100644 Yesod/Routes/TH/Dispatch.hs
|
||||
|
||||
diff --git a/Yesod/Routes/Overlap.hs b/Yesod/Routes/Overlap.hs
|
||||
deleted file mode 100644
|
||||
index ae45a02..0000000
|
||||
--- a/Yesod/Routes/Overlap.hs
|
||||
+++ /dev/null
|
||||
@@ -1,74 +0,0 @@
|
||||
--- | Check for overlapping routes.
|
||||
-module Yesod.Routes.Overlap
|
||||
- ( findOverlaps
|
||||
- , findOverlapNames
|
||||
- , Overlap (..)
|
||||
- ) where
|
||||
-
|
||||
-import Yesod.Routes.TH.Types
|
||||
-import Data.List (intercalate)
|
||||
-
|
||||
-data Overlap t = Overlap
|
||||
- { overlapParents :: [String] -> [String] -- ^ parent resource trees
|
||||
- , overlap1 :: ResourceTree t
|
||||
- , overlap2 :: ResourceTree t
|
||||
- }
|
||||
-
|
||||
-findOverlaps :: ([String] -> [String]) -> [ResourceTree t] -> [Overlap t]
|
||||
-findOverlaps _ [] = []
|
||||
-findOverlaps front (x:xs) = concatMap (findOverlap front x) xs ++ findOverlaps front xs
|
||||
-
|
||||
-findOverlap :: ([String] -> [String]) -> ResourceTree t -> ResourceTree t -> [Overlap t]
|
||||
-findOverlap front x y =
|
||||
- here rest
|
||||
- where
|
||||
- here
|
||||
- | overlaps (resourceTreePieces x) (resourceTreePieces y) (hasSuffix x) (hasSuffix y) = (Overlap front x y:)
|
||||
- | otherwise = id
|
||||
- rest =
|
||||
- case x of
|
||||
- ResourceParent name _ children -> findOverlaps (front . (name:)) children
|
||||
- ResourceLeaf{} -> []
|
||||
-
|
||||
-hasSuffix :: ResourceTree t -> Bool
|
||||
-hasSuffix (ResourceLeaf r) =
|
||||
- case resourceDispatch r of
|
||||
- Subsite{} -> True
|
||||
- Methods Just{} _ -> True
|
||||
- Methods Nothing _ -> False
|
||||
-hasSuffix ResourceParent{} = True
|
||||
-
|
||||
-overlaps :: [(CheckOverlap, Piece t)] -> [(CheckOverlap, Piece t)] -> Bool -> Bool -> Bool
|
||||
-
|
||||
--- No pieces on either side, will overlap regardless of suffix
|
||||
-overlaps [] [] _ _ = True
|
||||
-
|
||||
--- No pieces on the left, will overlap if the left side has a suffix
|
||||
-overlaps [] _ suffixX _ = suffixX
|
||||
-
|
||||
--- Ditto for the right
|
||||
-overlaps _ [] _ suffixY = suffixY
|
||||
-
|
||||
--- As soon as we ignore a single piece (via CheckOverlap == False), we say that
|
||||
--- the routes don't overlap at all. In other words, disabling overlap checking
|
||||
--- on a single piece disables it on the whole route.
|
||||
-overlaps ((False, _):_) _ _ _ = False
|
||||
-overlaps _ ((False, _):_) _ _ = False
|
||||
-
|
||||
--- Compare the actual pieces
|
||||
-overlaps ((True, pieceX):xs) ((True, pieceY):ys) suffixX suffixY =
|
||||
- piecesOverlap pieceX pieceY && overlaps xs ys suffixX suffixY
|
||||
-
|
||||
-piecesOverlap :: Piece t -> Piece t -> Bool
|
||||
--- Statics only match if they equal. Dynamics match with anything
|
||||
-piecesOverlap (Static x) (Static y) = x == y
|
||||
-piecesOverlap _ _ = True
|
||||
-
|
||||
-findOverlapNames :: [ResourceTree t] -> [(String, String)]
|
||||
-findOverlapNames =
|
||||
- map go . findOverlaps id
|
||||
- where
|
||||
- go (Overlap front x y) =
|
||||
- (go' $ resourceTreeName x, go' $ resourceTreeName y)
|
||||
- where
|
||||
- go' = intercalate "/" . front . return
|
||||
diff --git a/Yesod/Routes/Parse.hs b/Yesod/Routes/Parse.hs
|
||||
deleted file mode 100644
|
||||
index fc16eef..0000000
|
||||
--- a/Yesod/Routes/Parse.hs
|
||||
+++ /dev/null
|
||||
@@ -1,115 +0,0 @@
|
||||
-{-# LANGUAGE TemplateHaskell #-}
|
||||
-{-# LANGUAGE DeriveDataTypeable #-}
|
||||
-{-# OPTIONS_GHC -fno-warn-missing-fields #-} -- QuasiQuoter
|
||||
-module Yesod.Routes.Parse
|
||||
- ( parseRoutes
|
||||
- , parseRoutesFile
|
||||
- , parseRoutesNoCheck
|
||||
- , parseRoutesFileNoCheck
|
||||
- , parseType
|
||||
- ) where
|
||||
-
|
||||
-import Language.Haskell.TH.Syntax
|
||||
-import Data.Char (isUpper)
|
||||
-import Language.Haskell.TH.Quote
|
||||
-import qualified System.IO as SIO
|
||||
-import Yesod.Routes.TH
|
||||
-import Yesod.Routes.Overlap (findOverlapNames)
|
||||
-
|
||||
--- | A quasi-quoter to parse a string into a list of 'Resource's. Checks for
|
||||
--- overlapping routes, failing if present; use 'parseRoutesNoCheck' to skip the
|
||||
--- checking. See documentation site for details on syntax.
|
||||
-parseRoutes :: QuasiQuoter
|
||||
-parseRoutes = QuasiQuoter { quoteExp = x }
|
||||
- where
|
||||
- x s = do
|
||||
- let res = resourcesFromString s
|
||||
- case findOverlapNames res of
|
||||
- [] -> lift res
|
||||
- z -> error $ "Overlapping routes: " ++ unlines (map show z)
|
||||
-
|
||||
-parseRoutesFile :: FilePath -> Q Exp
|
||||
-parseRoutesFile = parseRoutesFileWith parseRoutes
|
||||
-
|
||||
-parseRoutesFileNoCheck :: FilePath -> Q Exp
|
||||
-parseRoutesFileNoCheck = parseRoutesFileWith parseRoutesNoCheck
|
||||
-
|
||||
-parseRoutesFileWith :: QuasiQuoter -> FilePath -> Q Exp
|
||||
-parseRoutesFileWith qq fp = do
|
||||
- s <- qRunIO $ readUtf8File fp
|
||||
- quoteExp qq s
|
||||
-
|
||||
-readUtf8File :: FilePath -> IO String
|
||||
-readUtf8File fp = do
|
||||
- h <- SIO.openFile fp SIO.ReadMode
|
||||
- SIO.hSetEncoding h SIO.utf8_bom
|
||||
- SIO.hGetContents h
|
||||
-
|
||||
--- | Same as 'parseRoutes', but performs no overlap checking.
|
||||
-parseRoutesNoCheck :: QuasiQuoter
|
||||
-parseRoutesNoCheck = QuasiQuoter
|
||||
- { quoteExp = lift . resourcesFromString
|
||||
- }
|
||||
-
|
||||
--- | Convert a multi-line string to a set of resources. See documentation for
|
||||
--- the format of this string. This is a partial function which calls 'error' on
|
||||
--- invalid input.
|
||||
-resourcesFromString :: String -> [ResourceTree String]
|
||||
-resourcesFromString =
|
||||
- fst . parse 0 . lines
|
||||
- where
|
||||
- parse _ [] = ([], [])
|
||||
- parse indent (thisLine:otherLines)
|
||||
- | length spaces < indent = ([], thisLine : otherLines)
|
||||
- | otherwise = (this others, remainder)
|
||||
- where
|
||||
- spaces = takeWhile (== ' ') thisLine
|
||||
- (others, remainder) = parse indent otherLines'
|
||||
- (this, otherLines') =
|
||||
- case takeWhile (/= "--") $ words thisLine of
|
||||
- [pattern, constr] | last constr == ':' ->
|
||||
- let (children, otherLines'') = parse (length spaces + 1) otherLines
|
||||
- (pieces, Nothing) = piecesFromString $ drop1Slash pattern
|
||||
- in ((ResourceParent (init constr) pieces children :), otherLines'')
|
||||
- (pattern:constr:rest) ->
|
||||
- let (pieces, mmulti) = piecesFromString $ drop1Slash pattern
|
||||
- disp = dispatchFromString rest mmulti
|
||||
- in ((ResourceLeaf (Resource constr pieces disp):), otherLines)
|
||||
- [] -> (id, otherLines)
|
||||
- _ -> error $ "Invalid resource line: " ++ thisLine
|
||||
-
|
||||
-dispatchFromString :: [String] -> Maybe String -> Dispatch String
|
||||
-dispatchFromString rest mmulti
|
||||
- | null rest = Methods mmulti []
|
||||
- | all (all isUpper) rest = Methods mmulti rest
|
||||
-dispatchFromString [subTyp, subFun] Nothing =
|
||||
- Subsite subTyp subFun
|
||||
-dispatchFromString [_, _] Just{} =
|
||||
- error "Subsites cannot have a multipiece"
|
||||
-dispatchFromString rest _ = error $ "Invalid list of methods: " ++ show rest
|
||||
-
|
||||
-drop1Slash :: String -> String
|
||||
-drop1Slash ('/':x) = x
|
||||
-drop1Slash x = x
|
||||
-
|
||||
-piecesFromString :: String -> ([(CheckOverlap, Piece String)], Maybe String)
|
||||
-piecesFromString "" = ([], Nothing)
|
||||
-piecesFromString x =
|
||||
- case (this, rest) of
|
||||
- (Left typ, ([], Nothing)) -> ([], Just typ)
|
||||
- (Left _, _) -> error "Multipiece must be last piece"
|
||||
- (Right piece, (pieces, mtyp)) -> (piece:pieces, mtyp)
|
||||
- where
|
||||
- (y, z) = break (== '/') x
|
||||
- this = pieceFromString y
|
||||
- rest = piecesFromString $ drop 1 z
|
||||
-
|
||||
-parseType :: String -> Type
|
||||
-parseType = ConT . mkName -- FIXME handle more complicated stuff
|
||||
-
|
||||
-pieceFromString :: String -> Either String (CheckOverlap, Piece String)
|
||||
-pieceFromString ('#':'!':x) = Right $ (False, Dynamic x)
|
||||
-pieceFromString ('#':x) = Right $ (True, Dynamic x)
|
||||
-pieceFromString ('*':x) = Left x
|
||||
-pieceFromString ('!':x) = Right $ (False, Static x)
|
||||
-pieceFromString x = Right $ (True, Static x)
|
||||
diff --git a/Yesod/Routes/TH.hs b/Yesod/Routes/TH.hs
|
||||
deleted file mode 100644
|
||||
index 41045b3..0000000
|
||||
--- a/Yesod/Routes/TH.hs
|
||||
+++ /dev/null
|
||||
@@ -1,12 +0,0 @@
|
||||
-{-# LANGUAGE TemplateHaskell #-}
|
||||
-module Yesod.Routes.TH
|
||||
- ( module Yesod.Routes.TH.Types
|
||||
- -- * Functions
|
||||
- , module Yesod.Routes.TH.RenderRoute
|
||||
- -- ** Dispatch
|
||||
- , module Yesod.Routes.TH.Dispatch
|
||||
- ) where
|
||||
-
|
||||
-import Yesod.Routes.TH.Types
|
||||
-import Yesod.Routes.TH.RenderRoute
|
||||
-import Yesod.Routes.TH.Dispatch
|
||||
diff --git a/Yesod/Routes/TH/Dispatch.hs b/Yesod/Routes/TH/Dispatch.hs
|
||||
deleted file mode 100644
|
||||
index a52f69a..0000000
|
||||
--- a/Yesod/Routes/TH/Dispatch.hs
|
||||
+++ /dev/null
|
||||
@@ -1,344 +0,0 @@
|
||||
-{-# LANGUAGE TemplateHaskell #-}
|
||||
-module Yesod.Routes.TH.Dispatch
|
||||
- ( -- ** Dispatch
|
||||
- mkDispatchClause
|
||||
- ) where
|
||||
-
|
||||
-import Prelude hiding (exp)
|
||||
-import Yesod.Routes.TH.Types
|
||||
-import Language.Haskell.TH.Syntax
|
||||
-import Data.Maybe (catMaybes)
|
||||
-import Control.Monad (forM, replicateM)
|
||||
-import Data.Text (pack)
|
||||
-import qualified Yesod.Routes.Dispatch as D
|
||||
-import qualified Data.Map as Map
|
||||
-import Data.Char (toLower)
|
||||
-import Web.PathPieces (PathPiece (..), PathMultiPiece (..))
|
||||
-import Control.Applicative ((<$>))
|
||||
-import Data.List (foldl')
|
||||
-
|
||||
-data FlatResource a = FlatResource [(String, [(CheckOverlap, Piece a)])] String [(CheckOverlap, Piece a)] (Dispatch a)
|
||||
-
|
||||
-flatten :: [ResourceTree a] -> [FlatResource a]
|
||||
-flatten =
|
||||
- concatMap (go id)
|
||||
- where
|
||||
- go front (ResourceLeaf (Resource a b c)) = [FlatResource (front []) a b c]
|
||||
- go front (ResourceParent name pieces children) =
|
||||
- concatMap (go (front . ((name, pieces):))) children
|
||||
-
|
||||
--- |
|
||||
---
|
||||
--- This function will generate a single clause that will address all
|
||||
--- your routing needs. It takes four arguments. The fourth (a list of
|
||||
--- 'Resource's) is self-explanatory. We\'ll discuss the first
|
||||
--- three. But first, let\'s cover the terminology.
|
||||
---
|
||||
--- Dispatching involves a master type and a sub type. When you dispatch to the
|
||||
--- top level type, master and sub are the same. Each time to dispatch to
|
||||
--- another subsite, the sub changes. This requires two changes:
|
||||
---
|
||||
--- * Getting the new sub value. This is handled via 'subsiteFunc'.
|
||||
---
|
||||
--- * Figure out a way to convert sub routes to the original master route. To
|
||||
--- address this, we keep a toMaster function, and each time we dispatch to a
|
||||
--- new subsite, we compose it with the constructor for that subsite.
|
||||
---
|
||||
--- Dispatching acts on two different components: the request method and a list
|
||||
--- of path pieces. If we cannot match the path pieces, we need to return a 404
|
||||
--- response. If the path pieces match, but the method is not supported, we need
|
||||
--- to return a 405 response.
|
||||
---
|
||||
--- The final result of dispatch is going to be an application type. A simple
|
||||
--- example would be the WAI Application type. However, our handler functions
|
||||
--- will need more input: the master/subsite, the toMaster function, and the
|
||||
--- type-safe route. Therefore, we need to have another type, the handler type,
|
||||
--- and a function that turns a handler into an application, i.e.
|
||||
---
|
||||
--- > runHandler :: handler sub master -> master -> sub -> Route sub -> (Route sub -> Route master) -> app
|
||||
---
|
||||
--- This is the first argument to our function. Note that this will almost
|
||||
--- certainly need to be a method of a typeclass, since it will want to behave
|
||||
--- differently based on the subsite.
|
||||
---
|
||||
--- Note that the 404 response passed in is an application, while the 405
|
||||
--- response is a handler, since the former can\'t be passed the type-safe
|
||||
--- route.
|
||||
---
|
||||
--- In the case of a subsite, we don\'t directly deal with a handler function.
|
||||
--- Instead, we redispatch to the subsite, passing on the updated sub value and
|
||||
--- toMaster function, as well as any remaining, unparsed path pieces. This
|
||||
--- function looks like:
|
||||
---
|
||||
--- > dispatcher :: master -> sub -> (Route sub -> Route master) -> app -> handler sub master -> Text -> [Text] -> app
|
||||
---
|
||||
--- Where the parameters mean master, sub, toMaster, 404 response, 405 response,
|
||||
--- request method and path pieces. This is the second argument of our function.
|
||||
---
|
||||
--- Finally, we need a way to decide which of the possible formats
|
||||
--- should the handler send the data out. Think of each URL holding an
|
||||
--- abstract object which has multiple representation (JSON, plain HTML
|
||||
--- etc). Each client might have a preference on which format it wants
|
||||
--- the abstract object in. For example, a javascript making a request
|
||||
--- (on behalf of a browser) might prefer a JSON object over a plain
|
||||
--- HTML file where as a user browsing with javascript disabled would
|
||||
--- want the page in HTML. The third argument is a function that
|
||||
--- converts the abstract object to the desired representation
|
||||
--- depending on the preferences sent by the client.
|
||||
---
|
||||
--- The typical values for the first three arguments are,
|
||||
--- @'yesodRunner'@ for the first, @'yesodDispatch'@ for the second and
|
||||
--- @fmap 'chooseRep'@.
|
||||
-
|
||||
-mkDispatchClause :: Q Exp -- ^ runHandler function
|
||||
- -> Q Exp -- ^ dispatcher function
|
||||
- -> Q Exp -- ^ fixHandler function
|
||||
- -> [ResourceTree a]
|
||||
- -> Q Clause
|
||||
-mkDispatchClause runHandler dispatcher fixHandler ress' = do
|
||||
- -- Allocate the names to be used. Start off with the names passed to the
|
||||
- -- function itself (with a 0 suffix).
|
||||
- --
|
||||
- -- We don't reuse names so as to avoid shadowing names (triggers warnings
|
||||
- -- with -Wall). Additionally, we want to ensure that none of the code
|
||||
- -- passed to toDispatch uses variables from the closure to prevent the
|
||||
- -- dispatch data structure from being rebuilt on each run.
|
||||
- master0 <- newName "master0"
|
||||
- sub0 <- newName "sub0"
|
||||
- toMaster0 <- newName "toMaster0"
|
||||
- app4040 <- newName "app4040"
|
||||
- handler4050 <- newName "handler4050"
|
||||
- method0 <- newName "method0"
|
||||
- pieces0 <- newName "pieces0"
|
||||
-
|
||||
- -- Name of the dispatch function
|
||||
- dispatch <- newName "dispatch"
|
||||
-
|
||||
- -- Dispatch function applied to the pieces
|
||||
- let dispatched = VarE dispatch `AppE` VarE pieces0
|
||||
-
|
||||
- -- The 'D.Route's used in the dispatch function
|
||||
- routes <- mapM (buildRoute runHandler dispatcher fixHandler) ress
|
||||
-
|
||||
- -- The dispatch function itself
|
||||
- toDispatch <- [|D.toDispatch|]
|
||||
- let dispatchFun = FunD dispatch [Clause [] (NormalB $ toDispatch `AppE` ListE routes) []]
|
||||
-
|
||||
- -- The input to the clause.
|
||||
- let pats = map VarP [master0, sub0, toMaster0, app4040, handler4050, method0, pieces0]
|
||||
-
|
||||
- -- For each resource that dispatches based on methods, build up a map for handling the dispatching.
|
||||
- methodMaps <- catMaybes <$> mapM (buildMethodMap fixHandler) ress
|
||||
-
|
||||
- u <- [|case $(return dispatched) of
|
||||
- Just f -> f $(return $ VarE master0)
|
||||
- $(return $ VarE sub0)
|
||||
- $(return $ VarE toMaster0)
|
||||
- $(return $ VarE app4040)
|
||||
- $(return $ VarE handler4050)
|
||||
- $(return $ VarE method0)
|
||||
- Nothing -> $(return $ VarE app4040)
|
||||
- |]
|
||||
- return $ Clause pats (NormalB u) $ dispatchFun : methodMaps
|
||||
- where
|
||||
- ress = flatten ress'
|
||||
-
|
||||
--- | Determine the name of the method map for a given resource name.
|
||||
-methodMapName :: String -> Name
|
||||
-methodMapName s = mkName $ "methods" ++ s
|
||||
-
|
||||
-buildMethodMap :: Q Exp -- ^ fixHandler
|
||||
- -> FlatResource a
|
||||
- -> Q (Maybe Dec)
|
||||
-buildMethodMap _ (FlatResource _ _ _ (Methods _ [])) = return Nothing -- single handle function
|
||||
-buildMethodMap fixHandler (FlatResource parents name pieces' (Methods mmulti methods)) = do
|
||||
- fromList <- [|Map.fromList|]
|
||||
- methods' <- mapM go methods
|
||||
- let exp = fromList `AppE` ListE methods'
|
||||
- let fun = FunD (methodMapName name) [Clause [] (NormalB exp) []]
|
||||
- return $ Just fun
|
||||
- where
|
||||
- pieces = concat $ map snd parents ++ [pieces']
|
||||
- go method = do
|
||||
- fh <- fixHandler
|
||||
- let func = VarE $ mkName $ map toLower method ++ name
|
||||
- pack' <- [|pack|]
|
||||
- let isDynamic Dynamic{} = True
|
||||
- isDynamic _ = False
|
||||
- let argCount = length (filter (isDynamic . snd) pieces) + maybe 0 (const 1) mmulti
|
||||
- xs <- replicateM argCount $ newName "arg"
|
||||
- let rhs = LamE (map VarP xs) $ fh `AppE` (foldl' AppE func $ map VarE xs)
|
||||
- return $ TupE [pack' `AppE` LitE (StringL method), rhs]
|
||||
-buildMethodMap _ (FlatResource _ _ _ Subsite{}) = return Nothing
|
||||
-
|
||||
--- | Build a single 'D.Route' expression.
|
||||
-buildRoute :: Q Exp -> Q Exp -> Q Exp -> FlatResource a -> Q Exp
|
||||
-buildRoute runHandler dispatcher fixHandler (FlatResource parents name resPieces resDisp) = do
|
||||
- -- First two arguments to D.Route
|
||||
- routePieces <- ListE <$> mapM (convertPiece . snd) allPieces
|
||||
- isMulti <-
|
||||
- case resDisp of
|
||||
- Methods Nothing _ -> [|False|]
|
||||
- _ -> [|True|]
|
||||
-
|
||||
- [|D.Route $(return routePieces) $(return isMulti) $(routeArg3 runHandler dispatcher fixHandler parents name (map snd allPieces) resDisp)|]
|
||||
- where
|
||||
- allPieces = concat $ map snd parents ++ [resPieces]
|
||||
-
|
||||
-routeArg3 :: Q Exp -- ^ runHandler
|
||||
- -> Q Exp -- ^ dispatcher
|
||||
- -> Q Exp -- ^ fixHandler
|
||||
- -> [(String, [(CheckOverlap, Piece a)])]
|
||||
- -> String -- ^ name of resource
|
||||
- -> [Piece a]
|
||||
- -> Dispatch a
|
||||
- -> Q Exp
|
||||
-routeArg3 runHandler dispatcher fixHandler parents name resPieces resDisp = do
|
||||
- pieces <- newName "pieces"
|
||||
-
|
||||
- -- Allocate input piece variables (xs) and variables that have been
|
||||
- -- converted via fromPathPiece (ys)
|
||||
- xs <- forM resPieces $ \piece ->
|
||||
- case piece of
|
||||
- Static _ -> return Nothing
|
||||
- Dynamic _ -> Just <$> newName "x"
|
||||
-
|
||||
- -- Note: the zipping with Ints is just a workaround for (apparently) a bug
|
||||
- -- in GHC where the identifiers are considered to be overlapping. Using
|
||||
- -- newName should avoid the problem, but it doesn't.
|
||||
- ys <- forM (zip (catMaybes xs) [1..]) $ \(x, i) -> do
|
||||
- y <- newName $ "y" ++ show (i :: Int)
|
||||
- return (x, y)
|
||||
-
|
||||
- -- In case we have multi pieces at the end
|
||||
- xrest <- newName "xrest"
|
||||
- yrest <- newName "yrest"
|
||||
-
|
||||
- -- Determine the pattern for matching the pieces
|
||||
- pat <-
|
||||
- case resDisp of
|
||||
- Methods Nothing _ -> return $ ListP $ map (maybe WildP VarP) xs
|
||||
- _ -> do
|
||||
- let cons = mkName ":"
|
||||
- return $ foldr (\a b -> ConP cons [maybe WildP VarP a, b]) (VarP xrest) xs
|
||||
-
|
||||
- -- Convert the xs
|
||||
- fromPathPiece' <- [|fromPathPiece|]
|
||||
- xstmts <- forM ys $ \(x, y) -> return $ BindS (VarP y) (fromPathPiece' `AppE` VarE x)
|
||||
-
|
||||
- -- Convert the xrest if appropriate
|
||||
- (reststmts, yrest') <-
|
||||
- case resDisp of
|
||||
- Methods (Just _) _ -> do
|
||||
- fromPathMultiPiece' <- [|fromPathMultiPiece|]
|
||||
- return ([BindS (VarP yrest) (fromPathMultiPiece' `AppE` VarE xrest)], [yrest])
|
||||
- _ -> return ([], [])
|
||||
-
|
||||
- -- The final expression that actually uses the values we've computed
|
||||
- caller <- buildCaller runHandler dispatcher fixHandler xrest parents name resDisp $ map snd ys ++ yrest'
|
||||
-
|
||||
- -- Put together all the statements
|
||||
- just <- [|Just|]
|
||||
- let stmts = concat
|
||||
- [ xstmts
|
||||
- , reststmts
|
||||
- , [NoBindS $ just `AppE` caller]
|
||||
- ]
|
||||
-
|
||||
- errorMsg <- [|error "Invariant violated"|]
|
||||
- let matches =
|
||||
- [ Match pat (NormalB $ DoE stmts) []
|
||||
- , Match WildP (NormalB errorMsg) []
|
||||
- ]
|
||||
-
|
||||
- return $ LamE [VarP pieces] $ CaseE (VarE pieces) matches
|
||||
-
|
||||
--- | The final expression in the individual Route definitions.
|
||||
-buildCaller :: Q Exp -- ^ runHandler
|
||||
- -> Q Exp -- ^ dispatcher
|
||||
- -> Q Exp -- ^ fixHandler
|
||||
- -> Name -- ^ xrest
|
||||
- -> [(String, [(CheckOverlap, Piece a)])]
|
||||
- -> String -- ^ name of resource
|
||||
- -> Dispatch a
|
||||
- -> [Name] -- ^ ys
|
||||
- -> Q Exp
|
||||
-buildCaller runHandler dispatcher fixHandler xrest parents name resDisp ys = do
|
||||
- master <- newName "master"
|
||||
- sub <- newName "sub"
|
||||
- toMaster <- newName "toMaster"
|
||||
- app404 <- newName "_app404"
|
||||
- handler405 <- newName "_handler405"
|
||||
- method <- newName "_method"
|
||||
-
|
||||
- let pat = map VarP [master, sub, toMaster, app404, handler405, method]
|
||||
-
|
||||
- -- Create the route
|
||||
- let route = routeFromDynamics parents name ys
|
||||
-
|
||||
- exp <-
|
||||
- case resDisp of
|
||||
- Methods _ ms -> do
|
||||
- handler <- newName "handler"
|
||||
-
|
||||
- -- Run the whole thing
|
||||
- runner <- [|$(runHandler)
|
||||
- $(return $ VarE handler)
|
||||
- $(return $ VarE master)
|
||||
- $(return $ VarE sub)
|
||||
- (Just $(return route))
|
||||
- $(return $ VarE toMaster)|]
|
||||
-
|
||||
- let myLet handlerExp =
|
||||
- LetE [FunD handler [Clause [] (NormalB handlerExp) []]] runner
|
||||
-
|
||||
- if null ms
|
||||
- then do
|
||||
- -- Just a single handler
|
||||
- fh <- fixHandler
|
||||
- let he = fh `AppE` foldl' (\a b -> a `AppE` VarE b) (VarE $ mkName $ "handle" ++ name) ys
|
||||
- return $ myLet he
|
||||
- else do
|
||||
- -- Individual methods
|
||||
- mf <- [|Map.lookup $(return $ VarE method) $(return $ VarE $ methodMapName name)|]
|
||||
- f <- newName "f"
|
||||
- let apply = foldl' (\a b -> a `AppE` VarE b) (VarE f) ys
|
||||
- let body405 =
|
||||
- VarE handler405
|
||||
- `AppE` route
|
||||
- return $ CaseE mf
|
||||
- [ Match (ConP 'Just [VarP f]) (NormalB $ myLet apply) []
|
||||
- , Match (ConP 'Nothing []) (NormalB body405) []
|
||||
- ]
|
||||
-
|
||||
- Subsite _ getSub -> do
|
||||
- let sub2 = foldl' (\a b -> a `AppE` VarE b) (VarE (mkName getSub) `AppE` VarE sub) ys
|
||||
- [|$(dispatcher)
|
||||
- $(return $ VarE master)
|
||||
- $(return sub2)
|
||||
- ($(return $ VarE toMaster) . $(return route))
|
||||
- $(return $ VarE app404)
|
||||
- ($(return $ VarE handler405) . $(return route))
|
||||
- $(return $ VarE method)
|
||||
- $(return $ VarE xrest)
|
||||
- |]
|
||||
-
|
||||
- return $ LamE pat exp
|
||||
-
|
||||
--- | Convert a 'Piece' to a 'D.Piece'
|
||||
-convertPiece :: Piece a -> Q Exp
|
||||
-convertPiece (Static s) = [|D.Static (pack $(lift s))|]
|
||||
-convertPiece (Dynamic _) = [|D.Dynamic|]
|
||||
-
|
||||
-routeFromDynamics :: [(String, [(CheckOverlap, Piece a)])] -- ^ parents
|
||||
- -> String -- ^ constructor name
|
||||
- -> [Name]
|
||||
- -> Exp
|
||||
-routeFromDynamics [] name ys = foldl' (\a b -> a `AppE` VarE b) (ConE $ mkName name) ys
|
||||
-routeFromDynamics ((parent, pieces):rest) name ys =
|
||||
- foldl' (\a b -> a `AppE` b) (ConE $ mkName parent) here
|
||||
- where
|
||||
- (here', ys') = splitAt (length $ filter (isDynamic . snd) pieces) ys
|
||||
- isDynamic Dynamic{} = True
|
||||
- isDynamic _ = False
|
||||
- here = map VarE here' ++ [routeFromDynamics rest name ys']
|
||||
diff --git a/Yesod/Routes/TH/Types.hs b/Yesod/Routes/TH/Types.hs
|
||||
index 52cd446..18208d3 100644
|
||||
--- a/Yesod/Routes/TH/Types.hs
|
||||
+++ b/Yesod/Routes/TH/Types.hs
|
||||
@@ -29,10 +29,6 @@ instance Functor ResourceTree where
|
||||
fmap f (ResourceLeaf r) = ResourceLeaf (fmap f r)
|
||||
fmap f (ResourceParent a b c) = ResourceParent a (map (second $ fmap f) b) $ map (fmap f) c
|
||||
|
||||
-instance Lift t => Lift (ResourceTree t) where
|
||||
- lift (ResourceLeaf r) = [|ResourceLeaf $(lift r)|]
|
||||
- lift (ResourceParent a b c) = [|ResourceParent $(lift a) $(lift b) $(lift c)|]
|
||||
-
|
||||
data Resource typ = Resource
|
||||
{ resourceName :: String
|
||||
, resourcePieces :: [(CheckOverlap, Piece typ)]
|
||||
@@ -45,9 +41,6 @@ type CheckOverlap = Bool
|
||||
instance Functor Resource where
|
||||
fmap f (Resource a b c) = Resource a (map (second $ fmap f) b) (fmap f c)
|
||||
|
||||
-instance Lift t => Lift (Resource t) where
|
||||
- lift (Resource a b c) = [|Resource $(lift a) $(lift b) $(lift c)|]
|
||||
-
|
||||
data Piece typ = Static String | Dynamic typ
|
||||
deriving Show
|
||||
|
||||
@@ -55,10 +48,6 @@ instance Functor Piece where
|
||||
fmap _ (Static s) = (Static s)
|
||||
fmap f (Dynamic t) = Dynamic (f t)
|
||||
|
||||
-instance Lift t => Lift (Piece t) where
|
||||
- lift (Static s) = [|Static $(lift s)|]
|
||||
- lift (Dynamic t) = [|Dynamic $(lift t)|]
|
||||
-
|
||||
data Dispatch typ =
|
||||
Methods
|
||||
{ methodsMulti :: Maybe typ -- ^ type of the multi piece at the end
|
||||
@@ -74,11 +63,6 @@ instance Functor Dispatch where
|
||||
fmap f (Methods a b) = Methods (fmap f a) b
|
||||
fmap f (Subsite a b) = Subsite (f a) b
|
||||
|
||||
-instance Lift t => Lift (Dispatch t) where
|
||||
- lift (Methods Nothing b) = [|Methods Nothing $(lift b)|]
|
||||
- lift (Methods (Just t) b) = [|Methods (Just $(lift t)) $(lift b)|]
|
||||
- lift (Subsite t b) = [|Subsite $(lift t) $(lift b)|]
|
||||
-
|
||||
resourceMulti :: Resource typ -> Maybe typ
|
||||
resourceMulti Resource { resourceDispatch = Methods (Just t) _ } = Just t
|
||||
resourceMulti _ = Nothing
|
||||
diff --git a/yesod-routes.cabal b/yesod-routes.cabal
|
||||
index eb367b3..dc6a12c 100644
|
||||
--- a/yesod-routes.cabal
|
||||
+++ b/yesod-routes.cabal
|
||||
@@ -23,31 +23,10 @@ library
|
||||
, path-pieces >= 0.1 && < 0.2
|
||||
|
||||
exposed-modules: Yesod.Routes.Dispatch
|
||||
- Yesod.Routes.TH
|
||||
Yesod.Routes.Class
|
||||
- Yesod.Routes.Parse
|
||||
- Yesod.Routes.Overlap
|
||||
- other-modules: Yesod.Routes.TH.Dispatch
|
||||
- Yesod.Routes.TH.RenderRoute
|
||||
Yesod.Routes.TH.Types
|
||||
ghc-options: -Wall
|
||||
|
||||
-test-suite runtests
|
||||
- type: exitcode-stdio-1.0
|
||||
- main-is: main.hs
|
||||
- hs-source-dirs: test
|
||||
- other-modules: Hierarchy
|
||||
-
|
||||
- build-depends: base >= 4.3 && < 5
|
||||
- , yesod-routes
|
||||
- , text >= 0.5 && < 0.12
|
||||
- , HUnit >= 1.2 && < 1.3
|
||||
- , hspec >= 1.3
|
||||
- , containers
|
||||
- , template-haskell
|
||||
- , path-pieces
|
||||
- ghc-options: -Wall
|
||||
-
|
||||
source-repository head
|
||||
type: git
|
||||
location: https://github.com/yesodweb/yesod
|
||||
--
|
||||
1.8.2.rc3
|
||||
|
|
@ -0,0 +1,29 @@
|
|||
From f6bfe8e01d8fe6d129ad3819070aa17934094a0a Mon Sep 17 00:00:00 2001
|
||||
From: foo <foo@bar>
|
||||
Date: Sun, 22 Sep 2013 06:24:09 +0000
|
||||
Subject: [PATCH] export module referenced by TH splices
|
||||
|
||||
---
|
||||
yesod-routes.cabal | 2 +-
|
||||
1 file changed, 1 insertion(+), 1 deletion(-)
|
||||
|
||||
diff --git a/yesod-routes.cabal b/yesod-routes.cabal
|
||||
index 0b245f2..a97582a 100644
|
||||
--- a/yesod-routes.cabal
|
||||
+++ b/yesod-routes.cabal
|
||||
@@ -27,11 +27,11 @@ library
|
||||
Yesod.Routes.Class
|
||||
Yesod.Routes.Parse
|
||||
Yesod.Routes.Overlap
|
||||
+ Yesod.Routes.TH.Types
|
||||
other-modules: Yesod.Routes.TH.Dispatch
|
||||
Yesod.Routes.TH.RenderRoute
|
||||
Yesod.Routes.TH.ParseRoute
|
||||
Yesod.Routes.TH.RouteAttrs
|
||||
- Yesod.Routes.TH.Types
|
||||
ghc-options: -Wall
|
||||
|
||||
test-suite runtests
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,174 +0,0 @@
|
|||
From 476414b04064bb66fc25ba9ca426c309fe5c156e Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Mon, 15 Apr 2013 12:48:13 -0400
|
||||
Subject: [PATCH] remove TH
|
||||
|
||||
---
|
||||
Yesod/Static.hs | 121 ----------------------------------------------
|
||||
dist/package.conf.inplace | 3 +-
|
||||
2 files changed, 2 insertions(+), 122 deletions(-)
|
||||
|
||||
diff --git a/Yesod/Static.hs b/Yesod/Static.hs
|
||||
index e8ca09f..193b1f0 100644
|
||||
--- a/Yesod/Static.hs
|
||||
+++ b/Yesod/Static.hs
|
||||
@@ -1,5 +1,3 @@
|
||||
-{-# LANGUAGE QuasiQuotes #-}
|
||||
-{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
@@ -34,11 +32,6 @@ module Yesod.Static
|
||||
-- * Smart constructor
|
||||
, static
|
||||
, staticDevel
|
||||
- , embed
|
||||
- -- * Template Haskell helpers
|
||||
- , staticFiles
|
||||
- , staticFilesList
|
||||
- , publicFiles
|
||||
-- * Hashing
|
||||
, base64md5
|
||||
#ifdef TEST_EXPORT
|
||||
@@ -50,7 +43,6 @@ import Prelude hiding (FilePath)
|
||||
import qualified Prelude
|
||||
import System.Directory
|
||||
import Control.Monad
|
||||
-import Data.FileEmbed (embedDir)
|
||||
|
||||
import Yesod.Core hiding (lift)
|
||||
|
||||
@@ -111,18 +103,6 @@ staticDevel dir = do
|
||||
hashLookup <- cachedETagLookupDevel dir
|
||||
return $ Static $ webAppSettingsWithLookup (F.decodeString dir) hashLookup
|
||||
|
||||
--- | Produce a 'Static' based on embedding all of the static
|
||||
--- files' contents in the executable at compile time.
|
||||
--- Nota Bene: if you replace the scaffolded 'static' call in Settings/StaticFiles.hs
|
||||
--- you will need to change the scaffolded addStaticContent. Otherwise, some of your
|
||||
--- assets will be 404'ed. This is because by default yesod will generate compile those
|
||||
--- assets to @static/tmp@ which for 'static' is fine since they are served out of the
|
||||
--- directory itself. With embedded static, that will not work.
|
||||
--- You can easily change @addStaticContent@ to @\_ _ _ -> return Nothing@ as a workaround.
|
||||
--- This will cause yesod to embed those assets into the generated HTML file itself.
|
||||
-embed :: Prelude.FilePath -> Q Exp
|
||||
-embed fp = [|Static (embeddedSettings $(embedDir fp))|]
|
||||
-
|
||||
instance RenderRoute Static where
|
||||
-- | A route on the static subsite (see also 'staticFiles').
|
||||
--
|
||||
@@ -167,59 +147,6 @@ getFileListPieces = flip go id
|
||||
dirs' <- mapM (\f -> go (fullPath f) (front . (:) f)) dirs
|
||||
return $ concat $ files' : dirs'
|
||||
|
||||
--- | Template Haskell function that automatically creates routes
|
||||
--- for all of your static files.
|
||||
---
|
||||
--- For example, if you used
|
||||
---
|
||||
--- > staticFiles "static/"
|
||||
---
|
||||
--- and you had files @\"static\/style.css\"@ and
|
||||
--- @\"static\/js\/script.js\"@, then the following top-level
|
||||
--- definitions would be created:
|
||||
---
|
||||
--- > style_css = StaticRoute ["style.css"] []
|
||||
--- > js_script_js = StaticRoute ["js/script.js"] []
|
||||
---
|
||||
--- Note that dots (@.@), dashes (@-@) and slashes (@\/@) are
|
||||
--- replaced by underscores (@\_@) to create valid Haskell
|
||||
--- identifiers.
|
||||
-staticFiles :: Prelude.FilePath -> Q [Dec]
|
||||
-staticFiles dir = mkStaticFiles dir
|
||||
-
|
||||
--- | Same as 'staticFiles', but takes an explicit list of files
|
||||
--- to create identifiers for. The files path given are relative
|
||||
--- to the static folder. For example, to create routes for the
|
||||
--- files @\"static\/js\/jquery.js\"@ and
|
||||
--- @\"static\/css\/normalize.css\"@, you would use:
|
||||
---
|
||||
--- > staticFilesList \"static\" [\"js\/jquery.js\", \"css\/normalize.css\"]
|
||||
---
|
||||
--- This can be useful when you have a very large number of static
|
||||
--- files, but only need to refer to a few of them from Haskell.
|
||||
-staticFilesList :: Prelude.FilePath -> [Prelude.FilePath] -> Q [Dec]
|
||||
-staticFilesList dir fs =
|
||||
- mkStaticFilesList dir (map split fs) "StaticRoute" True
|
||||
- where
|
||||
- split :: Prelude.FilePath -> [String]
|
||||
- split [] = []
|
||||
- split x =
|
||||
- let (a, b) = break (== '/') x
|
||||
- in a : split (drop 1 b)
|
||||
-
|
||||
--- | Same as 'staticFiles', but doesn't append an ETag to the
|
||||
--- query string.
|
||||
---
|
||||
--- Using 'publicFiles' will speed up the compilation, since there
|
||||
--- won't be any need for hashing files during compile-time.
|
||||
--- However, since the ETag ceases to be part of the URL, the
|
||||
--- 'Static' subsite won't be able to set the expire date too far
|
||||
--- on the future. Browsers still will be able to cache the
|
||||
--- contents, however they'll need send a request to the server to
|
||||
--- see if their copy is up-to-date.
|
||||
-publicFiles :: Prelude.FilePath -> Q [Dec]
|
||||
-publicFiles dir = mkStaticFiles' dir "StaticRoute" False
|
||||
-
|
||||
|
||||
mkHashMap :: Prelude.FilePath -> IO (M.Map F.FilePath S8.ByteString)
|
||||
mkHashMap dir = do
|
||||
@@ -262,54 +189,6 @@ cachedETagLookup dir = do
|
||||
etags <- mkHashMap dir
|
||||
return $ (\f -> return $ M.lookup f etags)
|
||||
|
||||
-mkStaticFiles :: Prelude.FilePath -> Q [Dec]
|
||||
-mkStaticFiles fp = mkStaticFiles' fp "StaticRoute" True
|
||||
-
|
||||
-mkStaticFiles' :: Prelude.FilePath -- ^ static directory
|
||||
- -> String -- ^ route constructor "StaticRoute"
|
||||
- -> Bool -- ^ append checksum query parameter
|
||||
- -> Q [Dec]
|
||||
-mkStaticFiles' fp routeConName makeHash = do
|
||||
- fs <- qRunIO $ getFileListPieces fp
|
||||
- mkStaticFilesList fp fs routeConName makeHash
|
||||
-
|
||||
-mkStaticFilesList
|
||||
- :: Prelude.FilePath -- ^ static directory
|
||||
- -> [[String]] -- ^ list of files to create identifiers for
|
||||
- -> String -- ^ route constructor "StaticRoute"
|
||||
- -> Bool -- ^ append checksum query parameter
|
||||
- -> Q [Dec]
|
||||
-mkStaticFilesList fp fs routeConName makeHash = do
|
||||
- concat `fmap` mapM mkRoute fs
|
||||
- where
|
||||
- replace' c
|
||||
- | 'A' <= c && c <= 'Z' = c
|
||||
- | 'a' <= c && c <= 'z' = c
|
||||
- | '0' <= c && c <= '9' = c
|
||||
- | otherwise = '_'
|
||||
- mkRoute f = do
|
||||
- let name' = intercalate "_" $ map (map replace') f
|
||||
- routeName = mkName $
|
||||
- case () of
|
||||
- ()
|
||||
- | null name' -> error "null-named file"
|
||||
- | isDigit (head name') -> '_' : name'
|
||||
- | isLower (head name') -> name'
|
||||
- | otherwise -> '_' : name'
|
||||
- f' <- [|map pack $(lift f)|]
|
||||
- let route = mkName routeConName
|
||||
- pack' <- [|pack|]
|
||||
- qs <- if makeHash
|
||||
- then do hash <- qRunIO $ base64md5File $ pathFromRawPieces fp f
|
||||
- [|[(pack "etag", pack $(lift hash))]|]
|
||||
- else return $ ListE []
|
||||
- return
|
||||
- [ SigD routeName $ ConT route
|
||||
- , FunD routeName
|
||||
- [ Clause [] (NormalB $ (ConE route) `AppE` f' `AppE` qs) []
|
||||
- ]
|
||||
- ]
|
||||
-
|
||||
base64md5File :: Prelude.FilePath -> IO String
|
||||
base64md5File = fmap (base64 . encode) . hashFile
|
||||
where encode d = Data.Serialize.encode (d :: MD5)
|
|
@ -0,0 +1,74 @@
|
|||
From 8bf7c428a42b984f63f435bb34f22743202ae449 Mon Sep 17 00:00:00 2001
|
||||
From: foo <foo@bar>
|
||||
Date: Sun, 22 Sep 2013 05:24:19 +0000
|
||||
Subject: [PATCH] hacked up for Android
|
||||
|
||||
---
|
||||
Yesod.hs | 2 --
|
||||
Yesod/Default/Util.hs | 17 -----------------
|
||||
2 files changed, 19 deletions(-)
|
||||
|
||||
diff --git a/Yesod.hs b/Yesod.hs
|
||||
index b367144..3050bf5 100644
|
||||
--- a/Yesod.hs
|
||||
+++ b/Yesod.hs
|
||||
@@ -5,9 +5,7 @@ module Yesod
|
||||
( -- * Re-exports from yesod-core
|
||||
module Yesod.Core
|
||||
, module Yesod.Form
|
||||
- , module Yesod.Persist
|
||||
) where
|
||||
|
||||
import Yesod.Core
|
||||
import Yesod.Form
|
||||
-import Yesod.Persist
|
||||
diff --git a/Yesod/Default/Util.hs b/Yesod/Default/Util.hs
|
||||
index a10358e..c5a4e58 100644
|
||||
--- a/Yesod/Default/Util.hs
|
||||
+++ b/Yesod/Default/Util.hs
|
||||
@@ -8,7 +8,6 @@ module Yesod.Default.Util
|
||||
, widgetFileNoReload
|
||||
, widgetFileReload
|
||||
, TemplateLanguage (..)
|
||||
- , defaultTemplateLanguages
|
||||
, WidgetFileSettings
|
||||
, wfsLanguages
|
||||
, wfsHamletSettings
|
||||
@@ -20,9 +19,6 @@ import Yesod.Core -- purposely using complete import so that Haddock will see ad
|
||||
import Control.Monad (when, unless)
|
||||
import System.Directory (doesFileExist, createDirectoryIfMissing)
|
||||
import Language.Haskell.TH.Syntax
|
||||
-import Text.Lucius (luciusFile, luciusFileReload)
|
||||
-import Text.Julius (juliusFile, juliusFileReload)
|
||||
-import Text.Cassius (cassiusFile, cassiusFileReload)
|
||||
import Text.Hamlet (HamletSettings, defaultHamletSettings)
|
||||
import Data.Maybe (catMaybes)
|
||||
import Data.Default (Default (def))
|
||||
@@ -69,24 +65,11 @@ data TemplateLanguage = TemplateLanguage
|
||||
, tlReload :: FilePath -> Q Exp
|
||||
}
|
||||
|
||||
-defaultTemplateLanguages :: HamletSettings -> [TemplateLanguage]
|
||||
-defaultTemplateLanguages hset =
|
||||
- [ TemplateLanguage False "hamlet" whamletFile' whamletFile'
|
||||
- , TemplateLanguage True "cassius" cassiusFile cassiusFileReload
|
||||
- , TemplateLanguage True "julius" juliusFile juliusFileReload
|
||||
- , TemplateLanguage True "lucius" luciusFile luciusFileReload
|
||||
- ]
|
||||
- where
|
||||
- whamletFile' = whamletFileWithSettings hset
|
||||
-
|
||||
data WidgetFileSettings = WidgetFileSettings
|
||||
{ wfsLanguages :: HamletSettings -> [TemplateLanguage]
|
||||
, wfsHamletSettings :: HamletSettings
|
||||
}
|
||||
|
||||
-instance Default WidgetFileSettings where
|
||||
- def = WidgetFileSettings defaultTemplateLanguages defaultHamletSettings
|
||||
-
|
||||
widgetFileNoReload :: WidgetFileSettings -> FilePath -> Q Exp
|
||||
widgetFileNoReload wfs x = combine "widgetFileNoReload" x False $ wfsLanguages wfs $ wfsHamletSettings wfs
|
||||
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -0,0 +1,41 @@
|
|||
From 7e815b11f242d6836f9615439e32f9937bf2feaf Mon Sep 17 00:00:00 2001
|
||||
From: foo <foo@bar>
|
||||
Date: Sun, 22 Sep 2013 13:59:34 +0000
|
||||
Subject: [PATCH] hack around missing symbols
|
||||
|
||||
---
|
||||
Yesod.hs | 17 +++++++++++++++++
|
||||
1 file changed, 17 insertions(+)
|
||||
|
||||
diff --git a/Yesod.hs b/Yesod.hs
|
||||
index 3050bf5..fbe309c 100644
|
||||
--- a/Yesod.hs
|
||||
+++ b/Yesod.hs
|
||||
@@ -5,7 +5,24 @@ module Yesod
|
||||
( -- * Re-exports from yesod-core
|
||||
module Yesod.Core
|
||||
, module Yesod.Form
|
||||
+ , insertBy
|
||||
+ , replace
|
||||
+ , deleteBy
|
||||
+ , delete
|
||||
+ , insert
|
||||
+ , Key
|
||||
) where
|
||||
|
||||
import Yesod.Core
|
||||
import Yesod.Form
|
||||
+
|
||||
+-- These symbols are usually imported from persistent,
|
||||
+-- But it is not built on Android. Still export them
|
||||
+-- just so that hiding them will work.
|
||||
+data Key = DummyKey
|
||||
+insertBy = undefined
|
||||
+replace = undefined
|
||||
+deleteBy = undefined
|
||||
+delete = undefined
|
||||
+insert = undefined
|
||||
+
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -1,157 +0,0 @@
|
|||
From 37abd5d34e18d11ff2961f672cf4491471029684 Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Thu, 28 Feb 2013 23:39:18 -0400
|
||||
Subject: [PATCH] hacked up to build on Android
|
||||
|
||||
removing stuff I don't need and stuff removed from other modules
|
||||
---
|
||||
Yesod.hs | 7 ------
|
||||
yesod.cabal | 77 -----------------------------------------------------------
|
||||
2 files changed, 84 deletions(-)
|
||||
|
||||
diff --git a/Yesod.hs b/Yesod.hs
|
||||
index ef9623d..255ab56 100644
|
||||
--- a/Yesod.hs
|
||||
+++ b/Yesod.hs
|
||||
@@ -6,7 +6,6 @@ module Yesod
|
||||
module Yesod.Core
|
||||
, module Yesod.Form
|
||||
, module Yesod.Json
|
||||
- , module Yesod.Persist
|
||||
-- * Running your application
|
||||
, warp
|
||||
, warpDebug
|
||||
@@ -21,19 +20,14 @@ module Yesod
|
||||
, readIntegral
|
||||
-- * Hamlet library
|
||||
-- ** Hamlet
|
||||
- , hamlet
|
||||
- , xhamlet
|
||||
, HtmlUrl
|
||||
, Html
|
||||
, toHtml
|
||||
-- ** Julius
|
||||
- , julius
|
||||
, JavascriptUrl
|
||||
, renderJavascriptUrl
|
||||
, toJSON
|
||||
-- ** Cassius/Lucius
|
||||
- , cassius
|
||||
- , lucius
|
||||
, CssUrl
|
||||
, renderCssUrl
|
||||
) where
|
||||
@@ -46,7 +40,6 @@ import Text.Julius
|
||||
|
||||
import Yesod.Form
|
||||
import Yesod.Json
|
||||
-import Yesod.Persist
|
||||
import Control.Monad.IO.Class (liftIO, MonadIO(..))
|
||||
import Control.Monad.Trans.Control (MonadBaseControl)
|
||||
|
||||
diff --git a/yesod.cabal b/yesod.cabal
|
||||
index 741f19a..7566cfb 100644
|
||||
--- a/yesod.cabal
|
||||
+++ b/yesod.cabal
|
||||
@@ -13,7 +13,6 @@ description:
|
||||
The Yesod documentation site <http://www.yesodweb.com/> has much more information, including on the supporting packages mentioned above.
|
||||
category: Web, Yesod
|
||||
stability: Stable
|
||||
-cabal-version: >= 1.6
|
||||
build-type: Simple
|
||||
homepage: http://www.yesodweb.com/
|
||||
|
||||
@@ -28,9 +27,7 @@ extra-source-files:
|
||||
library
|
||||
build-depends: base >= 4.3 && < 5
|
||||
, yesod-core >= 1.1.5 && < 1.2
|
||||
- , yesod-auth >= 1.1 && < 1.2
|
||||
, yesod-json >= 1.1 && < 1.2
|
||||
- , yesod-persistent >= 1.1 && < 1.2
|
||||
, yesod-form >= 1.1 && < 1.3
|
||||
, yesod-default >= 1.1.3 && < 1.2
|
||||
, monad-control >= 0.3 && < 0.4
|
||||
@@ -48,80 +45,6 @@ library
|
||||
exposed-modules: Yesod
|
||||
ghc-options: -Wall
|
||||
|
||||
-executable yesod-ghc-wrapper
|
||||
- main-is: ghcwrapper.hs
|
||||
- build-depends:
|
||||
- base >= 4 && < 5
|
||||
- , Cabal
|
||||
-
|
||||
-executable yesod-ld-wrapper
|
||||
- main-is: ghcwrapper.hs
|
||||
- cpp-options: -DLDCMD
|
||||
- build-depends:
|
||||
- base >= 4 && < 5
|
||||
- , Cabal
|
||||
-executable yesod-ar-wrapper
|
||||
- main-is: ghcwrapper.hs
|
||||
- cpp-options: -DARCMD
|
||||
- build-depends:
|
||||
- base >= 4 && < 5
|
||||
- , Cabal
|
||||
-
|
||||
-executable yesod
|
||||
- if os(windows)
|
||||
- cpp-options: -DWINDOWS
|
||||
- build-depends: base >= 4.3 && < 5
|
||||
- , ghc >= 7.0.3 && < 7.8
|
||||
- , ghc-paths >= 0.1
|
||||
- , parsec >= 2.1 && < 4
|
||||
- , text >= 0.11
|
||||
- , shakespeare-text >= 1.0 && < 1.1
|
||||
- , shakespeare >= 1.0.2 && < 1.1
|
||||
- , shakespeare-js >= 1.0.2 && < 1.2
|
||||
- , shakespeare-css >= 1.0.2 && < 1.1
|
||||
- , bytestring >= 0.9.1.4
|
||||
- , time >= 1.1.4
|
||||
- , template-haskell
|
||||
- , directory >= 1.0
|
||||
- , Cabal
|
||||
- , unix-compat >= 0.2 && < 0.5
|
||||
- , containers >= 0.2
|
||||
- , attoparsec >= 0.10
|
||||
- , http-types >= 0.7
|
||||
- , blaze-builder >= 0.2.1.4 && < 0.4
|
||||
- , filepath >= 1.1
|
||||
- , process
|
||||
- , zlib >= 0.5 && < 0.6
|
||||
- , tar >= 0.4 && < 0.5
|
||||
- , system-filepath >= 0.4 && < 0.5
|
||||
- , system-fileio >= 0.3 && < 0.4
|
||||
- , unordered-containers
|
||||
- , yaml >= 0.8 && < 0.9
|
||||
- , optparse-applicative >= 0.4
|
||||
- , fsnotify >= 0.0 && < 0.1
|
||||
- , split >= 0.2 && < 0.3
|
||||
- , file-embed
|
||||
- , conduit >= 0.5 && < 0.6
|
||||
- , resourcet >= 0.3 && < 0.5
|
||||
- , base64-bytestring
|
||||
- , lifted-base
|
||||
- , http-reverse-proxy >= 0.1.1
|
||||
- , network
|
||||
- , http-conduit
|
||||
- , network-conduit
|
||||
- , project-template >= 0.1.1
|
||||
-
|
||||
- ghc-options: -Wall -threaded
|
||||
- main-is: main.hs
|
||||
- other-modules: Scaffolding.Scaffolder
|
||||
- Devel
|
||||
- Build
|
||||
- GhcBuild
|
||||
- Keter
|
||||
- AddHandler
|
||||
- Paths_yesod
|
||||
- Options
|
||||
-
|
||||
source-repository head
|
||||
type: git
|
||||
location: https://github.com/yesodweb/yesod
|
||||
--
|
||||
1.7.10.4
|
||||
|
|
@ -30,19 +30,6 @@ index fe851e6..c6168f4 100644
|
|||
c_deflateInit2_ z a b c d e versionStr (#{const sizeof(z_stream)} :: CInt)
|
||||
|
||||
foreign import ccall unsafe "zlib.h deflateSetDictionary"
|
||||
diff --git a/zlib.cabal b/zlib.cabal
|
||||
index f2d1f5d..751bfab 100644
|
||||
--- a/zlib.cabal
|
||||
+++ b/zlib.cabal
|
||||
@@ -36,7 +36,7 @@ library
|
||||
other-modules: Codec.Compression.Zlib.Stream
|
||||
extensions: CPP, ForeignFunctionInterface
|
||||
build-depends: base >= 3 && < 5,
|
||||
- bytestring >= 0.9 && < 0.12
|
||||
+ bytestring >= 0.10.3.0
|
||||
includes: zlib.h
|
||||
ghc-options: -Wall
|
||||
if !os(windows)
|
||||
--
|
||||
1.7.10.4
|
||||
|
||||
|
|
|
@ -1,24 +1,20 @@
|
|||
#!/bin/sh
|
||||
#!/bin/bash
|
||||
# Bootstraps from an empty cabal to all the necessary haskell packages
|
||||
# being installed, with the necessary patches to work on Android.
|
||||
#
|
||||
# Packages are installed at specific versions we have patches for. Newer
|
||||
# versions often break cross-compilation by adding TH, etc.
|
||||
#
|
||||
# Needs some extra C libraries to be installed inside the cross-compiler
|
||||
# lib directory: libgnutls libxml2
|
||||
# You should install ghc-android first.
|
||||
#
|
||||
# When run with "native" as a parameter, the same versions are installed
|
||||
# in the host system. This is needed in order to use the EvilSplicer to
|
||||
# expand Template Haskell.
|
||||
# Note that the newest version of packages is installed.
|
||||
# It attempts to reuse patches for older versions, but
|
||||
# new versions of packages often break cross-compilation by adding TH,
|
||||
# etc
|
||||
|
||||
# lib dir
|
||||
set -e
|
||||
|
||||
if [ "$1" ]; then
|
||||
mode="$1"
|
||||
shift 1
|
||||
if [ ! -d haskell-patches ]; then
|
||||
cd standalone/android
|
||||
fi
|
||||
|
||||
cabalopts="$@"
|
||||
|
||||
cabalinstall () {
|
||||
|
@ -28,36 +24,32 @@ cabalinstall () {
|
|||
|
||||
patched () {
|
||||
pkg=$1
|
||||
version=$2
|
||||
if [ "$native" ]; then
|
||||
cabalinstall --force-reinstalls $pkg-$version
|
||||
else
|
||||
shift 2
|
||||
cabal unpack $pkg-$version
|
||||
cd $pkg-$version
|
||||
for patch in ../../haskell-patches/${pkg}_*; do
|
||||
echo applying $patch
|
||||
patch -p1 < $patch
|
||||
done
|
||||
cabalinstall "$@"
|
||||
cd ..
|
||||
fi
|
||||
}
|
||||
|
||||
unpatched () {
|
||||
shift 1
|
||||
cabal unpack $pkg
|
||||
cd $pkg*
|
||||
git init
|
||||
git config user.name dummy
|
||||
git config user.email dummy@example.com
|
||||
git add .
|
||||
git commit -m "pre-patched state of $pkg"
|
||||
for patch in ../../haskell-patches/${pkg}_*; do
|
||||
echo trying $patch
|
||||
if ! patch -p1 < $patch; then
|
||||
echo "failed to apply $patch"
|
||||
echo "please resolve this, replace the patch with a new version, and exit the subshell to continue"
|
||||
$SHELL
|
||||
fi
|
||||
done
|
||||
cabalinstall "$@"
|
||||
rm -rf $pkg*
|
||||
cd ..
|
||||
}
|
||||
|
||||
onlycross () {
|
||||
if [ ! "$native" ]; then
|
||||
eval "$@"
|
||||
fi
|
||||
}
|
||||
|
||||
onlynative () {
|
||||
if [ "$native" ]; then
|
||||
eval "$@"
|
||||
fi
|
||||
installgitannexdeps () {
|
||||
pushd ../..
|
||||
echo cabal install --only-dependencies
|
||||
cabal install --only-dependencies "$@"
|
||||
popd
|
||||
}
|
||||
|
||||
install_pkgs () {
|
||||
|
@ -65,145 +57,61 @@ install_pkgs () {
|
|||
mkdir tmp
|
||||
cd tmp
|
||||
|
||||
onlycross unpatched bytestring-0.10.3.0 text-0.11.3.1 parsec-3.1.3
|
||||
patched network 2.4.1.0
|
||||
unpatched cereal-0.3.5.2
|
||||
patched socks 0.4.2
|
||||
unpatched hslogger-1.2.1
|
||||
patched MissingH 1.2.0.0
|
||||
patched unix-time 0.1.4
|
||||
patched async 2.0.1.4
|
||||
patched zlib 0.5.4.0
|
||||
patched primitive 0.5.0.1
|
||||
patched vector 0.10.0.1
|
||||
patched distributive 0.3
|
||||
unpatched hashable-1.1.2.5
|
||||
patched case-insensitive 0.4.0.1
|
||||
unpatched nats-0.1 semigroups-0.9 tagged-0.4.4 comonad-3.0.1.1 comonad-transformers-3.0.1
|
||||
patched profunctors 3.3
|
||||
patched split 0.2.1.2
|
||||
unpatched monads-tf-0.1.0.1
|
||||
onlycross patched gnutls 0.1.4
|
||||
unpatched attoparsec-0.10.4.0 blaze-builder-0.3.1.1
|
||||
patched syb 0.3.7
|
||||
patched aeson 0.6.1.0
|
||||
patched lifted-base 0.2.0.2
|
||||
patched resourcet 0.4.4
|
||||
patched monad-control 0.3.1.4
|
||||
unpatched conduit-0.5.6
|
||||
patched monad-logger 0.2.3.2
|
||||
unpatched reflection-1.1.7 bifunctors-3.2 semigroupoids-3.0.2
|
||||
unpatched bifunctors-3.2 comonads-fd-3.0.1 groupoids-3.0.1.1
|
||||
unpatched profunctor-extras-3.3
|
||||
patched lens 3.8.5
|
||||
unpatched xml-types-0.3.3
|
||||
patched libxml-sax 0.7.3
|
||||
patched network-conduit 0.6.2.2
|
||||
unpatched asn1-data-0.7.1 asn1-types-0.1.3 attoparsec-conduit-0.5.0.3
|
||||
unpatched blaze-builder-conduit-0.5.0.3 blaze-markup-0.5.1.5 blaze-html-0.5.1.3
|
||||
patched cipher-aes 0.1.7
|
||||
unpatched crypto-api-0.10.2
|
||||
unpatched cprng-aes-0.3.4
|
||||
unpatched http-types-0.8.0 mime-types-0.1.0.3
|
||||
patched certificate 1.3.7
|
||||
unpatched system-fileio-0.3.11 tls-1.1.2
|
||||
unpatched utf8-string-0.3.7
|
||||
unpatched publicsuffixlist-0.1
|
||||
unpatched xml-conduit-1.0.3.3
|
||||
unpatched zlib-bindings-0.1.1.3 zlib-conduit-0.5.0.3
|
||||
patched shakespeare 1.0.3
|
||||
patched hamlet 1.1.6.1
|
||||
patched xml-hamlet 0.4.0.3
|
||||
unpatched certificate-1.3.7
|
||||
unpatched dataenc-0.12 hxt-charproperties-9.1.1 \
|
||||
hxt-regex-xmlschema-9.1.0 hxt-unicode-9.0.2 hxt-9.3.1.1
|
||||
unpatched -f-templateHaskell QuickCheck-2.5.1.1
|
||||
unpatched Crypto-4.2.5.1
|
||||
patched HTTP 4000.2.8
|
||||
patched hS3 0.5.7
|
||||
patched file-embed 0.0.4.7
|
||||
patched gsasl 0.3.5 \
|
||||
--ghc-options=-I$HOME/.ghc/android-14/arm-linux-androideabi-4.7/arm-linux-androideabi/sysroot/usr/include/ \
|
||||
--ld-options="-L$HOME/.ghc/android-14/arm-linux-androideabi-4.7/arm-linux-androideabi/sysroot/usr/lib/"
|
||||
onlycross patched network-protocol-xmpp 0.4.4
|
||||
onlynative network-protocol-xmpp
|
||||
patched shakespeare-css 1.0.2
|
||||
patched shakespeare-i18n 1.0.0.2
|
||||
patched shakespeare-js 1.1.2
|
||||
patched persistent 1.1.5.1
|
||||
onlycross unpatched largeword-1.0.4 crypto-api-0.10.2 http-date-0.0.4 \
|
||||
cryptohash-0.8.3 vault-0.2.0.4 unix-compat-0.4.1.1 \
|
||||
crypto-conduit-0.4.3 wai-1.3.0.3
|
||||
patched wai-app-static 1.3.1
|
||||
onlycross patched wai-extra 1.3.2.1
|
||||
patched yesod-routes 1.1.2
|
||||
onlycross unpatched http-conduit-1.8.7.1
|
||||
onlycross patched DAV 0.3
|
||||
onlynative unpatched DAV
|
||||
patched yesod-core 1.1.8
|
||||
patched yesod-persistent 1.1.0.1
|
||||
patched yesod-form 1.2.1.1
|
||||
onlycross unpatched warp-1.3.7.2 yaml-0.8.2
|
||||
patched yesod-default 1.1.3.2
|
||||
patched yesod 1.1.8
|
||||
patched yesod-static 1.1.2
|
||||
unpatched ifelse-0.85
|
||||
unpatched SafeSemaphore-0.9.0
|
||||
if [ ! "$native" ]; then cabal install bloomfilter-1.2.6.10 --constraint 'bytestring >= 0.10.3.0'; fi
|
||||
onlynative unpatched bloomfilter-1.2.6.10
|
||||
unpatched edit-distance-0.2.1.2
|
||||
unpatched uuid-1.2.12
|
||||
unpatched json-0.7
|
||||
unpatched SHA-1.6.1
|
||||
onlycross unpatched data-endian-0.0.1
|
||||
unpatched hinotify-0.3.5
|
||||
patched iproute 1.2.11
|
||||
unpatched dns 0.3.6
|
||||
|
||||
patched network
|
||||
patched unix-time
|
||||
patched lifted-base
|
||||
patched zlib
|
||||
patched process
|
||||
patched MissingH
|
||||
patched bloomfilter
|
||||
patched SafeSemaphore
|
||||
patched unordered-containers
|
||||
patched comonad
|
||||
patched HTTP
|
||||
patched MonadCatchIO-transformers
|
||||
patched distributive
|
||||
patched iproute
|
||||
patched primitive
|
||||
patched socks
|
||||
patched entropy
|
||||
patched vector
|
||||
patched persistent
|
||||
patched profunctors
|
||||
patched skein
|
||||
patched lens
|
||||
patched persistent-template
|
||||
patched file-embed
|
||||
patched wai-app-static
|
||||
patched shakespeare
|
||||
patched hamlet
|
||||
patched shakespeare-css
|
||||
patched shakespeare-js
|
||||
patched yesod-routes
|
||||
patched yesod-core
|
||||
patched yesod-persistent
|
||||
patched yesod-form
|
||||
patched yesod-auth
|
||||
patched yesod
|
||||
patched async
|
||||
patched gnuidn
|
||||
patched DAV
|
||||
|
||||
cd ..
|
||||
rm -rf tmp
|
||||
|
||||
installgitannexdeps -fAndroid -f-Pairing
|
||||
}
|
||||
|
||||
native_install () {
|
||||
echo "Native install"
|
||||
native=1
|
||||
if [ ! -e $HOME/.cabal/packages/hackage.haskell.org ]; then
|
||||
cabal update
|
||||
fi
|
||||
install_pkgs
|
||||
}
|
||||
echo
|
||||
echo
|
||||
echo native build
|
||||
echo
|
||||
cabal update
|
||||
installgitannexdeps
|
||||
|
||||
cross_path () {
|
||||
PATH=$HOME/.ghc/android-14/arm-linux-androideabi-4.7/bin:$HOME/.ghc/android-14/arm-linux-androideabi-4.7/arm-linux-androideabi/bin:$PATH
|
||||
}
|
||||
|
||||
cross_install () {
|
||||
echo "Cross install"
|
||||
native=
|
||||
cross_path
|
||||
if [ ! -e $HOME/.ghc/android-14/arm-linux-androideabi-4.7/cabal/packages/hackage.haskell.org ]; then
|
||||
cabal update
|
||||
fi
|
||||
install_pkgs
|
||||
}
|
||||
|
||||
case "$mode" in
|
||||
native)
|
||||
native_install
|
||||
;;
|
||||
cross)
|
||||
cross_install
|
||||
;;
|
||||
cleancross)
|
||||
# cross install, first removing all currently installed
|
||||
# packages except those part of ghc
|
||||
rm -f $(grep -l $HOME/.ghc/android-14/arm-linux-androideabi-4.7/.cabal/lib/ $HOME/.ghc/android-14/arm-linux-androideabi-4.7/lib/ghc-*/package.conf.d/*.conf)
|
||||
cross_path
|
||||
ghc-pkg recache
|
||||
cross_install
|
||||
;;
|
||||
"")
|
||||
cross_install
|
||||
native_install
|
||||
;;
|
||||
esac
|
||||
echo
|
||||
echo
|
||||
echo cross build
|
||||
echo
|
||||
PATH=$HOME/.ghc/android-14/arm-linux-androideabi-4.7/bin:$HOME/.ghc/android-14/arm-linux-androideabi-4.7/arm-linux-androideabi/bin:$PATH
|
||||
cabal update
|
||||
install_pkgs
|
||||
|
|
Loading…
Reference in a new issue