packages feed

git-annex 5.20131213 → 5.20131221

raw patch · 121 files changed

+7554/−3515 lines, 121 files

Files

Annex/CatFile.hs view
@@ -119,7 +119,7 @@  - For command-line git-annex use, that doesn't matter. It's perfectly  - reasonable for things staged in the index after the currently running  - git-annex process to not be noticed by it. However, we do want to see- - what's in the index, since it may have uncommitted changes not in HEAD>+ - what's in the index, since it may have uncommitted changes not in HEAD  -  - For the assistant, this is much more of a problem, since it commits  - files and then needs to be able to immediately look up their keys.
Assistant/Install.hs view
@@ -11,18 +11,18 @@  import Assistant.Common import Assistant.Install.AutoStart-import Assistant.Install.Menu-import Assistant.Ssh import Config.Files import Utility.FileMode import Utility.Shell import Utility.Tmp import Utility.Env+import Utility.SshConfig  #ifdef darwin_HOST_OS import Utility.OSX #else import Utility.FreeDesktop+import Assistant.Install.Menu #endif  standaloneAppBase :: IO (Maybe FilePath)
Assistant/Install/Menu.hs view
@@ -14,10 +14,10 @@ import Utility.FreeDesktop  installMenu :: FilePath -> FilePath -> FilePath -> FilePath -> IO ()-installMenu command menufile iconsrcdir icondir = do #ifdef darwin_HOST_OS-	return ()+installMenu _command _menufile _iconsrcdir _icondir = return () #else+installMenu command menufile iconsrcdir icondir = do 	writeDesktopMenuFile (fdoDesktopMenu command) menufile 	installIcon (iconsrcdir </> "logo.svg") $ 		iconFilePath (iconBaseName ++ ".svg") "scalable" icondir
Assistant/Monad.hs view
@@ -99,7 +99,7 @@ 	liftAnnex :: Annex a -> m a  {- Runs an action in the git-annex monad. Note that the same monad state- - is shared amoung all assistant threads, so only one of these can run at+ - is shared among all assistant threads, so only one of these can run at  - a time. Therefore, long-duration actions should be avoided. -} instance LiftAnnex Assistant where 	liftAnnex a = do
Assistant/Repair.hs view
@@ -129,7 +129,7 @@ 	repairStaleLocks lockfiles 	return $ not $ null lockfiles   where-	findgitfiles = dirContentsRecursiveSkipping (== dropTrailingPathSeparator annexDir) . Git.localGitDir+	findgitfiles = dirContentsRecursiveSkipping (== dropTrailingPathSeparator annexDir) True . Git.localGitDir repairStaleLocks :: [FilePath] -> Assistant () repairStaleLocks lockfiles = go =<< getsizes   where
Assistant/Ssh.hs view
@@ -9,10 +9,10 @@  import Common.Annex import Utility.Tmp-import Utility.UserInfo import Utility.Shell import Utility.Rsync import Utility.FileMode+import Utility.SshConfig import Git.Remote  import Data.Text (Text)@@ -54,11 +54,6 @@ sshOpt :: String -> String -> String sshOpt k v = concat ["-o", k, "=", v] -sshDir :: IO FilePath-sshDir = do-	home <- myHomeDir-	return $ home </> ".ssh"- {- user@host or host -} genSshHost :: Text -> Maybe Text -> String genSshHost host user = maybe "" (\v -> T.unpack v ++ "@") user ++ T.unpack host@@ -228,6 +223,10 @@  -  - Similarly, IdentitiesOnly is set in the ssh config to prevent the  - ssh-agent from forcing use of a different key.+ -+ - Force strict host key checking to avoid repeated prompts+ - when git-annex and git try to access the remote, if its+ - host key has changed.  -} setupSshKeyPair :: SshKeyPair -> SshData -> IO SshData setupSshKeyPair sshkeypair sshdata = do@@ -242,29 +241,22 @@ 	setSshConfig sshdata 		[ ("IdentityFile", "~/.ssh/" ++ sshprivkeyfile) 		, ("IdentitiesOnly", "yes")+		, ("StrictHostKeyChecking", "yes") 		]   where 	sshprivkeyfile = "git-annex" </> "key." ++ mangleSshHostName sshdata 	sshpubkeyfile = sshprivkeyfile ++ ".pub"  {- Fixes git-annex ssh key pairs configured in .ssh/config - - by old versions to set IdentitiesOnly. -}-fixSshKeyPair :: IO ()-fixSshKeyPair = do-	sshdir <- sshDir-	let configfile = sshdir </> "config"-	whenM (doesFileExist configfile) $ do-		ls <- lines <$> readFileStrict configfile-		let ls' = fixSshKeyPair' ls-		when (ls /= ls') $-			viaTmp writeFile configfile $ unlines ls'--{- Strategy: Search for IdentityFile lines in for files with key.git-annex+ - by old versions to set IdentitiesOnly.+ -+ - Strategy: Search for IdentityFile lines with key.git-annex  - in their names. These are for git-annex ssh key pairs.  - Add the IdentitiesOnly line immediately after them, if not already- - present. -}-fixSshKeyPair' :: [String] -> [String]-fixSshKeyPair' = go []+ - present.+ -}+fixSshKeyPairIdentitiesOnly :: IO ()+fixSshKeyPairIdentitiesOnly = changeUserSshConfig $ unlines . go [] . lines   where   	go c [] = reverse c 	go c (l:[])@@ -276,6 +268,20 @@ 		| otherwise = go (l:c) (next:rest)   	indicators = ["IdentityFile", "key.git-annex"] 	fixedline tmpl = takeWhile isSpace tmpl ++ "IdentitiesOnly yes"++{- Add StrictHostKeyChecking to any ssh config stanzas that were written+ - by git-annex. -}+fixUpSshRemotes :: IO ()+fixUpSshRemotes = modifyUserSshConfig (map go)+  where+	go c@(HostConfig h _)+		| "git-annex-" `isPrefixOf` h = fixupconfig c+		| otherwise = c+	go other = other++	fixupconfig c = case findHostConfigKey c "StrictHostKeyChecking" of+		Nothing -> addToHostConfig c "StrictHostKeyChecking" "yes"+		Just _ -> c  {- Setups up a ssh config with a mangled hostname.  - Returns a modified SshData containing the mangled hostname. -}
Assistant/Threads/Committer.hs view
@@ -52,7 +52,7 @@ 			=<< annexDelayAdd <$> Annex.getGitConfig 	waitChangeTime $ \(changes, time) -> do 		readychanges <- handleAdds havelsof delayadd changes-		if shouldCommit time (length readychanges) readychanges+		if shouldCommit False time (length readychanges) readychanges 			then do 				debug 					[ "committing"@@ -94,16 +94,17 @@ 		let len = length changes 		-- See if now's a good time to commit. 		now <- liftIO getCurrentTime-		case (lastcommitsize >= maxCommitSize, shouldCommit now len changes, possiblyrename changes) of+		scanning <- not . scanComplete <$> getDaemonStatus+		case (lastcommitsize >= maxCommitSize, shouldCommit scanning now len changes, possiblyrename changes) of 			(True, True, _) 				| len > maxCommitSize -> -					waitchanges =<< a (changes, now)+					a (changes, now) >>= waitchanges 				| otherwise -> aftermaxcommit changes 			(_, True, False) ->-				waitchanges =<< a (changes, now)+				a (changes, now) >>= waitchanges 			(_, True, True) -> do 				morechanges <- getrelatedchanges changes-				waitchanges =<< a (changes ++ morechanges, now)+				a (changes ++ morechanges, now) >>= waitchanges 			_ -> do 				refill changes 				waitchanges lastcommitsize@@ -199,8 +200,9 @@  - Current strategy: If there have been 10 changes within the past second,  - a batch activity is taking place, so wait for later.  -}-shouldCommit :: UTCTime -> Int -> [Change] -> Bool-shouldCommit now len changes+shouldCommit :: Bool -> UTCTime -> Int -> [Change] -> Bool+shouldCommit scanning now len changes+	| scanning = len >= maxCommitSize 	| len == 0 = False 	| len >= maxCommitSize = True 	| length recentchanges < 10 = True
Assistant/Threads/SanityChecker.hs view
@@ -15,6 +15,7 @@ import Assistant.DaemonStatus import Assistant.Alert import Assistant.Repair+import Assistant.Ssh import qualified Git.LsFiles import qualified Git.Command import qualified Git.Config@@ -52,6 +53,9 @@ 			debug ["no index file; restaging"] 			modifyDaemonStatus_ $ \s -> s { forceRestage = True } 		)++	{- Fix up ssh remotes set up by past versions of the assistant. -}+	liftIO $ fixUpSshRemotes  	{- If there's a startup delay, it's done here. -} 	liftIO $ maybe noop (threadDelaySeconds . Seconds . fromIntegral . durationSeconds) startupdelay
Assistant/Threads/Watcher.hs view
@@ -144,6 +144,11 @@ 		 		modifyDaemonStatus_ $ \s -> s { scanComplete = True } +		-- Ensure that the Committer sees any changes+		-- that it did not process, and acts on them now that+		-- the scan is complete.+		refillChanges =<< getAnyChanges+ 		return (True, r)  {- Hardcoded ignores, passed to the DirWatcher so it can avoid looking
Assistant/WebApp/Configurators/Edit.hs view
@@ -199,7 +199,7 @@ 			let repoInfo = getRepoInfo mremote config 			let repoEncryption = getRepoEncryption mremote config 			$(widgetFile "configurators/edit/repository")-editForm new r@(RepoName _) = page "Edit repository" (Just Configuration) $ do+editForm _new r@(RepoName _) = page "Edit repository" (Just Configuration) $ do 	mr <- liftAnnex (repoIdRemote r) 	let repoInfo = getRepoInfo mr Nothing 	g <- liftAnnex gitRepo@@ -260,7 +260,7 @@   where   	go Nothing = redirect DashboardR 	go (Just rmt) = do-		liftIO fixSshKeyPair+		liftIO fixSshKeyPairIdentitiesOnly 		liftAnnex $ setConfig  			(remoteConfig (Remote.repo rmt) "ignore") 			(Git.Config.boolConfig False)
Assistant/WebApp/DashBoard.hs view
@@ -28,9 +28,8 @@ import Control.Concurrent  {- A display of currently running and queued transfers. -}-transfersDisplay :: Bool -> Widget-transfersDisplay warnNoScript = do-	webapp <- liftH getYesod+transfersDisplay :: Widget+transfersDisplay = do 	current <- liftAssistant $ M.toList <$> getCurrentTransfers 	queued <- take 10 <$> liftAssistant getTransferQueue 	autoUpdate ident NotifierTransfersR (10 :: Int) (10 :: Int)@@ -66,7 +65,7 @@ getTransfersR nid = do 	waitNotifier getTransferBroadcaster nid -	p <- widgetToPageContent $ transfersDisplay False+	p <- widgetToPageContent transfersDisplay 	giveUrlRenderer $ [hamlet|^{pageBody p}|]  {- The main dashboard. -}@@ -74,7 +73,7 @@ dashboard warnNoScript = do 	let repolist = repoListDisplay $ 		mainRepoSelector { nudgeAddMore = True }-	let transferlist = transfersDisplay warnNoScript+	let transferlist = transfersDisplay 	$(widgetFile "dashboard/main")  getDashboardR :: Handler Html@@ -94,7 +93,6 @@ {- Same as DashboardR, except with autorefreshing via meta refresh. -} getNoScriptAutoR :: Handler Html getNoScriptAutoR = page "" (Just DashBoard) $ do-	let ident = NoScriptR 	let delayseconds = 3 :: Int 	let this = NoScriptAutoR 	toWidgetHead $(Hamlet.hamletFile $ hamletTemplate "dashboard/metarefresh")
Build/EvilSplicer.hs view
@@ -199,10 +199,10 @@ applySplices destdir imports splices@(first:_) = do 	let f = splicedFile first 	let dest = (destdir </> f)-	lls <- map (++ "\n") . lines <$> readFileStrict f+	lls <- map (++ "\n") . lines <$> readFileStrictAnyEncoding f 	createDirectoryIfMissing True (parentDir dest) 	let newcontent = concat $ addimports $ expand lls splices-	oldcontent <- catchMaybeIO $ readFileStrict dest+	oldcontent <- catchMaybeIO $ readFileStrictAnyEncoding dest 	when (oldcontent /= Just newcontent) $ do 		putStrLn $ "splicing " ++ f 		writeFile dest newcontent@@ -362,13 +362,16 @@ 	 -     StaticR 	 -     yesod_dispatch_env_a4iDV 	 -     (\ p_a4iE2 r_a4iE3-	 -        -> r_a4iE3 {Network.Wai.pathInfo = p_a4iE2}+	 -        -> 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. 	 -+	 - Note that the { } may be on the same line, or wrapped to next.+	 - 	 - FIXME: This is a hack. lambdaparens could just always add a 	 - layer of parens even when a lambda seems to be in parent. 	 -}@@ -384,11 +387,16 @@ 		string indent 		lambdaarrow <- string "   ->" 		l2 <- restofline+		l3 <- if '{' `elem` l2 && '}' `elem` l2+			then return ""+			else do+				string indent+				restofline 		return $ unlines 			[ indent ++ staticr 			, indent ++ yesod_dispatch_env 			, indent ++ "(" ++ lambdaprefix ++ l1-			, indent ++ lambdaarrow ++ l2 ++ ")"+			, indent ++ lambdaarrow ++ l2 ++ l3 ++ ")" 			]  	restofline = manyTill (noneOf "\n") newline
CHANGELOG view
@@ -1,3 +1,27 @@+git-annex (5.20131221) unstable; urgency=low++  * assistant: Fix OSX-specific bug that caused the startup scan to try to+    follow symlinks to other directories, and add their contents to the annex.+  * assistant: Set StrictHostKeyChecking yes when creating ssh remotes,+    and add it to the configuration for any ssh remotes previously created+    by the assistant. This avoids repeated prompts by ssh if the host key+    changes, instead syncing with such a remote will fail. Closes: #732602+  * Fix test suite to cover lock --force change.+  * Add plumbing-level lookupkey and examinekey commands.+  * find --format: Added hashdirlower, hashdirmixed, keyname, and mtime+    format variables.+  * assistant: Always batch changes found in startup scan.+  * An armel Linux standalone build is now available, which includes the+    webapp.+  * Programs from Linux and OSX standalone builds can now be symlinked+    into a directory in PATH as an alternative installation method, and will+    use readlink to find where the build was unpacked.+  * Include man pages in Linux and OSX standalone builds.+  * Linux standalone build now includes its own glibc and forces the linker to+    use it, to remove dependence on the host glibc.++ -- Joey Hess <joeyh@debian.org>  Sat, 21 Dec 2013 12:00:17 -0400+ git-annex (5.20131213) unstable; urgency=low    * Avoid using git commit in direct mode, since in some situations
+ Command/ExamineKey.hs view
@@ -0,0 +1,27 @@+{- git-annex command+ -+ - Copyright 2013 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Command.ExamineKey where++import Common.Annex+import Command+import qualified Utility.Format+import Command.Find (formatOption, withFormat, showFormatted, keyVars)+import Types.Key++def :: [Command]+def = [noCommit $ noMessages $ withOptions [formatOption] $+	command "examinekey" (paramRepeating paramKey) seek+	SectionPlumbing "prints information from a key"]++seek :: [CommandSeek]+seek = [withFormat $ \f -> withKeys $ start f]++start :: Maybe Utility.Format.Format -> Key -> CommandStart+start format key = do+	showFormatted format (key2file key) (keyVars key)+	stop
Command/Find.hs view
@@ -26,6 +26,9 @@ formatOption :: Option formatOption = Option.field [] "format" paramFormat "control format of output" +withFormat :: (Maybe Utility.Format.Format -> CommandSeek) -> CommandSeek+withFormat = withField formatOption $ return . fmap Utility.Format.gen+ print0Option :: Option print0Option = Option.Option [] ["print0"] (Option.NoArg set) 	"terminate output with null"@@ -33,29 +36,36 @@ 	set = Annex.setField (Option.name formatOption) "${file}\0"  seek :: [CommandSeek]-seek = [withField formatOption formatconverter $ \f ->-		withFilesInGit $ whenAnnexed $ start f]-  where-	formatconverter = return . fmap Utility.Format.gen+seek = [withFormat $ \f -> withFilesInGit $ whenAnnexed $ start f]  start :: Maybe Utility.Format.Format -> FilePath -> (Key, Backend) -> CommandStart start format file (key, _) = do 	-- only files inAnnex are shown, unless the user has requested 	-- others via a limit 	whenM (limited <||> inAnnex key) $-		unlessM (showFullJSON vars) $-			case format of-				Nothing -> liftIO $ putStrLn file-				Just formatter -> liftIO $ putStr $-					Utility.Format.format formatter $-						M.fromList vars+		showFormatted format file $ ("file", file) : keyVars key 	stop++showFormatted :: Maybe Utility.Format.Format -> String -> [(String, String)] -> Annex ()+showFormatted format unformatted vars =+	unlessM (showFullJSON vars) $+		case format of+			Nothing -> liftIO $ putStrLn unformatted+			Just formatter -> liftIO $ putStr $+				Utility.Format.format formatter $+					M.fromList vars++keyVars :: Key -> [(String, String)]+keyVars key =+	[ ("key", key2file key)+	, ("backend", keyBackendName key)+	, ("bytesize", size show)+	, ("humansize", size $ roughSize storageUnits True)+	, ("keyname", keyName key)+	, ("hashdirlower", hashDirLower key)+	, ("hashdirmixed", hashDirMixed key)+	, ("mtime", whenavail show $ keyMtime key)+	]   where-	vars =-		[ ("file", file)-		, ("key", key2file key)-		, ("backend", keyBackendName key)-		, ("bytesize", size show)-		, ("humansize", size $ roughSize storageUnits True)-		]-	size c = maybe "unknown" c $ keySize key+	size c = whenavail c $ keySize key+	whenavail = maybe "unknown"
+ Command/LookupKey.hs view
@@ -0,0 +1,26 @@+{- git-annex command+ -+ - Copyright 2013 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Command.LookupKey where++import Common.Annex+import Command+import Annex.CatFile+import Types.Key++def :: [Command]+def = [notBareRepo $ noCommit $ noMessages $+	command "lookupkey" (paramRepeating paramFile) seek+		SectionPlumbing "looks up key used for file"]++seek :: [CommandSeek]+seek = [withStrings start]++start :: String -> CommandStart+start file = do+	liftIO . maybe exitFailure (putStrLn . key2file) =<< catKeyFile file+	stop
Command/TransferKey.hs view
@@ -1,5 +1,4 @@-{- git-annex command, used internally by old versions of assistant;- - kept around for now so running daemons don't break when upgraded+{- git-annex plumbing command (for use by old assistant, and users)  -  - Copyright 2012 Joey Hess <joey@kitenet.net>  -
Git/AutoCorrect.hs view
@@ -27,7 +27,7 @@ similarityFloor :: Int similarityFloor = 7 -{- Finds inexact matches for the input amoung the choices.+{- Finds inexact matches for the input among the choices.  - Returns an ordered list of good enough matches, or an empty list if  - nothing matches well. -} fuzzymatches :: String -> (c -> String) -> [c] -> [c]
Git/Objects.hs view
@@ -27,7 +27,7 @@ listLooseObjectShas :: Repo -> IO [Sha] listLooseObjectShas r = catchDefaultIO [] $ 	mapMaybe (extractSha . concat . reverse . take 2 . reverse . splitDirectories)-		<$> dirContentsRecursiveSkipping (== "pack") (objectsDir r)+		<$> dirContentsRecursiveSkipping (== "pack") True (objectsDir r)  looseObjectFile :: Repo -> Sha -> FilePath looseObjectFile r sha = objectsDir r </> prefix </> rest
GitAnnex.hs view
@@ -20,6 +20,8 @@ import qualified Command.Move import qualified Command.Copy import qualified Command.Get+import qualified Command.LookupKey+import qualified Command.ExamineKey import qualified Command.FromKey import qualified Command.DropKey import qualified Command.TransferKey@@ -124,6 +126,8 @@ 	, Command.Schedule.def 	, Command.Ungroup.def 	, Command.Vicfg.def+	, Command.LookupKey.def+	, Command.ExamineKey.def 	, Command.FromKey.def 	, Command.DropKey.def 	, Command.TransferKey.def
Logs/PreferredContent.hs view
@@ -76,7 +76,7 @@ 	<$> Annex.Branch.get preferredContentLog  {- This intentionally never fails, even on unparsable expressions,- - because the configuration is shared amoung repositories and newer+ - because the configuration is shared among repositories and newer  - versions of git-annex may add new features. Instead, parse errors  - result in a Matcher that will always succeed. -} makeMatcher :: GroupMap -> M.Map UUID RemoteConfig -> UUID -> String -> FileMatcher
Makefile view
@@ -1,9 +1,11 @@ mans=git-annex.1 git-annex-shell.1 all=git-annex $(mans) docs +CABAL?=cabal # set to "./Setup" if you lack a cabal program GHC?=ghc+ PREFIX?=/usr-CABAL?=cabal # set to "./Setup" if you lack a cabal program+SHAREDIR?=share  # Am I typing :make in vim? Do a fast build. ifdef VIM@@ -34,13 +36,13 @@ 	$(GHC) --make -threaded $@  install-mans: $(mans)-	install -d $(DESTDIR)$(PREFIX)/share/man/man1-	install -m 0644 $(mans) $(DESTDIR)$(PREFIX)/share/man/man1+	install -d $(DESTDIR)$(PREFIX)/$(SHAREDIR)/man/man1+	install -m 0644 $(mans) $(DESTDIR)$(PREFIX)/$(SHAREDIR)/man/man1  install-docs: docs install-mans-	install -d $(DESTDIR)$(PREFIX)/share/doc/git-annex+	install -d $(DESTDIR)$(PREFIX)/$(SHAREDIR)/doc/git-annex 	if [ -d html ]; then \-		rsync -a --delete html/ $(DESTDIR)$(PREFIX)/share/doc/git-annex/html/; \+		rsync -a --delete html/ $(DESTDIR)$(PREFIX)/$(SHAREDIR)/doc/git-annex/html/; \ 	fi  install: build install-docs Build/InstallDesktopFile@@ -99,15 +101,15 @@ 	@cabal upload dist/*.tar.gz  LINUXSTANDALONE_DEST=tmp/git-annex.linux-linuxstandalone: Build/Standalone-	$(MAKE) git-annex-+linuxstandalone:+	$(MAKE) git-annex linuxstandalone-nobuild+linuxstandalone-nobuild: Build/Standalone 	rm -rf "$(LINUXSTANDALONE_DEST)" 	mkdir -p tmp 	cp -R standalone/linux "$(LINUXSTANDALONE_DEST)"-+	 	install -d "$(LINUXSTANDALONE_DEST)/bin"-	cp git-annex "$(LINUXSTANDALONE_DEST)/bin/"+	cp dist/build/git-annex/git-annex "$(LINUXSTANDALONE_DEST)/bin/" 	strip "$(LINUXSTANDALONE_DEST)/bin/git-annex" 	ln -sf git-annex "$(LINUXSTANDALONE_DEST)/bin/git-annex-shell" 	zcat standalone/licences.gz > $(LINUXSTANDALONE_DEST)/LICENSE@@ -120,7 +122,7 @@ 	install -d "$(LINUXSTANDALONE_DEST)/templates" 	 	touch "$(LINUXSTANDALONE_DEST)/libdirs.tmp"-	for lib in $$(ldd "$(LINUXSTANDALONE_DEST)"/bin/* $$(find "$(LINUXSTANDALONE_DEST)"/git-core/ -type f) | grep -v -f standalone/linux/glibc-libs | grep -v "not a dynamic executable" | egrep '^	' | sed 's/^\t//' | sed 's/.*=> //' | cut -d ' ' -f 1 | sort | uniq); do \+	for lib in $$(ldd "$(LINUXSTANDALONE_DEST)"/bin/* $$(find "$(LINUXSTANDALONE_DEST)"/git-core/ -type f) | grep -v "not a dynamic executable" | egrep '^	' | sed 's/^\t//' | sed 's/.*=> //' | cut -d ' ' -f 1 | sort | uniq); do \ 		dir=$$(dirname "$$lib"); \ 		install -d "$(LINUXSTANDALONE_DEST)/$$dir"; \ 		echo "$$dir" >> "$(LINUXSTANDALONE_DEST)/libdirs.tmp"; \@@ -133,6 +135,30 @@ 	sort "$(LINUXSTANDALONE_DEST)/libdirs.tmp" | uniq > "$(LINUXSTANDALONE_DEST)/libdirs" 	rm -f "$(LINUXSTANDALONE_DEST)/libdirs.tmp" +	# Ensure bundle includes all glibc libs, and other support+	# files it loads.+	# XXX Debian specific.+	cd $(LINUXSTANDALONE_DEST) && dpkg -L libc6 | egrep '\.so|gconv'|tar c --files-from=- | tar x++	find $(LINUXSTANDALONE_DEST) -type d -name gconv | head -n 1 | sed 's!$(LINUXSTANDALONE_DEST)/*!!' > $(LINUXSTANDALONE_DEST)/gconvdir+	find $(LINUXSTANDALONE_DEST) | grep ld-linux | head -n 1 | sed 's!$(LINUXSTANDALONE_DEST)/*!!' > $(LINUXSTANDALONE_DEST)/linker+	+	# Install linker shim for each binary. Note that each binary is put+	# in its own separate directory, to avoid eg git looking for+	# binaries in its directory rather than in PATH.+	for file in $$(find "$(LINUXSTANDALONE_DEST)" -type f | grep -v \.so); do \+		if file "$$file" | grep ELF | egrep -q 'executable|shared object' && test -x "$$file"; then \+			base=$$(basename "$$file"); \+			mkdir -p "$(LINUXSTANDALONE_DEST)/shimmed/$$base"; \+			mv "$$file" "$(LINUXSTANDALONE_DEST)/shimmed/$$base/"; \+			echo "#!/bin/sh" > "$$file"; \+			echo "exec \"\$$GIT_ANNEX_LINKER\" --library-path \"\$$GIT_ANNEX_LD_LIBRARY_PATH\" \"\$$GIT_ANNEX_SHIMMED/$$base/$$base\" \"\$$@\"" >> "$$file"; \+			chmod +x "$$file"; \+		fi; \+	done++	$(MAKE) install-mans DESTDIR="$(LINUXSTANDALONE_DEST)"+ 	cd tmp/git-annex.linux && find . -type f > git-annex.MANIFEST 	cd tmp/git-annex.linux && find . -type l >> git-annex.MANIFEST 	cd tmp && tar czf git-annex-standalone-$(shell dpkg --print-architecture).tar.gz git-annex.linux@@ -158,6 +184,11 @@ 	(cd "$(shell git --exec-path)" && tar c .) | (cd "$(OSXAPP_BASE)" && tar x) 	install -d "$(OSXAPP_BASE)/templates" +	# OSX looks in man dir nearby the bin+	$(MAKE) install-mans DESTDIR="$(OSXAPP_BASE)/.." SHAREDIR="" PREFIX=""+	# This file breaks hditul create+	rm -f "$(OSXAPP_BASE)/../man/man1/git-annex-shell.1"+ 	./Build/OSXMkLibs $(OSXAPP_BASE) 	cd $(OSXAPP_DEST) && find . -type f > Contents/MacOS/git-annex.MANIFEST 	cd $(OSXAPP_DEST) && find . -type l >> Contents/MacOS/git-annex.MANIFEST@@ -165,6 +196,34 @@ 	hdiutil create -format UDBZ -srcfolder tmp/build-dmg \ 		-volname git-annex -o tmp/git-annex.dmg +# Must be run on a system with TH supported, and the same+# versions of TH splice generating packages as the arm system installed.+no-th-webapp-stage1: Build/EvilSplicer+	echo "Running throwaway build, to get TH splices.."+	if [ ! -e dist/setup/setup ]; then $(CABAL) configure -f-Production -O0;  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 no-th build tree.."+	./Build/EvilSplicer tmp/splices tmp/dump-splices standalone/no-th/evilsplicer-headers.hs+	rsync -az --exclude tmp --exclude dist . tmp/no-th-tree+# Copy the files with expanded splices to the source tree, but+# only if the existing source file is not newer. (So, if a file+# used to have TH splices but they were removed, it will be newer,+# and not overwritten.)+	cp -uR tmp/splices/* tmp/no-th-tree || true+# Some additional dependencies needed by the expanded splices.+	sed -i 's/^  Build-Depends: /  Build-Depends: yesod-routes, yesod-core, shakespeare-css, shakespeare-js, shakespeare, blaze-markup, file-embed, wai-app-static, /' tmp/no-th-tree/git-annex.cabal+# Avoid warnings due to sometimes unused imports added for the splices.+	sed -i 's/GHC-Options: \(.*\)-Wall/GHC-Options: \1-Wall -fno-warn-unused-imports /i' tmp/no-th-tree/git-annex.cabal++# Run on the arm system, after stage1+no-th-webapp-stage2: +	if [ ! -e tmp/no-th-tree/dist/setup-config ]; then \+		cd tmp/no-th-tree && cabal configure; \+	fi+	cd tmp/no-th-tree && cabal build --ghc-option=-D__NO_TH__+	cd tmp/no-th-tree && $(MAKE) linuxstandalone-nobuild+ ANDROID_FLAGS?= # Cross compile for Android. # Uses https://github.com/neurocyte/ghc-android@@ -174,7 +233,7 @@ 	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.."-	./Build/EvilSplicer tmp/splices tmp/dump-splices standalone/android/evilsplicer-headers.hs+	./Build/EvilSplicer tmp/splices tmp/dump-splices standalone/no-th/evilsplicer-headers.hs 	rsync -az --exclude tmp --exclude dist . tmp/androidtree # Copy the files with expanded splices to the source tree, but # only if the existing source file is not newer. (So, if a file
Seek.hs view
@@ -61,7 +61,7 @@   where 	get p = ifM (isDirectory <$> getFileStatus p) 		( map (\f -> (f, makeRelative (parentDir p) f))-			<$> dirContentsRecursiveSkipping (".git" `isSuffixOf`) p+			<$> dirContentsRecursiveSkipping (".git" `isSuffixOf`) True p 		, return [(p, takeFileName p)] 		)
Test.hs view
@@ -423,7 +423,8 @@ 	-- throws it away 	changecontent annexedfile 	writeFile annexedfile $ content annexedfile ++ "foo"-	git_annex env "lock" [annexedfile] @? "lock failed"+	not <$> git_annex env "lock" [annexedfile] @? "lock failed to fail without --force"+	git_annex env "lock" ["---force", annexedfile] @? "lock --force failed" 	annexed_present annexedfile 	git_annex env "unlock" [annexedfile] @? "unlock failed"		 	unannexed annexedfile
Utility/DirWatcher/FSEvents.hs view
@@ -67,7 +67,9 @@ 			| otherwise = noop 	 	scan d = unless (ignoredPath ignored d) $-		mapM_ go =<< dirContentsRecursive d+		-- Do not follow symlinks when scanning.+		-- This mirrors the inotify startup scan behavior.+		mapM_ go =<< dirContentsRecursiveSkipping (const False) False d 	  where		 		go f 			| ignoredPath ignored f = noop
Utility/DirWatcher/Win32Notify.hs view
@@ -42,7 +42,7 @@ 		runhook h s = maybe noop (\a -> a (filePath evt) s) (h hooks)  	scan d = unless (ignoredPath ignored d) $-		mapM_ go =<< dirContentsRecursive d+		mapM_ go =<< dirContentsRecursiveSkipping (const False) False d 	  where		 		go f 			| ignoredPath ignored f = noop
Utility/Directory.hs view
@@ -35,14 +35,18 @@ dirContents d = map (d </>) . filter (not . dirCruft) <$> getDirectoryContents d  {- Gets files in a directory, and then its subdirectories, recursively,- - and lazily. If the directory does not exist, no exception is thrown,+ - and lazily.+ -+ - Follows symlinks to other subdirectories.+ -+ - When the directory does not exist, no exception is thrown,  - instead, [] is returned. -} dirContentsRecursive :: FilePath -> IO [FilePath]-dirContentsRecursive topdir = dirContentsRecursiveSkipping (const False) topdir+dirContentsRecursive topdir = dirContentsRecursiveSkipping (const False) True topdir  {- Skips directories whose basenames match the skipdir. -}-dirContentsRecursiveSkipping :: (FilePath -> Bool) -> FilePath -> IO [FilePath]-dirContentsRecursiveSkipping skipdir topdir = go [topdir]+dirContentsRecursiveSkipping :: (FilePath -> Bool) -> Bool -> FilePath -> IO [FilePath]+dirContentsRecursiveSkipping skipdir followsubdirsymlinks topdir = go [topdir]   where   	go [] = return [] 	go (dir:dirs)@@ -56,10 +60,18 @@ 	collect files dirs' (entry:entries) 		| dirCruft entry = collect files dirs' entries 		| otherwise = do-			ifM (doesDirectoryExist entry)-				( collect files (entry:dirs') entries-				, collect (entry:files) dirs' entries-				)			+			let skip = collect (entry:files) dirs' entries+			let recurse = collect files (entry:dirs') entries+			ms <- catchMaybeIO $ getSymbolicLinkStatus entry+			case ms of+				(Just s) +					| isDirectory s -> recurse+					| isSymbolicLink s && followsubdirsymlinks ->+						ifM (doesDirectoryExist entry)+							( recurse+							, skip+							)+				_ -> skip  {- Moves one filename to another.  - First tries a rename, but falls back to moving across devices if needed. -}
+ Utility/SshConfig.hs view
@@ -0,0 +1,125 @@+{- ssh config file parsing and modification+ -+ - Copyright 2013 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Utility.SshConfig where++import Common+import Utility.UserInfo+import Utility.Tmp++import Data.Char+import Data.Ord+import Data.Either++data SshConfig+	= GlobalConfig SshSetting+	| HostConfig Host [Either Comment SshSetting]+	| CommentLine Comment+	deriving (Show)++data Comment = Comment Indent String+	deriving (Show)++data SshSetting = SshSetting Indent Key Value+	deriving (Show)++type Indent = String+type Host = String+type Key = String+type Value = String++{- Parses ~/.ssh/config. Comments and indentation are preserved.+ -+ - Note that there is no parse failure. If a line cannot be parsed, it will+ - be taken to be a SshSetting that contains the whole line as the key,+ - and has no value. -}+parseSshConfig :: String -> [SshConfig]+parseSshConfig = go [] . lines+  where+	go c [] = reverse c+	go c (l:ls)+		| iscomment l = collect $ CommentLine $ mkcomment l+		| otherwise = case splitline l of+			(indent, k, v)+				| isHost k -> hoststanza v c [] ls+				| otherwise -> collect $ GlobalConfig $ SshSetting indent k v+	  where+		collect v = go (v:c) ls++	hoststanza host c hc [] = go (HostConfig host (reverse hc):c) []+	hoststanza host c hc (l:ls)+		| iscomment l = hoststanza host c ((Left $ mkcomment l):hc) ls+		| otherwise = case splitline l of+			(indent, k, v)+			 	| isHost k -> hoststanza v+					(HostConfig host (reverse hc):c) [] ls+				| otherwise -> hoststanza host c+					((Right $ SshSetting indent k v):hc) ls++	iscomment l = all isSpace l || "#" `isPrefixOf` (dropWhile isSpace l)++	splitline l = (indent, k, v)+	  where+		(indent, rest) = span isSpace l+		(k, v) = separate isSpace rest+	+	mkcomment l = Comment indent c+	  where+		(indent, c) = span isSpace l++	isHost v = map toLower v == "host"+	+genSshConfig :: [SshConfig] -> String+genSshConfig = unlines . concatMap gen+  where+	gen (CommentLine c) = [comment c]+	gen (GlobalConfig s) = [setting s]+	gen (HostConfig h cs) = ("Host " ++ h) : map (either comment setting) cs++	setting (SshSetting indent k v) = indent ++ k ++ " " ++ v+	comment (Comment indent c) = indent ++ c++findHostConfigKey :: SshConfig -> Key -> Maybe Value+findHostConfigKey (HostConfig _ cs) wantk = go (rights cs) (map toLower wantk)+  where+  	go [] _ = Nothing+	go ((SshSetting _ k v):rest) wantk'+		| map toLower k == wantk' = Just v+		| otherwise = go rest wantk'+findHostConfigKey _ _ = Nothing++{- Adds a particular Key and Value to a HostConfig. -}+addToHostConfig :: SshConfig -> Key -> Value -> SshConfig+addToHostConfig (HostConfig host cs) k v = +	HostConfig host $ Right (SshSetting indent k v) : cs+  where+ 	{- The indent is taken from any existing SshSetting+	 - in the HostConfig (largest indent wins). -}+	indent = fromMaybe "\t" $ headMaybe $ reverse $+		sortBy (comparing length) $ map getindent cs+	getindent (Right (SshSetting i _ _)) = i+	getindent (Left (Comment i _)) = i+addToHostConfig other _ _ = other++modifyUserSshConfig :: ([SshConfig] -> [SshConfig]) -> IO ()+modifyUserSshConfig modifier = changeUserSshConfig $ +	genSshConfig . modifier . parseSshConfig++changeUserSshConfig :: (String -> String) -> IO ()+changeUserSshConfig modifier = do+	sshdir <- sshDir+	let configfile = sshdir </> "config"+	whenM (doesFileExist configfile) $ do+		c <- readFileStrict configfile+		let c' = modifier c+		when (c /= c') $+			viaTmp writeFile configfile c'++sshDir :: IO FilePath+sshDir = do+	home <- myHomeDir+	return $ home </> ".ssh"
Utility/Yesod.hs view
@@ -13,7 +13,7 @@ module Utility.Yesod  	( module Y 	, liftH-#ifndef __ANDROID__+#ifndef __NO_TH__ 	, widgetFile 	, hamletTemplate #endif@@ -28,7 +28,7 @@ #else import Yesod as Y hiding (Html) #endif-#ifndef __ANDROID__+#ifndef __NO_TH__ import Yesod.Default.Util import Language.Haskell.TH.Syntax (Q, Exp) #if MIN_VERSION_yesod_default(1,1,0)@@ -37,7 +37,7 @@ #endif #endif -#ifndef __ANDROID__+#ifndef __NO_TH__ widgetFile :: String -> Q Exp #if ! MIN_VERSION_yesod_default(1,1,0) widgetFile = widgetFileNoReload
debian/changelog view
@@ -1,3 +1,27 @@+git-annex (5.20131221) unstable; urgency=low++  * assistant: Fix OSX-specific bug that caused the startup scan to try to+    follow symlinks to other directories, and add their contents to the annex.+  * assistant: Set StrictHostKeyChecking yes when creating ssh remotes,+    and add it to the configuration for any ssh remotes previously created+    by the assistant. This avoids repeated prompts by ssh if the host key+    changes, instead syncing with such a remote will fail. Closes: #732602+  * Fix test suite to cover lock --force change.+  * Add plumbing-level lookupkey and examinekey commands.+  * find --format: Added hashdirlower, hashdirmixed, keyname, and mtime+    format variables.+  * assistant: Always batch changes found in startup scan.+  * An armel Linux standalone build is now available, which includes the+    webapp.+  * Programs from Linux and OSX standalone builds can now be symlinked+    into a directory in PATH as an alternative installation method, and will+    use readlink to find where the build was unpacked.+  * Include man pages in Linux and OSX standalone builds.+  * Linux standalone build now includes its own glibc and forces the linker to+    use it, to remove dependence on the host glibc.++ -- Joey Hess <joeyh@debian.org>  Sat, 21 Dec 2013 12:00:17 -0400+ git-annex (5.20131213) unstable; urgency=low    * Avoid using git commit in direct mode, since in some situations
debian/control view
@@ -51,6 +51,7 @@ 	libghc-async-dev, 	libghc-http-dev, 	libghc-feed-dev,+	lsof, 	ikiwiki, 	perlmagick, 	git (>= 1:1.8.4),
doc/assistant.mdwn view
@@ -1,6 +1,6 @@ The git-annex assistant creates a synchronised folder on each of your-OSX and Linux  computers, Android devices, removable drives, and-cloud services. The contents of the folder are the same everywhere.+OSX and Linux computers, Android devices, removable drives, NAS appliances,+and cloud services. The contents of the folder are the same everywhere. It's very easy to use, and has all the power of git and git-annex.  ## installation
doc/assistant/release_notes.mdwn view
@@ -1,3 +1,9 @@+## version 5.20131213++The assistant can now be used on Windows! However, it has known problems,+described in [[todo/windows_support]], and should be considered an+alpha-level preview.+ ## version 5.20131127  Starting with this version, when git-annex is installed from a build on
+ doc/bugs/Armel_version_broken_on_Synology_DSM_4.3-3810.mdwn view
@@ -0,0 +1,28 @@+### Please describe the problem.++The armel daily build linked from https://git-annex.branchable.com/install/Linux_standalone/ doesn't seem to work.++When runshell is run as root, it hangs with no output and trying to run git directly from the bin directory gives ++"/git: exec: line 2: : Permission denied:."++When run as an ordinary user, it gives ++"./runshell: line 40: can't create /root/.ssh/git-annex-shell: Permission denied+chmod: /root/.ssh/git-annex-shell: Permission denied"++### What steps will reproduce the problem?++- Login in to NAS as root via SSH+- Download latest daily build via curl+- Untar, chown -R root:root, and CD in to git-annex.linux+- ./runshell or 'cd bin; ./git"++### What version of git-annex are you using? On what operating system?++Synology DSM 4.3-3810 and latest nightly build of git-annex.++> The shimming was broken, causing the hang. [[fixed|done]]+> +> (It looks like you somehow forgot to set HOME when becoming the non-root+> user.) --[[Joey]]
doc/bugs/Endless_SSH_password_prompts.mdwn view
@@ -13,3 +13,22 @@  ### What version of git-annex are you using? On what operating system? 1 Nov 2013 Linux tarball on Ubuntu Raring 13.04++> [[fixed|done]]; assistant now sets `StrictHostKeyChecking yes`+> when creating ssh remotes. It also fixes up any ssh remotes it already+> created to have that setting (unless StrictHostKeyChecking is already+> being set).+> +> So, when the host key changes, syncing with the remote will now fail,+> rather than letting ssh prompt for the y/n response. In the local+> pairing case, this is completely right, when on a different lan+> and it tries to communicate with the wrong host there. OTOH, if the ssh+> key of a ssh server has really changed, the assistant does not currently+> help dealing with that.+> +> Any ssh remotes not set up by the assistant are left as-is, so this +> could still happen if the ssh host key of such a ssh remote changes.+> I'll assume that if someone can set up their ssh remotes at the command+> line, they can also read the dialog box ssh pops up, ignore the +> misleading "passphrase request" in the title, and see that it's actually+> prompting about a host key change. --[[Joey]]
doc/bugs/No_manual_page_on_prebuilt_linux_version.mdwn view
@@ -14,3 +14,5 @@ Fedora 20  `git-annex --version` doesn't work and the webapp tells me Version: 5.20131130-gc25be33++> [[fixed|done]] (OSX too) --[[Joey]]
+ doc/bugs/OSX_build_broken.mdwn view
@@ -0,0 +1,11 @@+### Please describe the problem.++The OSX webapp doesn't start on the current OSX 10.7.5 builds. ++### What steps will reproduce the problem?++Download git-annex from http://downloads.kitenet.net/git-annex/OSX/current/10.7.5_Lion/git-annex.dmg and install it by copying it to Application. Try to launch it then. The result is a message in the system log saying "git-annex unknown command webapp" and then the usage information.++### What version of git-annex are you using? On what operating system?++The current version as downloaded from http://downloads.kitenet.net/git-annex/OSX/current/10.7.5_Lion/git-annex.dmg on OSX 10.7.5
doc/bugs/Old_repository_stuck.mdwn view
@@ -5,5 +5,5 @@ * OS: Ubuntu 12.04.1 LTS 3.2.0-35-generic-pae #55-Ubuntu SMP Wed Dec 5 18:04:39 UTC 2012 i686 i686 i386 GNU/Linux  > This is [[fixed|done]] in git; assuming the repo was showing up-> in the upper-right menu for switching amoung local repositories.+> in the upper-right menu for switching among local repositories. > --[[Joey]]
doc/bugs/Too_many_open_files.mdwn view
@@ -53,3 +53,7 @@  # End of transcript or log. """]]++> This appears to be the same problem as [[Resource_exhausted]],+> so closing as duplicate; please follow up to the other bug report if+> possible. [[done]] --[[Joey]]
+ doc/bugs/__39__Cannot_write_a_repository_there__39___on_Windows.mdwn view
@@ -0,0 +1,26 @@+### Please describe the problem.+When I try to create the repository with the suggested location `C:\Users\bbigras\Desktop\annex\` I get "Cannot write a repository there". I didn't see the program output any errors on the console. [screen capture](http://imgur.com/7ZUqqVQ)++It works if I change the path to `C:\Users\bbigras\annex\`.++### What steps will reproduce the problem?+* run `git annex webapp`+* click `Make Repository`++### What version of git-annex are you using? On what operating system?+[[!format sh """+git-annex version: 5.20131213-g2893b22+build flags: Assistant Webapp Pairing Testsuite S3 WebDAV DNS Feeds Quvi TDFA CryptoHash+key/value backends: SHA256E SHA1E SHA512E SHA224E SHA384E SKEIN256E SKEIN512E SHA256 SHA1 SHA512 SHA224 SHA384 SKEIN256 SKEIN512 WORM URL+remote types: git gcrypt S3 bup directory rsync web webdav glacier hook++git version 1.8.4.msysgit.0+"""]]++Windows 7 64-bit++### Please provide any additional information below.++[[!format sh """+Launching web browser on file://C:\Users\bbigras\AppData\Local\Temp\webapp9924.html+"""]]
+ doc/bugs/feature_request:_addhash.mdwn view
@@ -0,0 +1,29 @@+### Use case 1++I have a big repo using a SHA256E back-end. Along comes a new shiny SKEIN512E back-end and I would like to transition to using that, because it's faster and moves from ridiculously to ludicrously low risk of collisions.++I can set `.gitattributes` to use the new back-end for any new files added, but then I when I import some arbitrary mix of existing and new files to the repo it will not deduplicate any more, it will add all the files under the new hash scheme.++### Use case 2++I have a big repo of files I have added using `addurl --fast`. I download the files, and they are in the repo.++ - I cannot verify later that none of them have been damaged.+ - If I come across an offline collection of some of the files, I cannot easily get them into the annex by a simple import.++### Workaround++In both these cases, what I can do is <del>unlock (maybe?) or unannex (definitely) all of the files, and then re-add them using the new hash</del> <em>use `migrate` to relink the files using the new scheme</em>. In both use cases this means I now risk having duplicates in various clones of the repo, and would have to clean them up with `drop-unused` -- after first having re-copied them from a repo that has them under the new hash <em>or `migrate`d them in each clone using the pre-migration commit; Either way is problematic for special remotes, in particular glacier</em>. I also lose the continuity of the history of that object.++<del>In use case 2 I also lose the URLs of the files and would have to re-add them using `addurl`.</del> <em>This is probably not true when using `migrate`.</em>++... which brings me to the proposed feature.++### addhash++Symmetrical to `addurl`, which in one form can take an existing hashed (or URL-sourced) file and add an URL source to it, `addhash` can take an existing URL-sourced (or hashed) file and add a hash reference to it (given that the file is in the annex so that the hash may be calculated) -- an alias under which it may also be identified, in addition to the existing URL or hash.++ - Any file added to the annex after `addhash` will use the symlink name of the original hash if their hash matches the `addhash`ed one.+ - An `fsck` run will use one of the available hashes to verify the integrity of the file, maybe according to some internal order of preference, or possibly a configurable one.++> [[done]] --[[Joey]]
@@ -0,0 +1,3 @@+I've had a bug report that the assistant follows directory symlinks to elsewhere. I thought it didn't. This needs to be avoided.++[[fixed|done]]
+ doc/bugs/git-repair_real_world_failure_example.mdwn view
@@ -0,0 +1,11 @@+I was given these 2 repos, git-repair fails on the first, and the+second is a backup copy from before the problem:++* <http://www.clacke.se/annex/podcasts.git.tar.xz>+* <http://www.clacke.se/annex/podcasts-bak.git.tar.xz>++--[[Joey]]++> Tested with current version, and it successfully repairs. +> Bug reporter was using an older version (based on some old messages).+> [[done]] --[[Joey]]
+ doc/bugs/git_annex_get___60__file__62___should_verify_file_hash.mdwn view
@@ -0,0 +1,32 @@+### Please describe the problem.+git annex get fileName-  should perform a hash check on the file content before adding to the local repository+++### What steps will reproduce the problem?+Two scenarios:+1) Malicious user and owner of repository being pulled from can edit his/her local .git/annex/objects directory +to alter the file content. For src code, this could be to insert a bug, insert a backdoor, or for example +to replace an image file artifact for a website, with a pornographic image.+The user pulling the file content with "git annex get fileName"  might not be aware of the file contents +until they actually examine the file or perform an fsck or commit locally. +In the meantime a kiddy porn image could be sitting in their repository or a src code backdoor can get incorporated and deployed etc.+2) a file could also simply get corrupted during download. An inherent hash check during the 'annex get' would+point out the problem immediately.+To reproduce:  create repoNum1, and clone it to create repoNum2. manual edit/replace content in repoNum1/.git/annex/objects/...+then perform a 'git annex get <fileName>' from repoNum2 on the file that has been manipulated +++### What version of git-annex are you using? On what operating system?+3.2012112ubuntu2 on running linux mint +++### Please provide any additional information below.++Aside: Thanks Joey - this is fantastic work you are doing. You have really improved git. The ability to checkout +an entire tree - but selectively get only the content actually needed is a real killer feature.+Kudos and again many many thanks+M.+++# End of transcript or log.+"""]]
doc/builds.mdwn view
@@ -6,6 +6,9 @@ <h2>Linux amd64</h2> <iframe width=1024 scrolling=no frameborder=0 marginheight=0 marginwidth=0 src="https://downloads.kitenet.net/git-annex/autobuild/amd64/"> </iframe>+<h2>Linux armel</h2>+<iframe width=1024 scrolling=no frameborder=0 marginheight=0 marginwidth=0 src="https://downloads.kitenet.net/git-annex/autobuild/armel/">+</iframe> <h2>Android</h2> <iframe width=1024 scrolling=no frameborder=0 marginheight=0 marginwidth=0 src="https://downloads.kitenet.net/git-annex/autobuild/android/"> </iframe>
doc/design/assistant/blog/day_199__wrapping_up_Android_for_now.mdwn view
@@ -6,7 +6,7 @@ Today:  * Fixed a nasty regression that made `*` not match files in subdirectories.-  That broke the preferred content handling, amoung other things. I will+  That broke the preferred content handling, among other things. I will   be pushing out a new release soon. * As a last Android thing (for now), made the Android app automatically   run `git annex assistant --autostart` , so you can manually set up
doc/design/assistant/blog/day_312__DebConf_midpoint.mdwn view
@@ -15,7 +15,7 @@ ----  There has been a ton of discussion about git-annex here at DebConf,-including 3 BoF sessions that mostly focused on it, amoung other git stuff.+including 3 BoF sessions that mostly focused on it, among other git stuff. Also, RichiH will be presenting his "[Gitify Your Life](http://penta.debconf.org/dc13_schedule/events/1025.en.html)" talk on Friday; you can catch it on the [live stream](http://blog.debconf.org/blog/2013/08/14#hl_dc13_recordings).
doc/design/assistant/inotify.mdwn view
@@ -12,13 +12,6 @@   See [[bug|bugs/Issue_on_OSX_with_some_system_limits]]. (Does not affect   OSX any longer, only other BSDs). -## todo--* There needs to be a way for a new version of git-annex, when installed,-  to restart any running watch or assistant daemons. Or for the daemons-  to somehow detect it's been upgraded and restart themselves. Needed-  to allow for incompatable changes and, I suppose, for security upgrades..- ## beyond Linux  I'd also like to support OSX and if possible the BSDs.@@ -64,7 +57,52 @@   * <http://pypi.python.org/pypi/MacFSEvents/0.2.8> (good example program)   * <https://github.com/gorakhargosh/watchdog/blob/master/src/watchdog/observers/fsevents.py> (good example program) +  *hfsevents is now supported*+ * Windows has a Win32 ReadDirectoryChangesW, and perhaps other things.++  It was easy to get watching to work in windows. But there is no lsof,+  to check if a file can safely be added. So, need to carefully consider+  how to make adding a file safe in windows.++  Without lsof, an InodeCache is generated in "lockdown" (which doesn't+  do anything to prevent new writers), and is compared with the stat of the+  file after it's ingested (and checksummed). This will detect many changes+  to files, which change the size or mtime.++  So, we have 2 cases to worry about. ++  1. A process has the file open for write as it's added, does not change+     it until the add is done.++     As long as an event is generated once the file does get closed, this+     is fine -- the modified version will be re-added. And such events are+     indeed generated on windows.++  2. A process has the file open for write as it's added, and changes it +     in some way that does not affect size or mtime.++     If an event is generated when the file does get closed, this is the+     same as a scenario where a process opens the file after it's added,+     makes such a change, and closes it. In either case, a file closed+     event is generated, and the Watcher will not detect any change+     using the inode cache, so will not re-add the file.++     So, this scenario is a potential problem, but it seems at least+     unlikely that a program would modify a file without affecting its+     mtime. Note that this same scenario can happen even with lsof, and+     even on linux (although on linux the InodeCache includes an actual+     inode, which might detect the change too).++  Conclusion: It's probably ok to run without lsof on Windows.++  Corrolary: lsof might not generally be needed in direct mode, on+  systems that do generate file close events (but not when+  eventsCoalesce).+  The same arguments given above seem to apply to !Windows. Note that lsof+  is needed in indirect mode, as discussed below.++  **windows is now supported**  ## the races
doc/design/assistant/polls/Android_default_directory.mdwn view
@@ -4,4 +4,4 @@ want the first time they run it, but to save typing on android, anything that gets enough votes will be included in a list of choices as well. -[[!poll open=yes expandable=yes 62 "/sdcard/annex" 6 "Whole /sdcard" 5 "DCIM directory (photos and videos only)" 1 "Same as for regular git-annex. ~/annex/"]]+[[!poll open=yes expandable=yes 63 "/sdcard/annex" 6 "Whole /sdcard" 5 "DCIM directory (photos and videos only)" 1 "Same as for regular git-annex. ~/annex/"]]
doc/design/external_special_remote_protocol.mdwn view
@@ -22,6 +22,10 @@ The protocol is line based. Messages are sent in either direction, from git-annex to the special remote, and from the special remote to git-annex. +In order to avoid confusing interactions, one or the other has control+at any given time, and is responsible for sending requests, while the other+only sends replies to the requests.+ ## example session  The special remote is responsible for sending the first message, indicating@@ -38,9 +42,9 @@ and check that it's valid. git-annex responds with the configuration values  	GETCONFIG directory-	/media/usbdrive/repo+	VALUE /media/usbdrive/repo 	GETCONFIG automount-	true+	VALUE true  Once the special remote is satisfied with its configuration and is ready to go, it tells git-annex.@@ -96,7 +100,7 @@   should be derived from the Key.     Multiple transfers might be requested by git-annex, but it's fine for the    program to serialize them and only do one at a time.-* `HAS Key`  +* `CHECKPRESENT Key`     Requests the remote check if a key is present in it. * `REMOVE Key`     Requests the remote remove a key's contents.@@ -104,10 +108,9 @@ ## special remote replies  These should be sent only in response to the git-annex request messages.-(Any sent unexpectedly will be ignored.) They do not have to be sent immediately after the request; the special-remote can send other messages and queries (listed in sections below)-as it's performing the request.+remote can send its own requests (listed in the next section below)+while it's handling a request.  * `PREPARE-SUCCESS`     Sent as a response to PREPARE once the special remote is ready for use.@@ -115,13 +118,13 @@   Indicates the transfer completed successfully. * `TRANSFER-FAILURE STORE|RETRIEVE Key ErrorMsg`     Indicates the transfer failed.-* `HAS-SUCCESS Key`  +* `CHECKPRESENT-SUCCESS Key`     Indicates that a key has been positively verified to be present in the   remote.-* `HAS-FAILURE Key`  +* `CHECKPRESENT-FAILURE Key`     Indicates that a key has been positively verified to not be present in the   remote.-* `HAS-UNKNOWN Key ErrorMsg`  +* `CHECKPRESENT-UNKNOWN Key ErrorMsg`     Indicates that it is not currently possible to verify if the key is   present in the remote. (Perhaps the remote cannot be contacted.) * `REMOVE-SUCCESS Key`  @@ -143,51 +146,51 @@  ## special remote messages -These are messages the special remote program can send to-git-annex at any time. It should not expect any response from git-annex.+These messages may be sent by the special remote at any time that it's+in control.  * `VERSION Int`     Supported protocol version. Current version is 0. Must be sent first   thing at startup, as until it sees this git-annex does not know how to   talk with the special remote program!-* `ERROR ErrorMsg`  -  Generic error. Can be sent at any time if things get messed up.-  When possible, use a more specific reply from the list above.  -  It would be a good idea to send this if git-annex sends a command-  you do not support. The program should exit after sending this, as-  git-annex will not talk to it any further. * `PROGRESS STORE|RETRIEVE Key Int`     Indicates the current progress of the transfer. May be repeated any   number of times during the transfer process. This is highly recommended-  for STORE. (It is optional but good for RETRIEVE.)--## special remote queries--After git-annex has sent the special remote a request, and before the-special remote sends back a reply, git-annex enters quiet mode. It will-avoid sending additional messages. While git-annex is in quiet mode,-the special remote can send queries to it. Queries can not be sent at any-other time.--When it sees a query, git-annex will respond a line containing-*only* the requested data.-+  for STORE. (It is optional but good for RETRIEVE.)  +  (git-annex does not send a reply to this message.) * `DIRHASH Key`     Gets a two level hash associated with a Key. Something like "abc/def".   This is always the same for any given Key, so can be used for eg,-  creating hash directory structures to store Keys in.+  creating hash directory structures to store Keys in.  +  (git-annex replies with VALUE followed by the value.) * `GETCONFIG Setting`-  Gets one of the special remote's configuration settings.+  Gets one of the special remote's configuration settings.  +  (git-annex replies with VALUE followed by the value.) * `SETSTATE Key Value`     git-annex can store state in the git-annex branch on a-  per-special-remote, per-key basis. This sets that state.+  per-special-remote, per-key basis. This sets that state.  +  (git-annex replies with VALUE followed by the value stored.) * `GETSTATE Key`     Gets any state previously stored for the key from the git-annex branch.     Note that some special remotes may be accessed from multiple   repositories, and the state is only eventually consistently synced   between them. If two repositories set different values in the state-  for a key, the one that sets it last wins.+  for a key, the one that sets it last wins.  +  (git-annex replies with VALUE followed by the value.) +## general messages++These messages can be sent at any time by either git-annex or the special+remote.++* `ERROR ErrorMsg`  +  Generic error. Can be sent at any time if things get messed up.+  When possible, use a more specific reply from the list above.  +  It would be a good idea to send this if git-annex sends a command+  you do not support. The program should exit after sending this, as+  git-annex will not talk to it any further. If the program receives+  an ERROR, it can try to recover, or exit with its own ERROR.+ ## Simple shell example  [[!format sh """@@ -231,9 +234,9 @@ 				 			esac 		;;-		HAS)+		CHECKPRESENT) 			key="$2"-			echo HAS-UNKNOWN "$key" "not implemented"+			echo CHECKPRESENT-UNKNOWN "$key" "not implemented" 		;; 		REMOVE) 			key="$2"@@ -256,5 +259,3 @@   remotes can reconnect. * uuid discovery during initremote. * Support for splitting files into chunks.-* Use same verbs as used in special remote interface (instead of different-  verbs used in Types.Remote).
+ doc/devblog/day_80__plumbing.mdwn view
@@ -0,0 +1,9 @@+Made some improvements to git-annex's plumbing level commands today. Added+new lookupkey and examinekey commands. Also expanded the things that+`git annex find` can report about files. Among other things, the elusive+hash directory locations can now be looked up, which IIRC a few people have+asked for a way to do.++Also did some work on the linux standalone tarball and OSX app. Both now+include man pages, and it's also now possible to just unpack it and symlink+git-annex into ~/bin or similar to add it to PATH.
+ doc/devblog/day_81__more_standalone.mdwn view
@@ -0,0 +1,15 @@+Made the Linux standalone builds more self-contained, now they include+their own linker and glibc, and ugly hacks to make them be used when+running the included programs. This should make them more portable+to older systems.++Set up an arm autobuilder. +This autobuilder runs in an Debian armel chroot, using+qemu-user-static (with a patch to make it support some syscalls ghc uses).+No webapp yet; waiting on feedback of how well it works. I *hope* this+build will be usable on eg, Synology NAS and Raspberry PI.++Also worked on improving the assistant's batching of commits during the+startup scan. And some other followups and bug triage.++Today's work was sponsored by Hamish Coleman.
+ doc/devblog/day_82__rpi_and_synology.mdwn view
@@ -0,0 +1,21 @@+Fixed a few problems in the [[armel build|install/Linux_standalone]], and+it's been confirmed to work on Raspberry Pi and Synology NAS. Since none of+the fixes were specific to those platforms, it will probably work anywhere+the kernel is new enough. That covers 9+% of the +[missing ports in the user survey](http://git-annex-survey.branchable.com/polls/2013/missing_ports/)!++Thought through the possible issues with the assistant on Windows not being+able to use lsof. I've convinced myself it's probably safe. (In fact, it+might be safe to stop checking with lsof when using the assistant in direct+mode entirely.) Also did some testing of some specific interesting+circumstances (including 2 concurrent writers to a single file).++I've been working on adding the webapp to the armel build. This can mostly+reuse the patches and EvilSplicer developed for Android, but it's taking+some babysitting of the build to get yesod etc installer for various reasons.+Will be surprised if I don't get there tomorrow.++One other thing.. I notice that <http://git-annex.org/> is up and running.+This was set up by Subito, who offered me the domain, but I suggested he+keep it and set up a pretty start page that points new users at the+relevant parts of the wiki. I think he's done a good job with that!
+ doc/devblog/day_83__armel_webapp.mdwn view
@@ -0,0 +1,19 @@+Got the arm webapp to build! (I have not tried to run it.) The build+process for this is quite elaborate; 2 chroots, one amd64 and one armel,+with the same versions of everything installed in each, and git-annex is+built in the first to get the info the EvilSplicer needs to build it in the+second.++Fixed a nasty bug in the assistant on OSX, where at startup it would follow+symlinks in the repository that pointed to directories outside the+repository, and add the files found there. Didn't cause data loss itself+(in direct mode the assistant doesn't touch the files), but certainly+confusingly breaks things and makes it easy to shoot your foot off. I will+be moving up the next scheduled release because of this bug, probably to+Saturday.++Looped the git developers in on a problem with git failing on some kernels+due to `RLIMIT_NOFILE` not working. Looks like git will get more robust and+this should make the armel build work on even more embedded devices.++Today's work was sponsored by Johan Herland.
+ doc/forum/Assistant_loosing_advantages__63__.mdwn view
@@ -0,0 +1,10 @@+Hey,++I write an article for the univerity about git-annex assistant and I'm a little bit confused about the function of the assistant. +Because an advantage of git-annex is that you can hold different files at different places in one repository, but this isn't anymore, or? The assistant syncs every file to every place of the repository. And this makes it just to another Dropbox (not direct the same) pentant or I'm not correct?++The transfer group is just for transfer files to other repositories, which are not connected with the network or?++I'm using ppa, ubuntu 12.04 lts, vers, 2013-12-13++JP Lührig
+ doc/forum/Previous_versions_in_direct_mode__63__.mdwn view
@@ -0,0 +1,3 @@+I am in Windows and therefore forced to use direct mode. After reading for a long while I still have not found a way of "git annex get" previous versions. Is this supported? is it only the last version in the repository?++any chance to use indirect mode in Windows? In theory Windows supports NTFS symlinks, why is this not supported?
+ doc/forum/new_linux_arm_tarball_build.mdwn view
@@ -0,0 +1,12 @@+I've added an arm build to the autobuilds in [[install/Linux_standalone]].++I'm curious to see how this works out. I tried to make it as self-contained+as possible. It should work even on systems that do not use glibc, as long+as the kernel is new enough for the glibc included in it, and supports the+arm EABI.++If it seems sufficiently useful, I might try to add the webapp to the+build, which would be somewhat complicated, but doable (since I'm building+using qemu, it can run a build on amd64 first to get the TH splices).++--[[Joey]]
doc/git-annex.mdwn view
@@ -601,7 +601,7 @@   `--format`. The default output format is the same as `--format='${file}\\n'`    These variables are available for use in formats: file, key, backend,-  bytesize, humansize+  bytesize, humansize, keyname, hashdirlower, hashdirmixed, mtime.  * `whereis [path ...]` @@ -727,15 +727,30 @@   point to annexed content. Also handles injecting changes to unlocked   files into the annex. -* `update-hook refname olvrev newrev`+* `lookupkey [file ...]` -  This is meant to be called from git's update hook. `git annex init`-  automatically creates an update hook using this.+  This plumbing-level command looks up the key used for a file in the+  index. The key is output to stdout. If there is no key (because+  the file is not present in the index, or is not a git-annex managed file),+  nothing is output, and it exits nonzero. -  This denies updates being pushed for the currently checked out branch.-  While receive.denyCurrentBranch normally prevents that, it does-  not for fake bare repositories, as used by direct mode.+* `examinekey [key ...]` +  This plumbing-level command is given a key, and prints information+  that can be determined purely by looking at the key.++  To specify what information to print, use `--format`. Or use `--json`+  to get all available information in JSON format.++  The same variables can be used in the format string as can be used in+  the format string of git annex find (except there is no file option+  here).++  For example, the location a key's value is stored (in indirect mode)+  can be looked up by running:+  +        	git annex examinekey --format='.git/annex/objects/${hashdirmixed}${key}/${key}'+ * `fromkey key file`    This plumbing-level command can be used to manually set up a file@@ -753,9 +768,19 @@          	git annex dropkey SHA1-s10-7da006579dd64330eb2456001fd01948430572f2 +* `transferkey`++  This plumbing-level command is used to request a single key be+  transferred. Either the --from or the --to option can be used to specify+  the remote to use. A --file option can be used to hint at the file+  associated with the key.+ * `transferkeys`    This plumbing-level command is used by the assistant to transfer data.+  It is fed instructions about the keys to transfer using an internal+  stdio protocol, which is intentionally not documented (as it may change+  at any time).  * `rekey [file key ...]`
doc/install/Linux_standalone.mdwn view
@@ -2,9 +2,12 @@ you can either build it [[fromscratch]], or you can use a handy prebuilt tarball of the most recent release. -This tarball should work on most Linux systems. It does not depend-on anything except for glibc.+This tarball should work on most Linux systems. It has basically no+dependencies and is self-contained. +The armel version can be installed on NAS devices and other embedded ARM+linux systems.+ [download tarball](https://downloads.kitenet.net/git-annex/linux/current/)  To use, just unpack the tarball, `cd git-annex.linux` and run `./runshell`@@ -12,10 +15,11 @@ as everything else included in the bundle.  Alternatively, you can unpack the tarball, and add the directory to your-`PATH`. This lets you use `git annex`, without overriding your system's+`PATH`, or symlink the programs in the directory to a directory in your+PATH. This lets you use `git annex`, without overriding your system's own versions of git, etc. -Warning: This is a last resort. Most Linux users should instead+Note: This is a last resort. Most Linux users should instead [[install]] git-annex from their distribution of choice.  ## autobuilds@@ -25,10 +29,4 @@  * i386: [download tarball](https://downloads.kitenet.net/git-annex/autobuild/i386/git-annex-standalone-i386.tar.gz) ([build logs](https://downloads.kitenet.net/git-annex/autobuild/i386/)) * amd64: [download tarball](https://downloads.kitenet.net/git-annex/autobuild/amd64/git-annex-standalone-amd64.tar.gz) ([build logs](https://downloads.kitenet.net/git-annex/autobuild/amd64/))--## gitannex-install--Eskild Hustvedt has contributed a-[gitannex-install](https://github.com/zerodogg/scriptbucket/blob/master/gitannex-install)-script to manage keeping up to date with new releases using the standalone-build.+* armel: [download tarball](https://downloads.kitenet.net/git-annex/autobuild/armel/git-annex-standalone-armel.tar.gz) ([build logs](https://downloads.kitenet.net/git-annex/autobuild/armel/))
doc/install/OSX.mdwn view
@@ -34,7 +34,7 @@  <pre> brew update-brew install haskell-platform git ossp-uuid md5sha1sum coreutils libgsasl gnutls libidn libgsasl pkg-config libxml2+brew install haskell-platform git ossp-uuid md5sha1sum coreutils gnutls libidn gsasl pkg-config libxml2 brew link libxml2 --force cabal update mkdir $HOME/bin
doc/install/fromscratch.mdwn view
@@ -53,7 +53,7 @@   * [unix-compat](http://hackage.haskell.org/package/unix-compat)   * [MonadCatchIO-transformers](http://hackage.haskell.org/package/MonadCatchIO-transformers) * Shell commands-  * [git](http://git-scm.com/)+  * [git](http://git-scm.com/) (1.7.2 or newer; 1.8.5 recommended)   * [xargs](http://savannah.gnu.org/projects/findutils/)   * [rsync](http://rsync.samba.org/)   * [curl](http://http://curl.haxx.se/) (optional, but recommended)
doc/internals.mdwn view
@@ -130,3 +130,30 @@ These log files record urls used by the [[web_special_remote|special_remotes/web]]. Their format is similar to the location tracking files, but with urls rather than UUIDs.++## `schedule.log`++Used to record scheduled events, such as periodic fscks.++The file format is simply one line per repository, with the uuid followed by a+space and then its schedule, followed by a timestamp.++There can be multiple events in the schedule, separated by "; "++The format of the scheduled events is the same described in+the SCHEDULED JOBS section of the man page.++Example:++	42bf2035-0636-461d-a367-49e9dfd361dd fsck self 30m every day at any time; fsck 4b3ebc86-0faf-4892-83c5-ce00cbe30f0a 1h every year at any time timestamp=1385646997.053162s++## `transitions.log`++Used to record transitions, eg by `git annex forget`++Each line of the file is a transition, followed by a timestamp.++Example:++	ForgetGitHistory 1387325539.685136s+	ForgetDeadRemotes 1387325539.685136s
doc/internals/hashing.mdwn view
@@ -2,10 +2,18 @@ hash directories are used, to avoid issues with too many files in one directory. -Two separate hash methods are used. One, the old hash format, is only used-for non-bare git repositories. The other, the new hash format, is used for-bare git repositories, the git-annex branch, and on special remotes as-well.+Two separate hash methods are used. ++* hashdirmixed is only used for non-bare git repositories.+  (We'd like to stop using this, but it'd be too annoying to change+  all the git-annex symlinks!)++* hashdirlower is used for bare git repositories, the +  git-annex branch, and on special remotes as well.++Note that `git annex find` and `git annex examinekey` can be used with+the `--format` option to find the hash directories. The explanation+below is only for completeness.  ## new hash format
doc/internals/key_format.mdwn view
@@ -18,3 +18,6 @@   This is currently only used by the WORM backend. * Other fields could be added in the future, if needed. * Fields may appear, in any order (though always before the name field).++The `git annex examinekey` command can be used to extract information from+a key.
− doc/news/version_5.20131118.mdwn 
@@ -1,42 +0,0 @@-git-annex 5.20131118 released with [[!toggle text="these changes"]]-[[!toggleable text="""-   * Direct mode repositories now have core.bare=true set, to prevent-     accidentally running git commands that try to operate on the work tree,-     and so do the wrong thing in direct mode.-   * annex.version is now set to 5 for direct mode repositories.-     This upgrade is handled fully automatically, no need to run-     git annex upgrade-   * The "status" command has been renamed to "info", to allow-     "git annex status" to be used in direct mode repositories, now that-     "git status" won't work in them.-   * The -c option now not only modifies the git configuration seen by-     git-annex, but it is passed along to every git command git-annex runs.-   * watcher: Avoid loop when adding a file owned by someone else fails-     in indirect mode because its permissions cannot be modified.-   * webapp: Avoid encoding problems when displaying the daemon log file.-   * webapp: Improve UI around remote that have no annex.uuid set,-     either because setup of them is incomplete, or because the remote-     git repository is not a git-annex repository.-   * Include ssh-keygen in standalone bundle.-   * Allow optionally configuring git-annex with -fEKG to enable awesome-     remote monitoring interfaceat http://localhost:4242/-   * Fix bug that caused bad information to be written to the git-annex branch-     when running describe or other commands with a remote that has no uuid.-   * Work around Android linker problem that had prevented git-annex from-     running on Android 4.3 and 4.4.-   * repair: Handle case where index file is corrupt, but all objects are ok.-   * assistant: Notice on startup when the index file is corrupt, and-     auto-repair.-   * Fix direct mode merge bug when a direct mode file was deleted and replaced-     with a directory. An ordering problem caused the directory to not get-     created in this case.-     Thanks to Tim for the test case.-   * Direct mode .git/annex/objects directories are no longer left writable,-     because that allowed writing to symlinks of files that are not present,-     which followed the link and put bad content in an object location.-     Thanks to Tim for the test case.-   * fsck: Fix up .git/annex/object directory permissions.-   * Switched to the tasty test framework.-   * Android: Adjust default .gitignore to ignore .thumbnails at any location-     in the tree, not just at its top.-   * webapp: Check annex.version."""]]
+ doc/news/version_5.20131221.mdwn view
@@ -0,0 +1,21 @@+git-annex 5.20131221 released with [[!toggle text="these changes"]]+[[!toggleable text="""+   * assistant: Fix OSX-specific bug that caused the startup scan to try to+     follow symlinks to other directories, and add their contents to the annex.+   * assistant: Set StrictHostKeyChecking yes when creating ssh remotes,+     and add it to the configuration for any ssh remotes previously created+     by the assistant. This avoids repeated prompts by ssh if the host key+     changes, instead syncing with such a remote will fail. Closes: #[732602](http://bugs.debian.org/732602)+   * Fix test suite to cover lock --force change.+   * Add plumbing-level lookupkey and examinekey commands.+   * find --format: Added hashdirlower, hashdirmixed, keyname, and mtime+     format variables.+   * assistant: Always batch changes found in startup scan.+   * An armel Linux standalone build is now available, which includes the+     webapp.+   * Programs from Linux and OSX standalone builds can now be symlinked+     into a directory in PATH as an alternative installation method, and will+     use readlink to find where the build was unpacked.+   * Include man pages in Linux and OSX standalone builds.+   * Linux standalone build now includes its own glibc and forces the linker to+     use it, to remove dependence on the host glibc."""]]
doc/tips/offline_archive_drives.mdwn view
@@ -19,8 +19,8 @@ 	git remote add archivedrive /media/archive/annex 	git annex sync archivedrive -Don't forget to  tell git-annex this is an archive drive (or perhaps a backup-drive). Also, give the drive a description that matches something you write on+Don't forget to  tell git-annex this is an archive drive (or a backup+drive; see [[preferred_content]].). Also, give the drive a description that matches something you write on its label, so you can find it later:  	git annex group archivedrive archive
doc/tips/setup_a_public_repository_on_a_web_site.mdwn view
@@ -32,7 +32,7 @@ ## post-receive hook  If you have git-annex 4.20130703, the post-receive hook mentioned above-in step 8 just needs to run `git annex merge`.+in step 9 just needs to run `git annex merge`.  With older versions of git-annex, you can instead use `git annex sync`.
doc/tips/using_box.com_as_a_special_remote.mdwn view
@@ -30,7 +30,7 @@ * Edit `/etc/fstab`, and add a line to mount Box using davfs.          sudo mkdir -p /media/box.com-        echo "https://www.box.com/dav/	/media/box.com	davfs	noauto,user	0 0" | sudo tee -a /etc/fstab+        echo "https://dav.box.com/dav/	/media/box.com	davfs	noauto,user	0 0" | sudo tee -a /etc/fstab  * Create `~/.davfs2/davfs2.conf` with some important settings:
doc/todo/Build_for_Synology_DSM.mdwn view
@@ -1,1 +1,4 @@ It would be wonderful if a pre-built package would be available for Synology NAS. Basically, this is an ARM-based Linux. It has most of the required shell commands either out of the box or easily available (through ipkg). But I think it would be difficult to install the Haskell compiler and all the required modules, so it would probably be better to cross-compile targeting ARM.++> [[done]]; the standalone armel tarball has now been tested working on+> Synology. --[[Joey]]
doc/todo/branching.mdwn view
@@ -22,7 +22,7 @@ commit. Having the logs in a separate branch doesn't help with that. As more keys are added, the tree object size will increase, and git will take longer and longer to commit, and use more space. One way to deal with-this is simply by splitting the logs amoung subdirectories. Git then can+this is simply by splitting the logs among subdirectories. Git then can reuse trees for most directories. (Check: Does it still have to build dup trees in memory?) @@ -54,7 +54,7 @@ - (BTW, UUIDs probably don't compress well, and this reduces the bloat of having   them repeated lots of times in the tree.) - Per UUID branches mean that if it wants to find a file's location-  amoung configured remotes, it can examine only their branches, if+  among configured remotes, it can examine only their branches, if   desired. - It's important that the per-repo branches propigate beyond immediate   remotes. If there is a central bare repo, that means push --all. Without
doc/todo/windows_support.mdwn view
@@ -12,9 +12,6 @@ * Ssh connection caching does not work on Windows, so `git annex get`   has to connect twice to the remote system over ssh per file, which   is much slower than on systems supporting connection caching.-* `git annex watch` works, but does not detect when files are still open-  for write as they're being added (no lsof). So watch/webapp/assistant-  may be unsafe. * `git annex assistant` has not been tested, is probably quite incomplete   and/or buggy. * Doesn't daemonize. Maybe use
doc/todo/wishlist:_Prevent_repeated_password_prompts_for_one_command.mdwn view
@@ -24,7 +24,7 @@ Slightly more elaborate design for using ssh connection caching:  * Per-uuid ssh socket in `.git/annex/ssh/user@host.socket`-* Can be shared amoung concurrent git-annex processes as well as ssh+* Can be shared among concurrent git-annex processes as well as ssh   invocations inside the current git-annex. * Also a lock file, `.git/annex/ssh/user@host.lock`.   Open and take shared lock before running ssh; store lock in lock pool.
git-annex.1 view
@@ -554,7 +554,7 @@ \fB\-\-format\fP. The default output format is the same as \fB\-\-format='${file}\\n'\fP .IP These variables are available for use in formats: file, key, backend,-bytesize, humansize+bytesize, humansize, keyname, hashdirlower, hashdirmixed, mtime. .IP .IP "\fBwhereis [path ...]\fP" Displays a information about where the contents of files are located.@@ -670,14 +670,28 @@ point to annexed content. Also handles injecting changes to unlocked files into the annex. .IP-.IP "\fBupdate\-hook refname olvrev newrev\fP"-This is meant to be called from git's update hook. \fBgit annex init\fP-automatically creates an update hook using this.+.IP "\fBlookupkey [file ...]\fP"+This plumbing\-level command looks up the key used for a file in the+index. The key is output to stdout. If there is no key (because+the file is not present in the index, or is not a git\-annex managed file),+nothing is output, and it exits nonzero. .IP-This denies updates being pushed for the currently checked out branch.-While receive.denyCurrentBranch normally prevents that, it does-not for fake bare repositories, as used by direct mode.+.IP "\fBexaminekey [key ...]\fP"+This plumbing\-level command is given a key, and prints information+that can be determined purely by looking at the key. .IP+To specify what information to print, use \fB\-\-format\fP. Or use \fB\-\-json\fP+to get all available information in JSON format.+.IP+The same variables can be used in the format string as can be used in+the format string of git annex find (except there is no file option+here).+.IP+For example, the location a key's value is stored (in indirect mode)+can be looked up by running:+.IP+ git annex examinekey \-\-format='.git/annex/objects/${hashdirmixed}${key}/${key}'+.IP .IP "\fBfromkey key file\fP" This plumbing\-level command can be used to manually set up a file in the git repository to link to a specified key.@@ -693,8 +707,17 @@ .IP  git annex dropkey SHA1\-s10\-7da006579dd64330eb2456001fd01948430572f2 .IP+.IP "\fBtransferkey\fP"+This plumbing\-level command is used to request a single key be+transferred. Either the \-\-from or the \-\-to option can be used to specify+the remote to use. A \-\-file option can be used to hint at the file+associated with the key.+.IP .IP "\fBtransferkeys\fP" This plumbing\-level command is used by the assistant to transfer data.+It is fed instructions about the keys to transfer using an internal+stdio protocol, which is intentionally not documented (as it may change+at any time). .IP .IP "\fBrekey [file key ...]\fP" This plumbing\-level command is similar to migrate, but you specify
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 5.20131213+Version: 5.20131221 Cabal-Version: >= 1.8 License: GPL-3 Maintainer: Joey Hess <joey@kitenet.net>@@ -161,7 +161,7 @@      if flag(Android)     Build-Depends: data-endian-    CPP-Options: -D__ANDROID__ -DANDROID_SPLICES+    CPP-Options: -D__ANDROID__ -DANDROID_SPLICES -D__NO_TH__   if flag(AndroidSplice)     CPP-Options: -DANDROID_SPLICES
− standalone/android/evilsplicer-headers.hs 
@@ -1,32 +0,0 @@---{- This file was modified by the EvilSplicer, adding these headers,- - and expanding Template Haskell. - -- - ** 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-import qualified Data.Text-import qualified Data.Text.Lazy.Builder-import qualified Text.Shakespeare-import qualified Text.Hamlet-import qualified Text.Julius-import qualified Text.Css-import qualified "blaze-markup" Text.Blaze.Internal-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. -}--
− standalone/android/haskell-patches/DAV_build-without-TH.patch 
@@ -1,377 +0,0 @@-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 #-}
− standalone/android/haskell-patches/lens_various-hacking-to-cross-build.patch 
@@ -1,385 +0,0 @@-From 41706061810410cc38f602ccc9a4c9560502251f Mon Sep 17 00:00:00 2001-From: dummy <dummy@example.com>-Date: Sat, 19 Oct 2013 01:44:52 +0000-Subject: [PATCH] hackity------ 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 b25adf4..3e5c30c 100644---- a/lens.cabal-+++ b/lens.cabal-@@ -10,7 +10,7 @@ stability:     provisional- homepage:      http://github.com/ekmett/lens/- bug-reports:   http://github.com/ekmett/lens/issues- copyright:     Copyright (C) 2012-2013 Edward A. Kmett--build-type:    Custom-+build-type:    Simple- tested-with:   GHC == 7.6.3- synopsis:      Lenses, Folds and Traversals- description:-@@ -235,14 +235,12 @@ library-     Control.Lens.Review-     Control.Lens.Setter-     Control.Lens.Simple--    Control.Lens.TH-     Control.Lens.Traversal-     Control.Lens.Tuple-     Control.Lens.Type-     Control.Lens.Wrapped-     Control.Lens.Zipper-     Control.Lens.Zoom--    Control.Monad.Error.Lens-     Control.Parallel.Strategies.Lens-     Control.Seq.Lens-     Data.Array.Lens-@@ -266,12 +264,8 @@ library-     Data.Typeable.Lens-     Data.Vector.Lens-     Data.Vector.Generic.Lens--    Generics.Deriving.Lens--    GHC.Generics.Lens-     System.Exit.Lens-     System.FilePath.Lens--    System.IO.Error.Lens--    Language.Haskell.TH.Lens-     Numeric.Lens- -   if flag(safe)-@@ -370,7 +364,6 @@ test-suite doctests-       deepseq,-       doctest        >= 0.9.1,-       filepath,--      generic-deriving,-       mtl,-       nats,-       parallel,-@@ -396,7 +389,6 @@ benchmark plated-     comonad,-     criterion,-     deepseq,--    generic-deriving,-     lens,-     transformers- -@@ -431,7 +423,6 @@ benchmark unsafe-     comonads-fd,-     criterion,-     deepseq,--    generic-deriving,-     lens,-     transformers- -@@ -448,6 +439,5 @@ benchmark zipper-     comonads-fd,-     criterion,-     deepseq,--    generic-deriving,-     lens,-     transformers-diff --git a/src/Control/Exception/Lens.hs b/src/Control/Exception/Lens.hs-index 0619335..c97ad9b 100644---- a/src/Control/Exception/Lens.hs-+++ b/src/Control/Exception/Lens.hs-@@ -112,7 +112,7 @@ import Prelude-   ,  Maybe(..), Either(..), Functor(..), String, IO-   )- --{-# ANN module "HLint: ignore Use Control.Exception.catch" #-}-+- - -- $setup- -- >>> :set -XNoOverloadedStrings-diff --git a/src/Control/Lens.hs b/src/Control/Lens.hs-index 242c3c1..2ab9cdb 100644---- a/src/Control/Lens.hs-+++ b/src/Control/Lens.hs-@@ -59,7 +59,7 @@ module Control.Lens-   , module Control.Lens.Review-   , module Control.Lens.Setter-   , module Control.Lens.Simple--#ifndef DISABLE_TEMPLATE_HASKELL-+#if 0-   , module Control.Lens.TH- #endif-   , module Control.Lens.Traversal-@@ -89,7 +89,7 @@ import Control.Lens.Reified- import Control.Lens.Review- import Control.Lens.Setter- import Control.Lens.Simple--#ifndef DISABLE_TEMPLATE_HASKELL-+#if 0- import Control.Lens.TH- #endif- import Control.Lens.Traversal-@@ -99,4 +99,4 @@ import Control.Lens.Wrapped- import Control.Lens.Zipper- import Control.Lens.Zoom- --{-# ANN module "HLint: ignore Use import/export shortcut" #-}-+-diff --git a/src/Control/Lens/Equality.hs b/src/Control/Lens/Equality.hs-index 982c2d7..3a3fe1a 100644---- a/src/Control/Lens/Equality.hs-+++ b/src/Control/Lens/Equality.hs-@@ -28,8 +28,8 @@ module Control.Lens.Equality- import Control.Lens.Internal.Setter- import Control.Lens.Type- --{-# ANN module "HLint: ignore Use id" #-}--{-# ANN module "HLint: ignore Eta reduce" #-}-+-+- - -- $setup- -- >>> import Control.Lens-diff --git a/src/Control/Lens/Fold.hs b/src/Control/Lens/Fold.hs-index 32a4073..cc7da1e 100644---- a/src/Control/Lens/Fold.hs-+++ b/src/Control/Lens/Fold.hs-@@ -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- --{-# ANN module "HLint: ignore Eta reduce" #-}--{-# ANN module "HLint: ignore Use camelCase" #-}--{-# ANN module "HLint: ignore Use curry" #-}-+-+-+- - infixl 8 ^.., ^?, ^?!, ^@.., ^@?, ^@?!- -diff --git a/src/Control/Lens/Internal.hs b/src/Control/Lens/Internal.hs-index 295662e..539642d 100644---- a/src/Control/Lens/Internal.hs-+++ b/src/Control/Lens/Internal.hs-@@ -43,4 +43,4 @@ import Control.Lens.Internal.Review- import Control.Lens.Internal.Setter- import Control.Lens.Internal.Zoom- --{-# 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-+++ b/src/Control/Lens/Internal/Zipper.hs-@@ -53,7 +53,7 @@ import Data.Profunctor.Unsafe- -- >>> import Control.Lens- -- >>> import Data.Char- --{-# ANN module "HLint: ignore Use foldl" #-}-+- - ------------------------------------------------------------------------------- -- * Jacket-diff --git a/src/Control/Lens/Iso.hs b/src/Control/Lens/Iso.hs-index 1152af4..80c3175 100644---- a/src/Control/Lens/Iso.hs-+++ b/src/Control/Lens/Iso.hs-@@ -82,8 +82,6 @@ import Data.Maybe- import Data.Profunctor- import Data.Profunctor.Unsafe- --{-# ANN module "HLint: ignore Use on" #-}--- -- $setup- -- >>> :set -XNoOverloadedStrings- -- >>> import Control.Lens-diff --git a/src/Control/Lens/Lens.hs b/src/Control/Lens/Lens.hs-index b26cc06..6f84943 100644---- a/src/Control/Lens/Lens.hs-+++ b/src/Control/Lens/Lens.hs-@@ -126,7 +126,7 @@ import Data.Profunctor.Rep- import Data.Profunctor.Unsafe- import Data.Void- --{-# ANN module "HLint: ignore Use ***" #-}-+- - -- $setup- -- >>> :set -XNoOverloadedStrings-diff --git a/src/Control/Lens/Operators.hs b/src/Control/Lens/Operators.hs-index 11868e0..475c945 100644---- a/src/Control/Lens/Operators.hs-+++ b/src/Control/Lens/Operators.hs-@@ -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 a8c4d20..cef574e 100644---- a/src/Control/Lens/Plated.hs-+++ b/src/Control/Lens/Plated.hs-@@ -95,7 +95,7 @@ import           Data.Data.Lens- import           Data.Monoid- import           Data.Tree- --{-# ANN module "HLint: ignore Reduce duplication" #-}-+- - -- | 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-+++ b/src/Control/Lens/Setter.hs-@@ -87,8 +87,6 @@ import Data.Profunctor- import Data.Profunctor.Rep- import Data.Profunctor.Unsafe- --{-# ANN module "HLint: ignore Avoid lambda" #-}--- -- $setup- -- >>> import Control.Lens- -- >>> import Control.Monad.State-diff --git a/src/Control/Lens/TH.hs b/src/Control/Lens/TH.hs-index a05eb07..49218b5 100644---- a/src/Control/Lens/TH.hs-+++ b/src/Control/Lens/TH.hs-@@ -87,7 +87,7 @@ import Language.Haskell.TH- import Language.Haskell.TH.Syntax- import Language.Haskell.TH.Lens- --{-# ANN module "HLint: ignore Use foldl" #-}-+- - -- | Flags for 'Lens' construction- data LensFlag-diff --git a/src/Data/Data/Lens.hs b/src/Data/Data/Lens.hs-index cf1e7c9..b39dacf 100644---- a/src/Data/Data/Lens.hs-+++ b/src/Data/Data/Lens.hs-@@ -65,9 +65,9 @@ import           Data.Monoid- import           GHC.Exts (realWorld#)- #endif- --{-# ANN module "HLint: ignore Eta reduce" #-}--{-# ANN module "HLint: ignore Use foldl" #-}--{-# ANN module "HLint: ignore Reduce duplication" #-}-+-+-+- - -- $setup- -- >>> :set -XNoOverloadedStrings--- -1.7.10.4-
− standalone/android/haskell-patches/persistent-template_stub-out.patch 
@@ -1,25 +0,0 @@-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-
− standalone/android/haskell-patches/persistent_1.1.5.1_0001-disable-TH.patch 
@@ -1,32 +0,0 @@-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/Sql/Raw.hs |    2 --- 1 file changed, 2 deletions(-)--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]- rawQuery sql vals = do--    lift $ $logDebugS (pack "SQL") $ pack $ show sql ++ " " ++ show vals-     conn <- lift askSqlConn-     bracketP-         (getStmtConn conn sql)-@@ -34,7 +33,6 @@ rawExecute x y = liftM (const ()) $ rawExecuteCount x y- - rawExecuteCount :: MonadSqlPersist m => Text -> [PersistValue] -> m Int64- rawExecuteCount sql vals = do--    $logDebugS (pack "SQL") $ pack $ show sql ++ " " ++ show vals-     stmt <- getStmt sql-     res <- liftIO $ stmtExecute stmt vals-     liftIO $ stmtReset stmt--- -1.7.10.4-
− standalone/android/haskell-patches/wai-app-static_deal-with-TH.patch 
@@ -1,54 +0,0 @@-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 ----- 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 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)- - import Blaze.ByteString.Builder (toByteString)- --import Data.FileEmbed (embedFile)--- import Data.Text (Text)- import qualified Data.Text as T- -@@ -198,8 +196,6 @@ staticAppPieces _ _ req-         H.status405-         [("Content-Type", "text/plain")]-         "Only GET is supported"--staticAppPieces _ [".hidden", "folder.png"] _  = return $ W.responseLBS H.status200 [("Content-Type", "image/png")] $ L.fromChunks [$(embedFile "images/folder.png")]--staticAppPieces _ [".hidden", "haskell.png"] _ = return $ W.responseLBS H.status200 [("Content-Type", "image/png")] $ L.fromChunks [$(embedFile "images/haskell.png")]- 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.7.10.4-
− standalone/android/haskell-patches/yesod-auth_don-t-really-build.patch 
@@ -1,34 +0,0 @@-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-
− standalone/android/haskell-patches/yesod-core_expand_TH.patch 
@@ -1,411 +0,0 @@-From 7583457fb410d07f480a2aa7d6c2f174324b3592 Mon Sep 17 00:00:00 2001-From: dummy <dummy@example.com>-Date: Sat, 19 Oct 2013 02:03:18 +0000-Subject: [PATCH] hackity------ 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 -- 5 files changed, 179 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-         []--- -1.7.10.4-
− standalone/android/haskell-patches/yesod-form_spliced-TH.patch 
@@ -1,1783 +0,0 @@-From f645acc0efbfcba7715cd2b6734f0e9df98f7020 Mon Sep 17 00:00:00 2001-From: dummy <dummy@example.com>-Date: Mon, 11 Nov 2013 01:26:56 +0000-Subject: [PATCH] update------ Yesod/Form/Fields.hs    |  771 +++++++++++++++++++++++++++++++++++------------- Yesod/Form/Functions.hs |  237 ++++++++++++---- Yesod/Form/Jquery.hs    |  125 ++++++--- Yesod/Form/MassInput.hs |  233 +++++++++++---- Yesod/Form/Nic.hs       |   61 +++-- yesod-form.cabal        |    1 +- 6 files changed, 1122 insertions(+), 306 deletions(-)--diff --git a/Yesod/Form/Fields.hs b/Yesod/Form/Fields.hs-index 0689859..1e9d49b 100644---- a/Yesod/Form/Fields.hs-+++ b/Yesod/Form/Fields.hs-@@ -1,4 +1,3 @@--{-# LANGUAGE QuasiQuotes #-}- {-# LANGUAGE TypeFamilies #-}- {-# LANGUAGE OverloadedStrings #-}- {-# LANGUAGE GeneralizedNewtypeDeriving #-}-@@ -36,15 +35,11 @@ module Yesod.Form.Fields-     , selectFieldList-     , radioField-     , radioFieldList--    , checkboxesFieldList--    , checkboxesField-     , multiSelectField-     , multiSelectFieldList-     , Option (..)-     , OptionList (..)-     , mkOptionList--    , optionsPersist--    , optionsPersistKey-     , optionsPairs-     , optionsEnum-     ) where-@@ -70,6 +65,15 @@ import Text.HTML.SanitizeXSS (sanitizeBalance)- import Control.Monad (when, unless)- import Data.Maybe (listToMaybe, fromMaybe)- -+import qualified Text.Blaze as Text.Blaze.Internal-+import qualified Text.Blaze.Internal-+import qualified Text.Hamlet-+import qualified Yesod.Core.Widget-+import qualified Text.Css-+import qualified Data.Monoid-+import qualified Data.Foldable-+import qualified Control.Monad-+- import qualified Blaze.ByteString.Builder.Html.Utf8 as B- import Blaze.ByteString.Builder (writeByteString, toLazyByteString)- import Blaze.ByteString.Builder.Internal.Write (fromWriteList)-@@ -82,14 +86,12 @@ import Data.Text (Text, unpack, pack)- import qualified Data.Text.Read- - import qualified Data.Map as Map--import Yesod.Persist (selectList, runDB, Filter, SelectOpt, Key, YesodPersist, PersistEntity, PersistQuery, YesodDB)- import Control.Arrow ((&&&))- - import Control.Applicative ((<$>), (<|>))- - import Data.Attoparsec.Text (Parser, char, string, digit, skipSpace, endOfInput, parseOnly)- --import Yesod.Persist.Core- - defaultFormMessage :: FormMessage -> Text- defaultFormMessage = englishFormMessage-@@ -102,10 +104,24 @@ intField = Field-             Right (a, "") -> Right a-             _ -> Left $ MsgInvalidInteger s- --    , fieldView = \theId name attrs val isReq -> toWidget [hamlet|--$newline never--<input id="#{theId}" name="#{name}" *{attrs} type="number" :isReq:required="" value="#{showVal val}">--|]-+    , fieldView = \theId name attrs val isReq -> toWidget  $     \ _render_arOn-+      -> do { id-+                ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");-+              id (toHtml theId);-+              id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");-+              id (toHtml name);-+              id-+                ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"number\"");-+              Text.Hamlet.condH-+                [(isReq, -+                  id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]-+                Nothing;-+              id ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");-+              id (toHtml (showVal val));-+              id ((Text.Blaze.Internal.preEscapedText . pack) "\"");-+              id ((Text.Hamlet.attrsToHtml . toAttributes) attrs);-+              id ((Text.Blaze.Internal.preEscapedText . pack) ">") }-+-     , fieldEnctype = UrlEncoded-     }-   where-@@ -119,10 +135,24 @@ doubleField = Field-             Right (a, "") -> Right a-             _ -> Left $ MsgInvalidNumber s- --    , fieldView = \theId name attrs val isReq -> toWidget [hamlet|--$newline never--<input id="#{theId}" name="#{name}" *{attrs} type="text" :isReq:required="" value="#{showVal val}">--|]-+    , fieldView = \theId name attrs val isReq -> toWidget  $     \ _render_arOz-+      -> do { id-+                ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");-+              id (toHtml theId);-+              id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");-+              id (toHtml name);-+              id-+                ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"text\"");-+              Text.Hamlet.condH-+                [(isReq, -+                  id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]-+                Nothing;-+              id ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");-+              id (toHtml (showVal val));-+              id ((Text.Blaze.Internal.preEscapedText . pack) "\"");-+              id ((Text.Hamlet.attrsToHtml . toAttributes) attrs);-+              id ((Text.Blaze.Internal.preEscapedText . pack) ">") }-+-     , fieldEnctype = UrlEncoded-     }-   where showVal = either id (pack . show)-@@ -130,10 +160,24 @@ $newline never- dayField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Day- dayField = Field-     { fieldParse = parseHelper $ parseDate . unpack--    , fieldView = \theId name attrs val isReq -> toWidget [hamlet|--$newline never--<input id="#{theId}" name="#{name}" *{attrs} type="date" :isReq:required="" value="#{showVal val}">--|]-+    , fieldView = \theId name attrs val isReq -> toWidget  $     \ _render_arOJ-+      -> do { id-+                ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");-+              id (toHtml theId);-+              id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");-+              id (toHtml name);-+              id-+                ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"date\"");-+              Text.Hamlet.condH-+                [(isReq, -+                  id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]-+                Nothing;-+              id ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");-+              id (toHtml (showVal val));-+              id ((Text.Blaze.Internal.preEscapedText . pack) "\"");-+              id ((Text.Hamlet.attrsToHtml . toAttributes) attrs);-+              id ((Text.Blaze.Internal.preEscapedText . pack) ">") }-+-     , fieldEnctype = UrlEncoded-     }-   where showVal = either id (pack . show)-@@ -141,10 +185,23 @@ $newline never- timeField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m TimeOfDay- timeField = Field-     { fieldParse = parseHelper parseTime--    , fieldView = \theId name attrs val isReq -> toWidget [hamlet|--$newline never--<input id="#{theId}" name="#{name}" *{attrs} :isReq:required="" value="#{showVal val}">--|]-+    , fieldView = \theId name attrs val isReq -> toWidget  $     \ _render_arOW-+      -> do { id-+                ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");-+              id (toHtml theId);-+              id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");-+              id (toHtml name);-+              id ((Text.Blaze.Internal.preEscapedText . pack) "\"");-+              Text.Hamlet.condH-+                [(isReq, -+                  id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]-+                Nothing;-+              id ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");-+              id (toHtml (showVal val));-+              id ((Text.Blaze.Internal.preEscapedText . pack) "\"");-+              id ((Text.Hamlet.attrsToHtml . toAttributes) attrs);-+              id ((Text.Blaze.Internal.preEscapedText . pack) ">") }-+-     , fieldEnctype = UrlEncoded-     }-   where-@@ -157,10 +214,18 @@ $newline never- htmlField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Html- htmlField = Field-     { fieldParse = parseHelper $ Right . preEscapedText . sanitizeBalance--    , fieldView = \theId name attrs val _isReq -> toWidget [hamlet|--$newline never--<textarea id="#{theId}" name="#{name}" *{attrs}>#{showVal val}--|]-+    , fieldView = \theId name attrs val _isReq -> toWidget  $     \ _render_arP6-+      -> do { id-+                ((Text.Blaze.Internal.preEscapedText . pack) "<textarea id=\"");-+              id (toHtml theId);-+              id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");-+              id (toHtml name);-+              id ((Text.Blaze.Internal.preEscapedText . pack) "\"");-+              id ((Text.Hamlet.attrsToHtml . toAttributes) attrs);-+              id ((Text.Blaze.Internal.preEscapedText . pack) ">");-+              id (toHtml (showVal val));-+              id ((Text.Blaze.Internal.preEscapedText . pack) "</textarea>") }-+-     , fieldEnctype = UrlEncoded-     }-   where showVal = either id (pack . renderHtml)-@@ -169,8 +234,6 @@ $newline never- -- br-tags.- newtype Textarea = Textarea { unTextarea :: Text }-     deriving (Show, Read, Eq, PersistField, Ord)--instance PersistFieldSql Textarea where--    sqlType _ = SqlString- instance ToHtml Textarea where-     toHtml =-         unsafeByteString-@@ -188,10 +251,18 @@ instance ToHtml Textarea where- textareaField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Textarea- textareaField = Field-     { fieldParse = parseHelper $ Right . Textarea--    , fieldView = \theId name attrs val _isReq -> toWidget [hamlet|--$newline never--<textarea id="#{theId}" name="#{name}" *{attrs}>#{either id unTextarea val}--|]-+    , fieldView = \theId name attrs val _isReq -> toWidget  $     \ _render_arPf-+      -> do { id-+                ((Text.Blaze.Internal.preEscapedText . pack) "<textarea id=\"");-+              id (toHtml theId);-+              id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");-+              id (toHtml name);-+              id ((Text.Blaze.Internal.preEscapedText . pack) "\"");-+              id ((Text.Hamlet.attrsToHtml . toAttributes) attrs);-+              id ((Text.Blaze.Internal.preEscapedText . pack) ">");-+              id (toHtml (either id unTextarea val));-+              id ((Text.Blaze.Internal.preEscapedText . pack) "</textarea>") }-+-     , fieldEnctype = UrlEncoded-     }- -@@ -199,10 +270,19 @@ hiddenField :: (Monad m, PathPiece p, RenderMessage (HandlerSite m) FormMessage)-             => Field m p- hiddenField = Field-     { fieldParse = parseHelper $ maybe (Left MsgValueRequired) Right . fromPathPiece--    , fieldView = \theId name attrs val _isReq -> toWidget [hamlet|--$newline never--<input type="hidden" id="#{theId}" name="#{name}" *{attrs} value="#{either id toPathPiece val}">--|]-+    , fieldView = \theId name attrs val _isReq -> toWidget  $     \ _render_arPo-+      -> do { id-+                ((Text.Blaze.Internal.preEscapedText . pack)-+                   "<input type=\"hidden\" id=\"");-+              id (toHtml theId);-+              id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");-+              id (toHtml name);-+              id ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"");-+              id (toHtml (either id toPathPiece val));-+              id ((Text.Blaze.Internal.preEscapedText . pack) "\"");-+              id ((Text.Hamlet.attrsToHtml . toAttributes) attrs);-+              id ((Text.Blaze.Internal.preEscapedText . pack) ">") }-+-     , fieldEnctype = UrlEncoded-     }- -@@ -210,20 +290,55 @@ textField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Tex- textField = Field-     { fieldParse = parseHelper $ Right-     , fieldView = \theId name attrs val isReq ->--        [whamlet|--$newline never--<input id="#{theId}" name="#{name}" *{attrs} type="text" :isReq:required value="#{either id id val}">--|]-+        do { (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");-+             (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");-+             (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name);-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"text\"");-+             Text.Hamlet.condH-+               [(isReq, -+                 (Yesod.Core.Widget.asWidgetT . toWidget)-+                   ((Text.Blaze.Internal.preEscapedText . pack) " required"))]-+               Nothing;-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               (toHtml (either id id val));-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . pack) "\"");-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Hamlet.attrsToHtml . toAttributes) attrs);-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . pack) ">") }-+-     , fieldEnctype = UrlEncoded-     }- - passwordField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Text- passwordField = Field-     { fieldParse = parseHelper $ Right--    , fieldView = \theId name attrs val isReq -> toWidget [hamlet|--$newline never--<input id="#{theId}" name="#{name}" *{attrs} type="password" :isReq:required="" value="#{either id id val}">--|]-+    , fieldView = \theId name attrs val isReq -> toWidget  $     \ _render_arPF-+      -> do { id-+                ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");-+              id (toHtml theId);-+              id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");-+              id (toHtml name);-+              id-+                ((Text.Blaze.Internal.preEscapedText . pack)-+                   "\" type=\"password\"");-+              Text.Hamlet.condH-+                [(isReq, -+                  id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]-+                Nothing;-+              id ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");-+              id (toHtml (either id id val));-+              id ((Text.Blaze.Internal.preEscapedText . pack) "\"");-+              id ((Text.Hamlet.attrsToHtml . toAttributes) attrs);-+              id ((Text.Blaze.Internal.preEscapedText . pack) ">") }-+-     , fieldEnctype = UrlEncoded-     }- -@@ -295,10 +410,24 @@ emailField = Field-             case Email.canonicalizeEmail $ encodeUtf8 s of-                 Just e -> Right $ decodeUtf8With lenientDecode e-                 Nothing -> Left $ MsgInvalidEmail s--    , fieldView = \theId name attrs val isReq -> toWidget [hamlet|--$newline never--<input id="#{theId}" name="#{name}" *{attrs} type="email" :isReq:required="" value="#{either id id val}">--|]-+    , fieldView = \theId name attrs val isReq -> toWidget  $     \ _render_arQe-+      -> do { id-+                ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");-+              id (toHtml theId);-+              id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");-+              id (toHtml name);-+              id-+                ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"email\"");-+              Text.Hamlet.condH-+                [(isReq, -+                  id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]-+                Nothing;-+              id ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");-+              id (toHtml (either id id val));-+              id ((Text.Blaze.Internal.preEscapedText . pack) "\"");-+              id ((Text.Hamlet.attrsToHtml . toAttributes) attrs);-+              id ((Text.Blaze.Internal.preEscapedText . pack) ">") }-+-     , fieldEnctype = UrlEncoded-     }- -@@ -307,20 +436,78 @@ searchField :: Monad m => RenderMessage (HandlerSite m) FormMessage => AutoFocus- searchField autoFocus = Field-     { fieldParse = parseHelper Right-     , fieldView = \theId name attrs val isReq -> do--        [whamlet|\--$newline never--<input id="#{theId}" name="#{name}" *{attrs} type="search" :isReq:required="" :autoFocus:autofocus="" value="#{either id id val}">--|]-+        do { (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");-+             (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");-+             (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name);-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"search\"");-+             Text.Hamlet.condH-+               [(isReq, -+                 (Yesod.Core.Widget.asWidgetT . toWidget)-+                   ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]-+               Nothing;-+             Text.Hamlet.condH-+               [(autoFocus, -+                 (Yesod.Core.Widget.asWidgetT . toWidget)-+                   ((Text.Blaze.Internal.preEscapedText . pack) " autofocus=\"\""))]-+               Nothing;-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               (toHtml (either id id val));-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . pack) "\"");-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Hamlet.attrsToHtml . toAttributes) attrs);-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . pack) ">") }-+-         when autoFocus $ do-           -- we want this javascript to be placed immediately after the field--          [whamlet|--$newline never--<script>if (!('autofocus' in document.createElement('input'))) {document.getElementById('#{theId}').focus();}--|]--          toWidget [cassius|--            ##{theId}--              -webkit-appearance: textfield--            |]-+          do { (Yesod.Core.Widget.asWidgetT . toWidget)-+                 ((Text.Blaze.Internal.preEscapedText . pack)-+                    "<script>if (!('autofocus' in document.createElement('input'))) {document.getElementById('");-+               (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);-+               (Yesod.Core.Widget.asWidgetT . toWidget)-+                 ((Text.Blaze.Internal.preEscapedText . pack)-+                    "').focus();}</script>") }-+-+          toWidget  $           \ _render_arQv-+            -> (Text.Css.CssNoWhitespace-+                . (foldr ($) []))-+                 [((++)-+                   $ (map-+                        Text.Css.TopBlock-+                        (((Text.Css.Block-+                             {Text.Css.blockSelector = Data.Monoid.mconcat-+                                                                                 [(Text.Css.fromText-+                                                                                   . Text.Css.pack)-+                                                                                    "#",-+                                                                                  toCss theId],-+                              Text.Css.blockAttrs = (concat-+                                                                             $ ([Text.Css.Attr-+                                                                                   (Data.Monoid.mconcat-+                                                                                      [(Text.Css.fromText-+                                                                                        . Text.Css.pack)-+                                                                                         "-webkit-appearance"])-+                                                                                   (Data.Monoid.mconcat-+                                                                                      [(Text.Css.fromText-+                                                                                        . Text.Css.pack)-+                                                                                         "textfield"])]-+                                                                                :-+                                                                                  (map-+                                                                                     Text.Css.mixinAttrs-+                                                                                     []))),-+                              Text.Css.blockBlocks = (),-+                              Text.Css.blockMixins = ()}-+                         :)-+                          . ((foldr (.) id [])-+                             . (concatMap Text.Css.mixinBlocks [] ++)))-+                           [])))]-+-     , fieldEnctype = UrlEncoded-     }- -@@ -331,7 +518,30 @@ urlField = Field-             Nothing -> Left $ MsgInvalidUrl s-             Just _ -> Right s-     , fieldView = \theId name attrs val isReq ->--        [whamlet|<input ##{theId} name=#{name} *{attrs} type=url :isReq:required value=#{either id id val}>|]-+        do { (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");-+             (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");-+             (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name);-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"url\"");-+             Text.Hamlet.condH-+               [(isReq, -+                 (Yesod.Core.Widget.asWidgetT . toWidget)-+                   ((Text.Blaze.Internal.preEscapedText . pack) " required"))]-+               Nothing;-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               (toHtml (either id id val));-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . pack) "\"");-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Hamlet.attrsToHtml . toAttributes) attrs);-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . pack) ">") }-+-     , fieldEnctype = UrlEncoded-     }- -@@ -344,18 +554,56 @@ selectField :: (Eq a, RenderMessage site FormMessage)-             => HandlerT site IO (OptionList a)-             -> Field (HandlerT site IO) a- selectField = selectFieldHelper--    (\theId name attrs inside -> [whamlet|--$newline never--<select ##{theId} name=#{name} *{attrs}>^{inside}--|]) -- outside--    (\_theId _name isSel -> [whamlet|--$newline never--<option value=none :isSel:selected>_{MsgSelectNone}--|]) -- onOpt--    (\_theId _name _attrs value isSel text -> [whamlet|--$newline never--<option value=#{value} :isSel:selected>#{text}--|]) -- inside-+    (\theId name attrs inside ->     do { (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack) "<select id=\"");-+         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);-+         (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");-+         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name);-+         (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack) "\"");-+         (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Hamlet.attrsToHtml . toAttributes) attrs);-+         (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack) ">");-+         (Yesod.Core.Widget.asWidgetT . toWidget) inside;-+         (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack) "</select>") })-+ -- outside-+    (\_theId _name isSel ->     do { (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack)-+              "<option value=\"none\"");-+         Text.Hamlet.condH-+           [(isSel, -+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . pack) " selected"))]-+           Nothing;-+         (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack) ">");-+         ((Control.Monad.liftM (toHtml .) getMessageRender)-+          >>=-+            (\ urender_arQS-+               -> (Yesod.Core.Widget.asWidgetT . toWidget)-+                    (urender_arQS MsgSelectNone)));-+         (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack) "</option>") })-+ -- onOpt-+    (\_theId _name _attrs value isSel text ->     do { (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack) "<option value=\"");-+         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml value);-+         (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack) "\"");-+         Text.Hamlet.condH-+           [(isSel, -+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . pack) " selected"))]-+           Nothing;-+         (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack) ">");-+         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml text);-+         (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack) "</option>") })-+ -- inside- - multiSelectFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg)-                      => [(msg, a)]-@@ -378,11 +626,48 @@ multiSelectField ioptlist =-     view theId name attrs val isReq = do-         opts <- fmap olOptions $ handlerToWidget ioptlist-         let selOpts = map (id &&& (optselected val)) opts--        [whamlet|--            <select ##{theId} name=#{name} :isReq:required multiple *{attrs}>--                $forall (opt, optsel) <- selOpts--                    <option value=#{optionExternalValue opt} :optsel:selected>#{optionDisplay opt}--                |]-+        do { (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . pack) "<select id=\"");-+             (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");-+             (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name);-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . pack) "\"");-+             Text.Hamlet.condH-+               [(isReq, -+                 (Yesod.Core.Widget.asWidgetT . toWidget)-+                   ((Text.Blaze.Internal.preEscapedText . pack) " required"))]-+               Nothing;-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . pack) " multiple");-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Hamlet.attrsToHtml . toAttributes) attrs);-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . pack) ">");-+             Data.Foldable.mapM_-+               (\ (opt_arRl, optsel_arRm)-+                  -> do { (Yesod.Core.Widget.asWidgetT . toWidget)-+                            ((Text.Blaze.Internal.preEscapedText . pack) "<option value=\"");-+                          (Yesod.Core.Widget.asWidgetT . toWidget)-+                            (toHtml (optionExternalValue opt_arRl));-+                          (Yesod.Core.Widget.asWidgetT . toWidget)-+                            ((Text.Blaze.Internal.preEscapedText . pack) "\"");-+                          Text.Hamlet.condH-+                            [(optsel_arRm, -+                              (Yesod.Core.Widget.asWidgetT . toWidget)-+                                ((Text.Blaze.Internal.preEscapedText . pack) " selected"))]-+                            Nothing;-+                          (Yesod.Core.Widget.asWidgetT . toWidget)-+                            ((Text.Blaze.Internal.preEscapedText . pack) ">");-+                          (Yesod.Core.Widget.asWidgetT . toWidget)-+                            (toHtml (optionDisplay opt_arRl));-+                          (Yesod.Core.Widget.asWidgetT . toWidget)-+                            ((Text.Blaze.Internal.preEscapedText . pack) "</option>") })-+               selOpts;-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . pack) "</select>") }-+-         where-             optselected (Left _) _ = False-             optselected (Right vals) opt = (optionInternalValue opt) `elem` vals-@@ -392,67 +677,172 @@ radioFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg)-                -> Field (HandlerT site IO) a- radioFieldList = radioField . optionsPairs- --checkboxesFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg) => [(msg, a)]--                     -> Field (HandlerT site IO) [a]--checkboxesFieldList = checkboxesField . optionsPairs----checkboxesField :: (Eq a, RenderMessage site FormMessage)--                 => HandlerT site IO (OptionList a)--                 -> Field (HandlerT site IO) [a]--checkboxesField ioptlist = (multiSelectField ioptlist)--    { fieldView =--        \theId name attrs val isReq -> do--            opts <- fmap olOptions $ handlerToWidget ioptlist--            let optselected (Left _) _ = False--                optselected (Right vals) opt = (optionInternalValue opt) `elem` vals--            [whamlet|--                <span ##{theId}>--                    $forall opt <- opts--                        <label>--                            <input type=checkbox name=#{name} value=#{optionExternalValue opt} *{attrs} :optselected val opt:checked>--                            #{optionDisplay opt}--                |]--    }- - radioField :: (Eq a, RenderMessage site FormMessage)-            => HandlerT site IO (OptionList a)-            -> Field (HandlerT site IO) a- radioField = selectFieldHelper--    (\theId _name _attrs inside -> [whamlet|--$newline never--<div ##{theId}>^{inside}--|])--    (\theId name isSel -> [whamlet|--$newline never--<label .radio for=#{theId}-none>--    <div>--        <input id=#{theId}-none type=radio name=#{name} value=none :isSel:checked>--        _{MsgSelectNone}--|])--    (\theId name attrs value isSel text -> [whamlet|--$newline never--<label .radio for=#{theId}-#{value}>--    <div>--        <input id=#{theId}-#{value} type=radio name=#{name} value=#{value} :isSel:checked *{attrs}>--        \#{text}--|])-+    (\theId _name _attrs inside ->     do { (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack) "<div id=\"");-+         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);-+         (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack) "\">");-+         (Yesod.Core.Widget.asWidgetT . toWidget) inside;-+         (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack) "</div>") })-+-+    (\theId name isSel ->     do { (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack)-+              "<label class=\"radio\" for=\"");-+         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);-+         (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack)-+              "-none\"><div><input id=\"");-+         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);-+         (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack)-+              "-none\" type=\"radio\" name=\"");-+         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name);-+         (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"none\"");-+         Text.Hamlet.condH-+           [(isSel, -+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . pack) " checked"))]-+           Nothing;-+         (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack) ">");-+         ((Control.Monad.liftM (toHtml .) getMessageRender)-+          >>=-+            (\ urender_arRA-+               -> (Yesod.Core.Widget.asWidgetT . toWidget)-+                    (urender_arRA MsgSelectNone)));-+         (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack) "</div></label>") })-+-+    (\theId name attrs value isSel text ->     do { (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack)-+              "<label class=\"radio\" for=\"");-+         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);-+         (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack) "-");-+         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml value);-+         (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack)-+              "\"><div><input id=\"");-+         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);-+         (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack) "-");-+         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml value);-+         (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack)-+              "\" type=\"radio\" name=\"");-+         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name);-+         (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"");-+         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml value);-+         (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack) "\"");-+         Text.Hamlet.condH-+           [(isSel, -+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . pack) " checked"))]-+           Nothing;-+         (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Hamlet.attrsToHtml . toAttributes) attrs);-+         (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack) ">");-+         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml text);-+         (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack) "</div></label>") })-+- - boolField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Bool- boolField = Field-       { fieldParse = \e _ -> return $ boolParser e--      , fieldView = \theId name attrs val isReq -> [whamlet|--$newline never--  $if not isReq--      <input id=#{theId}-none *{attrs} type=radio name=#{name} value=none checked>--      <label for=#{theId}-none>_{MsgSelectNone}-+      , fieldView = \theId name attrs val isReq ->       do { Text.Hamlet.condH-+             [(not isReq, -+               do { (Yesod.Core.Widget.asWidgetT . toWidget)-+                      ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");-+                    (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);-+                    (Yesod.Core.Widget.asWidgetT . toWidget)-+                      ((Text.Blaze.Internal.preEscapedText . pack)-+                         "-none\" type=\"radio\" name=\"");-+                    (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name);-+                    (Yesod.Core.Widget.asWidgetT . toWidget)-+                      ((Text.Blaze.Internal.preEscapedText . pack)-+                         "\" value=\"none\" checked");-+                    (Yesod.Core.Widget.asWidgetT . toWidget)-+                      ((Text.Hamlet.attrsToHtml . toAttributes) attrs);-+                    (Yesod.Core.Widget.asWidgetT . toWidget)-+                      ((Text.Blaze.Internal.preEscapedText . pack) "><label for=\"");-+                    (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);-+                    (Yesod.Core.Widget.asWidgetT . toWidget)-+                      ((Text.Blaze.Internal.preEscapedText . pack) "-none\">");-+                    ((Control.Monad.liftM (toHtml .) getMessageRender)-+                     >>=-+                       (\ urender_arRX-+                          -> (Yesod.Core.Widget.asWidgetT . toWidget)-+                               (urender_arRX MsgSelectNone)));-+                    (Yesod.Core.Widget.asWidgetT . toWidget)-+                      ((Text.Blaze.Internal.preEscapedText . pack) "</label>") })]-+             Nothing;-+           (Yesod.Core.Widget.asWidgetT . toWidget)-+             ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");-+           (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);-+           (Yesod.Core.Widget.asWidgetT . toWidget)-+             ((Text.Blaze.Internal.preEscapedText . pack)-+                "-yes\" type=\"radio\" name=\"");-+           (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name);-+           (Yesod.Core.Widget.asWidgetT . toWidget)-+             ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"yes\"");-+           Text.Hamlet.condH-+             [(showVal id val, -+               (Yesod.Core.Widget.asWidgetT . toWidget)-+                 ((Text.Blaze.Internal.preEscapedText . pack) " checked"))]-+             Nothing;-+           (Yesod.Core.Widget.asWidgetT . toWidget)-+             ((Text.Hamlet.attrsToHtml . toAttributes) attrs);-+           (Yesod.Core.Widget.asWidgetT . toWidget)-+             ((Text.Blaze.Internal.preEscapedText . pack) "><label for=\"");-+           (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);-+           (Yesod.Core.Widget.asWidgetT . toWidget)-+             ((Text.Blaze.Internal.preEscapedText . pack) "-yes\">");-+           ((Control.Monad.liftM (toHtml .) getMessageRender)-+            >>=-+              (\ urender_arRY-+                 -> (Yesod.Core.Widget.asWidgetT . toWidget)-+                      (urender_arRY MsgBoolYes)));-+           (Yesod.Core.Widget.asWidgetT . toWidget)-+             ((Text.Blaze.Internal.preEscapedText . pack)-+                "</label><input id=\"");-+           (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);-+           (Yesod.Core.Widget.asWidgetT . toWidget)-+             ((Text.Blaze.Internal.preEscapedText . pack)-+                "-no\" type=\"radio\" name=\"");-+           (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name);-+           (Yesod.Core.Widget.asWidgetT . toWidget)-+             ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"no\"");-+           Text.Hamlet.condH-+             [(showVal not val, -+               (Yesod.Core.Widget.asWidgetT . toWidget)-+                 ((Text.Blaze.Internal.preEscapedText . pack) " checked"))]-+             Nothing;-+           (Yesod.Core.Widget.asWidgetT . toWidget)-+             ((Text.Hamlet.attrsToHtml . toAttributes) attrs);-+           (Yesod.Core.Widget.asWidgetT . toWidget)-+             ((Text.Blaze.Internal.preEscapedText . pack) "><label for=\"");-+           (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);-+           (Yesod.Core.Widget.asWidgetT . toWidget)-+             ((Text.Blaze.Internal.preEscapedText . pack) "-no\">");-+           ((Control.Monad.liftM (toHtml .) getMessageRender)-+            >>=-+              (\ urender_arRZ-+                 -> (Yesod.Core.Widget.asWidgetT . toWidget)-+                      (urender_arRZ MsgBoolNo)));-+           (Yesod.Core.Widget.asWidgetT . toWidget)-+             ((Text.Blaze.Internal.preEscapedText . pack) "</label>") }- ----<input id=#{theId}-yes *{attrs} type=radio name=#{name} value=yes :showVal id val:checked>--<label for=#{theId}-yes>_{MsgBoolYes}----<input id=#{theId}-no *{attrs} type=radio name=#{name} value=no :showVal not val:checked>--<label for=#{theId}-no>_{MsgBoolNo}--|]-     , fieldEnctype = UrlEncoded-     }-   where-@@ -478,10 +868,25 @@ $newline never- checkBoxField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Bool- checkBoxField = Field-     { fieldParse = \e _ -> return $ checkBoxParser e--    , fieldView  = \theId name attrs val _ -> [whamlet|--$newline never--<input id=#{theId} *{attrs} type=checkbox name=#{name} value=yes :showVal id val:checked>--|]-+    , fieldView  = \theId name attrs val _ ->     do { (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");-+         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);-+         (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack)-+              "\" type=\"checkbox\" name=\"");-+         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name);-+         (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"yes\"");-+         Text.Hamlet.condH-+           [(showVal id val, -+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . pack) " checked"))]-+           Nothing;-+         (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Hamlet.attrsToHtml . toAttributes) attrs);-+         (Yesod.Core.Widget.asWidgetT . toWidget)-+           ((Text.Blaze.Internal.preEscapedText . pack) ">") }-+-     , fieldEnctype = UrlEncoded-     }- -@@ -525,49 +930,7 @@ optionsPairs opts = do- optionsEnum :: (MonadHandler m, Show a, Enum a, Bounded a) => m (OptionList a)- optionsEnum = optionsPairs $ map (\x -> (pack $ show x, x)) [minBound..maxBound]- --optionsPersist :: ( YesodPersist site, PersistEntity a--                  , PersistQuery (YesodDB site)--                  , PathPiece (Key a)--                  , PersistEntityBackend a ~ PersistMonadBackend (YesodDB site)--                  , RenderMessage site msg--                  )--               => [Filter a]--               -> [SelectOpt a]--               -> (a -> msg)--               -> HandlerT site IO (OptionList (Entity a))--optionsPersist filts ords toDisplay = fmap mkOptionList $ do--    mr <- getMessageRender--    pairs <- runDB $ selectList filts ords--    return $ map (\(Entity key value) -> Option--        { optionDisplay = mr (toDisplay value)--        , optionInternalValue = Entity key value--        , optionExternalValue = toPathPiece key--        }) pairs------ | An alternative to 'optionsPersist' which returns just the @Key@ instead of---- the entire @Entity@.-------- Since 1.3.2--optionsPersistKey--  :: (YesodPersist site--     , PersistEntity a--     , PersistQuery (YesodPersistBackend site (HandlerT site IO))--     , PathPiece (Key a)--     , RenderMessage site msg--     , PersistEntityBackend a ~ PersistMonadBackend (YesodDB site))--  => [Filter a]--  -> [SelectOpt a]--  -> (a -> msg)--  -> HandlerT site IO (OptionList (Key a))----optionsPersistKey filts ords toDisplay = fmap mkOptionList $ do--    mr <- getMessageRender--    pairs <- runDB $ selectList filts ords--    return $ map (\(Entity key value) -> Option--        { optionDisplay = mr (toDisplay value)--        , optionInternalValue = key--        , optionExternalValue = toPathPiece key--        }) pairs-+- - selectFieldHelper-         :: (Eq a, RenderMessage site FormMessage)-@@ -611,9 +974,21 @@ fileField = Field-         case files of-             [] -> Right Nothing-             file:_ -> Right $ Just file--    , fieldView = \id' name attrs _ isReq -> toWidget [hamlet|--            <input id=#{id'} name=#{name} *{attrs} type=file :isReq:required>--        |]-+    , fieldView = \id' name attrs _ isReq -> toWidget  $     \ _render_arSN-+      -> do { id-+                ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");-+              id (toHtml id');-+              id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");-+              id (toHtml name);-+              id-+                ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"file\"");-+              Text.Hamlet.condH-+                [(isReq, -+                  id ((Text.Blaze.Internal.preEscapedText . pack) " required"))]-+                Nothing;-+              id ((Text.Hamlet.attrsToHtml . toAttributes) attrs);-+              id ((Text.Blaze.Internal.preEscapedText . pack) ">") }-+-     , fieldEnctype = Multipart-     }- -@@ -640,10 +1015,20 @@ fileAFormReq fs = AForm $ \(site, langs) menvs ints -> do-             { fvLabel = toHtml $ renderMessage site langs $ fsLabel fs-             , fvTooltip = fmap (toHtml . renderMessage site langs) $ fsTooltip fs-             , fvId = id'--            , fvInput = [whamlet|--$newline never--<input type=file name=#{name} ##{id'} *{fsAttrs fs}>--|]-+            , fvInput =             do { (Yesod.Core.Widget.asWidgetT . toWidget)-+                   ((Text.Blaze.Internal.preEscapedText . pack)-+                      "<input type=\"file\" name=\"");-+                 (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name);-+                 (Yesod.Core.Widget.asWidgetT . toWidget)-+                   ((Text.Blaze.Internal.preEscapedText . pack) "\" id=\"");-+                 (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml id');-+                 (Yesod.Core.Widget.asWidgetT . toWidget)-+                   ((Text.Blaze.Internal.preEscapedText . pack) "\"");-+                 (Yesod.Core.Widget.asWidgetT . toWidget)-+                   ((Text.Hamlet.attrsToHtml . toAttributes) (fsAttrs fs));-+                 (Yesod.Core.Widget.asWidgetT . toWidget)-+                   ((Text.Blaze.Internal.preEscapedText . pack) ">") }-+-             , fvErrors = errs-             , fvRequired = True-             }-@@ -672,10 +1057,20 @@ fileAFormOpt fs = AForm $ \(master, langs) menvs ints -> do-             { fvLabel = toHtml $ renderMessage master langs $ fsLabel fs-             , fvTooltip = fmap (toHtml . renderMessage master langs) $ fsTooltip fs-             , fvId = id'--            , fvInput = [whamlet|--$newline never--<input type=file name=#{name} ##{id'} *{fsAttrs fs}>--|]-+            , fvInput =             do { (Yesod.Core.Widget.asWidgetT . toWidget)-+                   ((Text.Blaze.Internal.preEscapedText . pack)-+                      "<input type=\"file\" name=\"");-+                 (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name);-+                 (Yesod.Core.Widget.asWidgetT . toWidget)-+                   ((Text.Blaze.Internal.preEscapedText . pack) "\" id=\"");-+                 (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml id');-+                 (Yesod.Core.Widget.asWidgetT . toWidget)-+                   ((Text.Blaze.Internal.preEscapedText . pack) "\"");-+                 (Yesod.Core.Widget.asWidgetT . toWidget)-+                   ((Text.Hamlet.attrsToHtml . toAttributes) (fsAttrs fs));-+                 (Yesod.Core.Widget.asWidgetT . toWidget)-+                   ((Text.Blaze.Internal.preEscapedText . pack) ">") }-+-             , fvErrors = errs-             , fvRequired = False-             }-diff --git a/Yesod/Form/Functions.hs b/Yesod/Form/Functions.hs-index 8a36710..c375ae0 100644---- a/Yesod/Form/Functions.hs-+++ b/Yesod/Form/Functions.hs-@@ -59,6 +59,10 @@ import Data.Maybe (listToMaybe, fromMaybe)- import qualified Data.Map as Map- import qualified Data.Text.Encoding as TE- import Control.Arrow (first)-+import qualified Text.Blaze.Internal-+import qualified Yesod.Core.Widget-+import qualified Data.Foldable-+import qualified Text.Hamlet- - -- | Get a unique identifier.- newFormIdent :: Monad m => MForm m Text-@@ -210,7 +214,14 @@ postHelper form env = do-     let token =-             case reqToken req of-                 Nothing -> mempty--                Just n -> [shamlet|<input type=hidden name=#{tokenKey} value=#{n}>|]-+                Just n ->                 do { id-+                       ((Text.Blaze.Internal.preEscapedText . pack)-+                          "<input type=\"hidden\" name=\"");-+                     id (toHtml tokenKey);-+                     id ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"");-+                     id (toHtml n);-+                     id ((Text.Blaze.Internal.preEscapedText . pack) "\">") }-+-     m <- getYesod-     langs <- languages-     ((res, xml), enctype) <- runFormGeneric (form token) m langs env-@@ -279,7 +290,12 @@ getHelper :: MonadHandler m-           -> Maybe (Env, FileEnv)-           -> m (a, Enctype)- getHelper form env = do--    let fragment = [shamlet|<input type=hidden name=#{getKey}>|]-+    let fragment =     do { id-+           ((Text.Blaze.Internal.preEscapedText . pack)-+              "<input type=\"hidden\" name=\"");-+         id (toHtml getKey);-+         id ((Text.Blaze.Internal.preEscapedText . pack) "\">") }-+-     langs <- languages-     m <- getYesod-     runFormGeneric (form fragment) m langs env-@@ -293,19 +309,66 @@ renderTable, renderDivs, renderDivsNoLabels :: Monad m => FormRender m a- renderTable aform fragment = do-     (res, views') <- aFormToForm aform-     let views = views' []--    let widget = [whamlet|--$newline never--\#{fragment}--$forall view <- views--    <tr :fvRequired view:.required :not $ fvRequired view:.optional>--        <td>--            <label for=#{fvId view}>#{fvLabel view}--            $maybe tt <- fvTooltip view--                <div .tooltip>#{tt}--        <td>^{fvInput view}--        $maybe err <- fvErrors view--            <td .errors>#{err}--|]-+    let widget =     do { (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml fragment);-+         Data.Foldable.mapM_-+           (\ view_aagq-+              -> do { (Yesod.Core.Widget.asWidgetT . toWidget)-+                        ((Text.Blaze.Internal.preEscapedText . pack) "<tr");-+                      Text.Hamlet.condH-+                        [(or [fvRequired view_aagq, not (fvRequired view_aagq)], -+                          do { (Yesod.Core.Widget.asWidgetT . toWidget)-+                                 ((Text.Blaze.Internal.preEscapedText . pack) " class=\"");-+                               Text.Hamlet.condH-+                                 [(fvRequired view_aagq, -+                                   (Yesod.Core.Widget.asWidgetT . toWidget)-+                                     ((Text.Blaze.Internal.preEscapedText . pack) "required "))]-+                                 Nothing;-+                               Text.Hamlet.condH-+                                 [(not (fvRequired view_aagq), -+                                   (Yesod.Core.Widget.asWidgetT . toWidget)-+                                     ((Text.Blaze.Internal.preEscapedText . pack) "optional"))]-+                                 Nothing;-+                               (Yesod.Core.Widget.asWidgetT . toWidget)-+                                 ((Text.Blaze.Internal.preEscapedText . pack) "\"") })]-+                        Nothing;-+                      (Yesod.Core.Widget.asWidgetT . toWidget)-+                        ((Text.Blaze.Internal.preEscapedText . pack) "><td><label for=\"");-+                      (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml (fvId view_aagq));-+                      (Yesod.Core.Widget.asWidgetT . toWidget)-+                        ((Text.Blaze.Internal.preEscapedText . pack) "\">");-+                      (Yesod.Core.Widget.asWidgetT . toWidget)-+                        (toHtml (fvLabel view_aagq));-+                      (Yesod.Core.Widget.asWidgetT . toWidget)-+                        ((Text.Blaze.Internal.preEscapedText . pack) "</label>");-+                      Text.Hamlet.maybeH-+                        (fvTooltip view_aagq)-+                        (\ tt_aagr-+                           -> do { (Yesod.Core.Widget.asWidgetT . toWidget)-+                                     ((Text.Blaze.Internal.preEscapedText . pack)-+                                        "<div class=\"tooltip\">");-+                                   (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml tt_aagr);-+                                   (Yesod.Core.Widget.asWidgetT . toWidget)-+                                     ((Text.Blaze.Internal.preEscapedText . pack) "</div>") })-+                        Nothing;-+                      (Yesod.Core.Widget.asWidgetT . toWidget)-+                        ((Text.Blaze.Internal.preEscapedText . pack) "</td><td>");-+                      (Yesod.Core.Widget.asWidgetT . toWidget) (fvInput view_aagq);-+                      (Yesod.Core.Widget.asWidgetT . toWidget)-+                        ((Text.Blaze.Internal.preEscapedText . pack) "</td>");-+                      Text.Hamlet.maybeH-+                        (fvErrors view_aagq)-+                        (\ err_aags-+                           -> do { (Yesod.Core.Widget.asWidgetT . toWidget)-+                                     ((Text.Blaze.Internal.preEscapedText . pack)-+                                        "<td class=\"errors\">");-+                                   (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml err_aags);-+                                   (Yesod.Core.Widget.asWidgetT . toWidget)-+                                     ((Text.Blaze.Internal.preEscapedText . pack) "</td>") })-+                        Nothing;-+                      (Yesod.Core.Widget.asWidgetT . toWidget)-+                        ((Text.Blaze.Internal.preEscapedText . pack) "</tr>") })-+           views }-+-     return (res, widget)- - -- | render a field inside a div-@@ -318,19 +381,67 @@ renderDivsMaybeLabels :: Monad m => Bool -> FormRender m a- renderDivsMaybeLabels withLabels aform fragment = do-     (res, views') <- aFormToForm aform-     let views = views' []--    let widget = [whamlet|--$newline never--\#{fragment}--$forall view <- views--    <div :fvRequired view:.required :not $ fvRequired view:.optional>--        $if withLabels--                <label for=#{fvId view}>#{fvLabel view}--        $maybe tt <- fvTooltip view--            <div .tooltip>#{tt}--        ^{fvInput view}--        $maybe err <- fvErrors view--            <div .errors>#{err}--|]-+    let widget =     do { (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml fragment);-+         Data.Foldable.mapM_-+           (\ view_aagE-+              -> do { (Yesod.Core.Widget.asWidgetT . toWidget)-+                        ((Text.Blaze.Internal.preEscapedText . pack) "<div");-+                      Text.Hamlet.condH-+                        [(or [fvRequired view_aagE, not (fvRequired view_aagE)], -+                          do { (Yesod.Core.Widget.asWidgetT . toWidget)-+                                 ((Text.Blaze.Internal.preEscapedText . pack) " class=\"");-+                               Text.Hamlet.condH-+                                 [(fvRequired view_aagE, -+                                   (Yesod.Core.Widget.asWidgetT . toWidget)-+                                     ((Text.Blaze.Internal.preEscapedText . pack) "required "))]-+                                 Nothing;-+                               Text.Hamlet.condH-+                                 [(not (fvRequired view_aagE), -+                                   (Yesod.Core.Widget.asWidgetT . toWidget)-+                                     ((Text.Blaze.Internal.preEscapedText . pack) "optional"))]-+                                 Nothing;-+                               (Yesod.Core.Widget.asWidgetT . toWidget)-+                                 ((Text.Blaze.Internal.preEscapedText . pack) "\"") })]-+                        Nothing;-+                      (Yesod.Core.Widget.asWidgetT . toWidget)-+                        ((Text.Blaze.Internal.preEscapedText . pack) ">");-+                      Text.Hamlet.condH-+                        [(withLabels, -+                          do { (Yesod.Core.Widget.asWidgetT . toWidget)-+                                 ((Text.Blaze.Internal.preEscapedText . pack) "<label for=\"");-+                               (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml (fvId view_aagE));-+                               (Yesod.Core.Widget.asWidgetT . toWidget)-+                                 ((Text.Blaze.Internal.preEscapedText . pack) "\">");-+                               (Yesod.Core.Widget.asWidgetT . toWidget)-+                                 (toHtml (fvLabel view_aagE));-+                               (Yesod.Core.Widget.asWidgetT . toWidget)-+                                 ((Text.Blaze.Internal.preEscapedText . pack) "</label>") })]-+                        Nothing;-+                      Text.Hamlet.maybeH-+                        (fvTooltip view_aagE)-+                        (\ tt_aagF-+                           -> do { (Yesod.Core.Widget.asWidgetT . toWidget)-+                                     ((Text.Blaze.Internal.preEscapedText . pack)-+                                        "<div class=\"tooltip\">");-+                                   (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml tt_aagF);-+                                   (Yesod.Core.Widget.asWidgetT . toWidget)-+                                     ((Text.Blaze.Internal.preEscapedText . pack) "</div>") })-+                        Nothing;-+                      (Yesod.Core.Widget.asWidgetT . toWidget) (fvInput view_aagE);-+                      Text.Hamlet.maybeH-+                        (fvErrors view_aagE)-+                        (\ err_aagG-+                           -> do { (Yesod.Core.Widget.asWidgetT . toWidget)-+                                     ((Text.Blaze.Internal.preEscapedText . pack)-+                                        "<div class=\"errors\">");-+                                   (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml err_aagG);-+                                   (Yesod.Core.Widget.asWidgetT . toWidget)-+                                     ((Text.Blaze.Internal.preEscapedText . pack) "</div>") })-+                        Nothing;-+                      (Yesod.Core.Widget.asWidgetT . toWidget)-+                        ((Text.Blaze.Internal.preEscapedText . pack) "</div>") })-+           views }-+-     return (res, widget)- - -- | Render a form using Bootstrap-friendly shamlet syntax.-@@ -354,19 +465,63 @@ renderBootstrap aform fragment = do-     let views = views' []-         has (Just _) = True-         has Nothing  = False--    let widget = [whamlet|--                $newline never--                \#{fragment}--                $forall view <- views--                    <div .control-group .clearfix :fvRequired view:.required :not $ fvRequired view:.optional :has $ fvErrors view:.error>--                        <label .control-label for=#{fvId view}>#{fvLabel view}--                        <div .controls .input>--                            ^{fvInput view}--                            $maybe tt <- fvTooltip view--                                <span .help-block>#{tt}--                            $maybe err <- fvErrors view--                                <span .help-block>#{err}--                |]-+    let widget =     do { (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml fragment);-+         Data.Foldable.mapM_-+           (\ view_aagR-+              -> do { (Yesod.Core.Widget.asWidgetT . toWidget)-+                        ((Text.Blaze.Internal.preEscapedText . pack)-+                           "<div class=\"control-group clearfix ");-+                      Text.Hamlet.condH-+                        [(fvRequired view_aagR, -+                          (Yesod.Core.Widget.asWidgetT . toWidget)-+                            ((Text.Blaze.Internal.preEscapedText . pack) "required "))]-+                        Nothing;-+                      Text.Hamlet.condH-+                        [(not (fvRequired view_aagR), -+                          (Yesod.Core.Widget.asWidgetT . toWidget)-+                            ((Text.Blaze.Internal.preEscapedText . pack) "optional "))]-+                        Nothing;-+                      Text.Hamlet.condH-+                        [(has (fvErrors view_aagR), -+                          (Yesod.Core.Widget.asWidgetT . toWidget)-+                            ((Text.Blaze.Internal.preEscapedText . pack) "error"))]-+                        Nothing;-+                      (Yesod.Core.Widget.asWidgetT . toWidget)-+                        ((Text.Blaze.Internal.preEscapedText . pack)-+                           "\"><label class=\"control-label\" for=\"");-+                      (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml (fvId view_aagR));-+                      (Yesod.Core.Widget.asWidgetT . toWidget)-+                        ((Text.Blaze.Internal.preEscapedText . pack) "\">");-+                      (Yesod.Core.Widget.asWidgetT . toWidget)-+                        (toHtml (fvLabel view_aagR));-+                      (Yesod.Core.Widget.asWidgetT . toWidget)-+                        ((Text.Blaze.Internal.preEscapedText . pack)-+                           "</label><div class=\"controls input\">");-+                      (Yesod.Core.Widget.asWidgetT . toWidget) (fvInput view_aagR);-+                      Text.Hamlet.maybeH-+                        (fvTooltip view_aagR)-+                        (\ tt_aagS-+                           -> do { (Yesod.Core.Widget.asWidgetT . toWidget)-+                                     ((Text.Blaze.Internal.preEscapedText . pack)-+                                        "<span class=\"help-block\">");-+                                   (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml tt_aagS);-+                                   (Yesod.Core.Widget.asWidgetT . toWidget)-+                                     ((Text.Blaze.Internal.preEscapedText . pack) "</span>") })-+                        Nothing;-+                      Text.Hamlet.maybeH-+                        (fvErrors view_aagR)-+                        (\ err_aagT-+                           -> do { (Yesod.Core.Widget.asWidgetT . toWidget)-+                                     ((Text.Blaze.Internal.preEscapedText . pack)-+                                        "<span class=\"help-block\">");-+                                   (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml err_aagT);-+                                   (Yesod.Core.Widget.asWidgetT . toWidget)-+                                     ((Text.Blaze.Internal.preEscapedText . pack) "</span>") })-+                        Nothing;-+                      (Yesod.Core.Widget.asWidgetT . toWidget)-+                        ((Text.Blaze.Internal.preEscapedText . pack) "</div></div>") })-+           views }-+-     return (res, widget)- - check :: (Monad m, RenderMessage (HandlerSite m) msg)-diff --git a/Yesod/Form/Jquery.hs b/Yesod/Form/Jquery.hs-index 2c4ae25..4362188 100644---- a/Yesod/Form/Jquery.hs-+++ b/Yesod/Form/Jquery.hs-@@ -12,6 +12,18 @@ module Yesod.Form.Jquery-     , Default (..)-     ) where- -+import qualified Text.Blaze as Text.Blaze.Internal-+import qualified Text.Blaze.Internal-+import qualified Text.Hamlet-+import qualified Yesod.Core.Widget-+import qualified Text.Css-+import qualified Data.Monoid-+import qualified Data.Foldable-+import qualified Control.Monad-+import qualified Text.Julius-+import qualified Data.Text.Lazy.Builder-+import qualified Text.Shakespeare-+- import Yesod.Core- import Yesod.Form- import Data.Time (Day)-@@ -60,27 +72,59 @@ jqueryDayField jds = Field-               . readMay-               . unpack-     , fieldView = \theId name attrs val isReq -> do--        toWidget [shamlet|--$newline never--<input id="#{theId}" name="#{name}" *{attrs} type="date" :isReq:required="" value="#{showVal val}">--|]-+        toWidget  $         do { id-+               ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");-+             id (toHtml theId);-+             id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");-+             id (toHtml name);-+             id-+               ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"date\"");-+             Text.Hamlet.condH-+               [(isReq, -+                 id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]-+               Nothing;-+             id ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");-+             id (toHtml (showVal val));-+             id ((Text.Blaze.Internal.preEscapedText . pack) "\"");-+             id ((Text.Hamlet.attrsToHtml . Text.Hamlet.toAttributes) attrs);-+             id ((Text.Blaze.Internal.preEscapedText . pack) ">") }-+-         addScript' urlJqueryJs-         addScript' urlJqueryUiJs-         addStylesheet' urlJqueryUiCss--        toWidget [julius|--$(function(){--    var i = document.getElementById("#{rawJS theId}");--    if (i.type != "date") {--        $(i).datepicker({--            dateFormat:'yy-mm-dd',--            changeMonth:#{jsBool $ jdsChangeMonth jds},--            changeYear:#{jsBool $ jdsChangeYear jds},--            numberOfMonths:#{rawJS $ mos $ jdsNumberOfMonths jds},--            yearRange:#{toJSON $ jdsYearRange jds}--        });--    }--});--|]-+        toWidget  $         Text.Julius.asJavascriptUrl-+          (\ _render_a1lYC-+             -> mconcat-+                  [Text.Julius.Javascript-+                     ((Data.Text.Lazy.Builder.fromText-+                       . Text.Shakespeare.pack')-+                        "\n$(function(){\n    var i = document.getElementById(\""),-+                   Text.Julius.toJavascript (rawJS theId),-+                   Text.Julius.Javascript-+                     ((Data.Text.Lazy.Builder.fromText-+                       . Text.Shakespeare.pack')-+                        "\");\n    if (i.type != \"date\") {\n        $(i).datepicker({\n            dateFormat:'yy-mm-dd',\n            changeMonth:"),-+                   Text.Julius.toJavascript (jsBool (jdsChangeMonth jds)),-+                   Text.Julius.Javascript-+                     ((Data.Text.Lazy.Builder.fromText-+                       . Text.Shakespeare.pack')-+                        ",\n            changeYear:"),-+                   Text.Julius.toJavascript (jsBool (jdsChangeYear jds)),-+                   Text.Julius.Javascript-+                     ((Data.Text.Lazy.Builder.fromText-+                       . Text.Shakespeare.pack')-+                        ",\n            numberOfMonths:"),-+                   Text.Julius.toJavascript (rawJS (mos (jdsNumberOfMonths jds))),-+                   Text.Julius.Javascript-+                     ((Data.Text.Lazy.Builder.fromText-+                       . Text.Shakespeare.pack')-+                        ",\n            yearRange:"),-+                   Text.Julius.toJavascript (toJSON (jdsYearRange jds)),-+                   Text.Julius.Javascript-+                     ((Data.Text.Lazy.Builder.fromText-+                       . Text.Shakespeare.pack')-+                        "\n        });\n    }\n});")])-+-     , fieldEnctype = UrlEncoded-     }-   where-@@ -101,16 +145,47 @@ jqueryAutocompleteField :: (RenderMessage site FormMessage, YesodJquery site)- jqueryAutocompleteField src = Field-     { fieldParse = parseHelper $ Right-     , fieldView = \theId name attrs val isReq -> do--        toWidget [shamlet|--$newline never--<input id="#{theId}" name="#{name}" *{attrs} type="text" :isReq:required="" value="#{either id id val}" .autocomplete>--|]-+        toWidget  $         do { id-+               ((Text.Blaze.Internal.preEscapedText . pack)-+                  "<input class=\"autocomplete\" id=\"");-+             id (toHtml theId);-+             id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");-+             id (toHtml name);-+             id-+               ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"text\"");-+             Text.Hamlet.condH-+               [(isReq, -+                 id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]-+               Nothing;-+             id ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");-+             id (toHtml (either id id val));-+             id ((Text.Blaze.Internal.preEscapedText . pack) "\"");-+             id ((Text.Hamlet.attrsToHtml . Text.Hamlet.toAttributes) attrs);-+             id ((Text.Blaze.Internal.preEscapedText . pack) ">") }-+-         addScript' urlJqueryJs-         addScript' urlJqueryUiJs-         addStylesheet' urlJqueryUiCss--        toWidget [julius|--$(function(){$("##{rawJS theId}").autocomplete({source:"@{src}",minLength:2})});--|]-+        toWidget  $         Text.Julius.asJavascriptUrl-+          (\ _render_a1lYP-+             -> mconcat-+                  [Text.Julius.Javascript-+                     ((Data.Text.Lazy.Builder.fromText-+                       . Text.Shakespeare.pack')-+                        "\n$(function(){$(\"#"),-+                   Text.Julius.toJavascript (rawJS theId),-+                   Text.Julius.Javascript-+                     ((Data.Text.Lazy.Builder.fromText-+                       . Text.Shakespeare.pack')-+                        "\").autocomplete({source:\""),-+                   Text.Julius.Javascript-+                     (Data.Text.Lazy.Builder.fromText-+                        (_render_a1lYP src [])),-+                   Text.Julius.Javascript-+                     ((Data.Text.Lazy.Builder.fromText-+                       . Text.Shakespeare.pack')-+                        "\",minLength:2})});")])-+-     , fieldEnctype = UrlEncoded-     }- -diff --git a/Yesod/Form/MassInput.hs b/Yesod/Form/MassInput.hs-index 332eb66..5015e7b 100644---- a/Yesod/Form/MassInput.hs-+++ b/Yesod/Form/MassInput.hs-@@ -9,6 +9,16 @@ module Yesod.Form.MassInput-     , massTable-     ) where- -+import qualified Data.Text-+import qualified Text.Blaze as Text.Blaze.Internal-+import qualified Text.Blaze.Internal-+import qualified Text.Hamlet-+import qualified Yesod.Core.Widget-+import qualified Text.Css-+import qualified Data.Monoid-+import qualified Data.Foldable-+import qualified Control.Monad-+- import Yesod.Form.Types- import Yesod.Form.Functions- import Yesod.Form.Fields (boolField)-@@ -70,16 +80,28 @@ inputList label fixXml single mdef = formToAForm $ do-         { fvLabel = label-         , fvTooltip = Nothing-         , fvId = theId--        , fvInput = [whamlet|--$newline never--^{fixXml views}--<p>--    $forall xml <- xmls--        ^{xml}--    <input .count type=hidden name=#{countName} value=#{count}>--    <input type=checkbox name=#{addName}>--    Add another row--|]-+        , fvInput =         do { (Yesod.Core.Widget.asWidgetT . toWidget) (fixXml views);-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "<p>");-+             Data.Foldable.mapM_-+               (\ xml_aUS3 -> (Yesod.Core.Widget.asWidgetT . toWidget) xml_aUS3)-+               xmls;-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)-+                  "<input class=\"count\" type=\"hidden\" name=\"");-+             (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml countName);-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)-+                  "\" value=\"");-+             (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml count);-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)-+                  "\"><input type=\"checkbox\" name=\"");-+             (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml addName);-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)-+                  "\">Add another row</p>") }-+-         , fvErrors = Nothing-         , fvRequired = False-         }])-@@ -92,10 +114,14 @@ withDelete af = do-     deleteName <- newFormIdent-     (menv, _, _) <- ask-     res <- case menv >>= Map.lookup deleteName . fst of--        Just ("yes":_) -> return $ Left [whamlet|--$newline never--<input type=hidden name=#{deleteName} value=yes>--|]-+        Just ("yes":_) -> return $ Left  $         do { (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)-+                  "<input type=\"hidden\" name=\"");-+             (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml deleteName);-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)-+                  "\" value=\"yes\">") }-+-         _ -> do-             (_, xml2) <- aFormToForm $ areq boolField FieldSettings-                 { fsLabel = SomeMessage MsgDelete-@@ -121,32 +147,155 @@ fixme eithers =- massDivs, massTable-          :: [[FieldView site]]-          -> WidgetT site IO ()--massDivs viewss = [whamlet|--$newline never--$forall views <- viewss--    <fieldset>--        $forall view <- views--            <div :fvRequired view:.required :not $ fvRequired view:.optional>--                <label for=#{fvId view}>#{fvLabel view}--                $maybe tt <- fvTooltip view--                    <div .tooltip>#{tt}--                ^{fvInput view}--                $maybe err <- fvErrors view--                    <div .errors>#{err}--|]-+massDivs viewss = Data.Foldable.mapM_-+  (\ views_aUSm-+     -> do { (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)-+                  "<fieldset>");-+             Data.Foldable.mapM_-+               (\ view_aUSn-+                  -> do { (Yesod.Core.Widget.asWidgetT . toWidget)-+                            ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "<div");-+                          Text.Hamlet.condH-+                            [(or [fvRequired view_aUSn, not (fvRequired view_aUSn)], -+                              do { (Yesod.Core.Widget.asWidgetT . toWidget)-+                                     ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)-+                                        " class=\"");-+                                   Text.Hamlet.condH-+                                     [(fvRequired view_aUSn, -+                                       (Yesod.Core.Widget.asWidgetT . toWidget)-+                                         ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)-+                                            "required "))]-+                                     Nothing;-+                                   Text.Hamlet.condH-+                                     [(not (fvRequired view_aUSn), -+                                       (Yesod.Core.Widget.asWidgetT . toWidget)-+                                         ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)-+                                            "optional"))]-+                                     Nothing;-+                                   (Yesod.Core.Widget.asWidgetT . toWidget)-+                                     ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)-+                                        "\"") })]-+                            Nothing;-+                          (Yesod.Core.Widget.asWidgetT . toWidget)-+                            ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)-+                               "><label for=\"");-+                          (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml (fvId view_aUSn));-+                          (Yesod.Core.Widget.asWidgetT . toWidget)-+                            ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "\">");-+                          (Yesod.Core.Widget.asWidgetT . toWidget)-+                            (toHtml (fvLabel view_aUSn));-+                          (Yesod.Core.Widget.asWidgetT . toWidget)-+                            ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</label>");-+                          Text.Hamlet.maybeH-+                            (fvTooltip view_aUSn)-+                            (\ tt_aUSo-+                               -> do { (Yesod.Core.Widget.asWidgetT . toWidget)-+                                         ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)-+                                            "<div class=\"tooltip\">");-+                                       (Yesod.Core.Widget.asWidgetT . toWidget)-+                                         (toHtml tt_aUSo);-+                                       (Yesod.Core.Widget.asWidgetT . toWidget)-+                                         ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)-+                                            "</div>") })-+                            Nothing;-+                          (Yesod.Core.Widget.asWidgetT . toWidget) (fvInput view_aUSn);-+                          Text.Hamlet.maybeH-+                            (fvErrors view_aUSn)-+                            (\ err_aUSp-+                               -> do { (Yesod.Core.Widget.asWidgetT . toWidget)-+                                         ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)-+                                            "<div class=\"errors\">");-+                                       (Yesod.Core.Widget.asWidgetT . toWidget)-+                                         (toHtml err_aUSp);-+                                       (Yesod.Core.Widget.asWidgetT . toWidget)-+                                         ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)-+                                            "</div>") })-+                            Nothing;-+                          (Yesod.Core.Widget.asWidgetT . toWidget)-+                            ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</div>") })-+               views_aUSm;-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)-+                  "</fieldset>") })-+  viewss-+-+-+massTable viewss = Data.Foldable.mapM_-+  (\ views_aUSu-+     -> do { (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)-+                  "<fieldset><table>");-+             Data.Foldable.mapM_-+               (\ view_aUSv-+                  -> do { (Yesod.Core.Widget.asWidgetT . toWidget)-+                            ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "<tr");-+                          Text.Hamlet.condH-+                            [(or [fvRequired view_aUSv, not (fvRequired view_aUSv)], -+                              do { (Yesod.Core.Widget.asWidgetT . toWidget)-+                                     ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)-+                                        " class=\"");-+                                   Text.Hamlet.condH-+                                     [(fvRequired view_aUSv, -+                                       (Yesod.Core.Widget.asWidgetT . toWidget)-+                                         ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)-+                                            "required "))]-+                                     Nothing;-+                                   Text.Hamlet.condH-+                                     [(not (fvRequired view_aUSv), -+                                       (Yesod.Core.Widget.asWidgetT . toWidget)-+                                         ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)-+                                            "optional"))]-+                                     Nothing;-+                                   (Yesod.Core.Widget.asWidgetT . toWidget)-+                                     ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)-+                                        "\"") })]-+                            Nothing;-+                          (Yesod.Core.Widget.asWidgetT . toWidget)-+                            ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)-+                               "><td><label for=\"");-+                          (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml (fvId view_aUSv));-+                          (Yesod.Core.Widget.asWidgetT . toWidget)-+                            ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "\">");-+                          (Yesod.Core.Widget.asWidgetT . toWidget)-+                            (toHtml (fvLabel view_aUSv));-+                          (Yesod.Core.Widget.asWidgetT . toWidget)-+                            ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</label>");-+                          Text.Hamlet.maybeH-+                            (fvTooltip view_aUSv)-+                            (\ tt_aUSw-+                               -> do { (Yesod.Core.Widget.asWidgetT . toWidget)-+                                         ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)-+                                            "<div class=\"tooltip\">");-+                                       (Yesod.Core.Widget.asWidgetT . toWidget)-+                                         (toHtml tt_aUSw);-+                                       (Yesod.Core.Widget.asWidgetT . toWidget)-+                                         ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)-+                                            "</div>") })-+                            Nothing;-+                          (Yesod.Core.Widget.asWidgetT . toWidget)-+                            ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)-+                               "</td><td>");-+                          (Yesod.Core.Widget.asWidgetT . toWidget) (fvInput view_aUSv);-+                          (Yesod.Core.Widget.asWidgetT . toWidget)-+                            ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</td>");-+                          Text.Hamlet.maybeH-+                            (fvErrors view_aUSv)-+                            (\ err_aUSx-+                               -> do { (Yesod.Core.Widget.asWidgetT . toWidget)-+                                         ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)-+                                            "<td class=\"errors\">");-+                                       (Yesod.Core.Widget.asWidgetT . toWidget)-+                                         (toHtml err_aUSx);-+                                       (Yesod.Core.Widget.asWidgetT . toWidget)-+                                         ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)-+                                            "</td>") })-+                            Nothing;-+                          (Yesod.Core.Widget.asWidgetT . toWidget)-+                            ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</tr>") })-+               views_aUSu;-+             (Yesod.Core.Widget.asWidgetT . toWidget)-+               ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)-+                  "</table></fieldset>") })-+  viewss- --massTable viewss = [whamlet|--$newline never--$forall views <- viewss--    <fieldset>--        <table>--            $forall view <- views--                <tr :fvRequired view:.required :not $ fvRequired view:.optional>--                    <td>--                        <label for=#{fvId view}>#{fvLabel view}--                        $maybe tt <- fvTooltip view--                            <div .tooltip>#{tt}--                    <td>^{fvInput view}--                    $maybe err <- fvErrors view--                        <td .errors>#{err}--|]-diff --git a/Yesod/Form/Nic.hs b/Yesod/Form/Nic.hs-index 2862678..7b49b1a 100644---- a/Yesod/Form/Nic.hs-+++ b/Yesod/Form/Nic.hs-@@ -9,6 +9,19 @@ module Yesod.Form.Nic-     , nicHtmlField-     ) where- -+import qualified Text.Blaze as Text.Blaze.Internal-+import qualified Text.Blaze.Internal-+import qualified Text.Hamlet-+import qualified Yesod.Core.Widget-+import qualified Text.Css-+import qualified Data.Monoid-+import qualified Data.Foldable-+import qualified Control.Monad-+import qualified Text.Julius-+import qualified Data.Text.Lazy.Builder-+import qualified Text.Shakespeare-+-+- import Yesod.Core- import Yesod.Form- import Text.HTML.SanitizeXSS (sanitizeBalance)-@@ -27,20 +40,48 @@ nicHtmlField :: YesodNic site => Field (HandlerT site IO) Html- nicHtmlField = Field-     { fieldParse = \e _ -> return . Right . fmap (preEscapedToMarkup . sanitizeBalance) . listToMaybe $ e-     , fieldView = \theId name attrs val _isReq -> do--        toWidget [shamlet|--$newline never--    <textarea id="#{theId}" *{attrs} name="#{name}" .html>#{showVal val}--|]-+        toWidget  $         do { id-+               ((Text.Blaze.Internal.preEscapedText . pack)-+                  "<textarea class=\"html\" id=\"");-+             id (toHtml theId);-+             id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");-+             id (toHtml name);-+             id ((Text.Blaze.Internal.preEscapedText . pack) "\"");-+             id ((Text.Hamlet.attrsToHtml . Text.Hamlet.toAttributes) attrs);-+             id ((Text.Blaze.Internal.preEscapedText . pack) ">");-+             id (toHtml (showVal val));-+             id ((Text.Blaze.Internal.preEscapedText . pack) "</textarea>") }-+-         addScript' urlNicEdit-         master <- getYesod-         toWidget $-           case jsLoader master of--            BottomOfHeadBlocking -> [julius|--bkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance("#{rawJS theId}")});--|]--            _ -> [julius|--(function(){new nicEditor({fullPanel:true}).panelInstance("#{rawJS theId}")})();--|]-+            BottomOfHeadBlocking ->             Text.Julius.asJavascriptUrl-+              (\ _render_a1qhO-+                 -> Data.Monoid.mconcat-+                      [Text.Julius.Javascript-+                         ((Data.Text.Lazy.Builder.fromText-+                           . Text.Shakespeare.pack')-+                            "\nbkLib.onDomLoaded(function(){new nicEditor({true}).panelInstance(\""),-+                       Text.Julius.toJavascript (rawJS theId),-+                       Text.Julius.Javascript-+                         ((Data.Text.Lazy.Builder.fromText-+                           . Text.Shakespeare.pack')-+                            "\")});")])-+-+            _ ->             Text.Julius.asJavascriptUrl-+              (\ _render_a1qhS-+                 -> Data.Monoid.mconcat-+                      [Text.Julius.Javascript-+                         ((Data.Text.Lazy.Builder.fromText-+                           . Text.Shakespeare.pack')-+                            "\n(function(){new nicEditor({true}).panelInstance(\""),-+                       Text.Julius.toJavascript (rawJS theId),-+                       Text.Julius.Javascript-+                         ((Data.Text.Lazy.Builder.fromText-+                           . Text.Shakespeare.pack')-+                            "\")})();")])-+-     , fieldEnctype = UrlEncoded-     }-   where-diff --git a/yesod-form.cabal b/yesod-form.cabal-index 39fa680..88ed066 100644---- a/yesod-form.cabal-+++ b/yesod-form.cabal-@@ -19,6 +19,7 @@ library-                    , time                  >= 1.1.4-                    , hamlet                >= 1.1      && < 1.2-                    , shakespeare-css       >= 1.0      && < 1.1-+                   , shakespeare-                    , shakespeare-js        >= 1.0.2    && < 1.3-                    , persistent            >= 1.2      && < 1.3-                    , template-haskell--- -1.7.10.4-
− standalone/android/haskell-patches/yesod_001_hacked-up-for-Android.patch 
@@ -1,74 +0,0 @@-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-
standalone/android/install-haskell-packages view
@@ -35,12 +35,14 @@ 	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+	for patch in ../../haskell-patches/${pkg}_* ../../../no-th/haskell-patches/${pkg}_*; do+		if [ -e "$patch" ]; then+			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 		fi 	done 	cabalinstall "$@"
standalone/linux/README view
@@ -1,4 +1,5 @@-You can put this directory into your PATH, and use git-annex the same+You can put this directory into your PATH, or symlink the programs in this+directory to anyplace already in your PATH, and use git-annex the same as if you'd installed it using a package manager.  Or, you can use the runshell script in this directory to start a shell@@ -6,20 +7,14 @@ this bundle, including git, gpg, rsync, ssh, etc.  This should work on any Linux system of the appropriate architecture.-More or less. There are no external dependencies, except for glibc.-Any recent-ish version of glibc should work (2.13 is ok; so is 2.11).+More or less.   How it works: This directory tree contains a lot of libraries and programs-that git-annex needs. But it's not a chroot. Instead, runshell sets PATH-and LD_LIBRARY_PATH to point to the stuff in here.--The glibc libs are not included. Instead, it runs with the host system's-glibc. We trust that glibc's excellent backwards and forward compatability-is good enough to run binaries that were linked for a newer or older-version. Of course, this could fail. Particularly if the binaries try to-use some new glibc feature. But hopefully not.+that git-annex needs. But it's not a chroot. Instead, runshell sets a lot+of environment variables to cause files from here to be used, and a shim+around the binaries arranges for them to be run with the libraries in here. -Why not bundle glibc too? I've not gotten it to work! The host system's -ld-linux.so will be used for sure, as that's hardcoded into the binaries.-When I tried including libraries from glibc in here, everything segfaulted.+It shouldn't even be dependent on the host system's glibc libraries.+All that's needed is a kernel that supports the glibc included in this+bundle.
standalone/linux/git-annex view
@@ -1,5 +1,11 @@ #!/bin/sh-base="$(dirname "$0")"+link="$(readlink "$0")" || true+if [ -n "$link" ]; then+	base="$(dirname "$link")"+else+	base="$(dirname "$0")"+fi+ if [ ! -d "$base" ]; then 	echo "** cannot find base directory (I seem to be $0)" >&2 	exit 1
standalone/linux/git-annex-shell view
@@ -1,5 +1,11 @@ #!/bin/sh-base="$(dirname "$0")"+link="$(readlink "$0")" || true+if [ -n "$link" ]; then+	base="$(dirname "$link")"+else+	base="$(dirname "$0")"+fi+ if [ ! -d "$base" ]; then 	echo "** cannot find base directory (I seem to be $0)" >&2 	exit 1
standalone/linux/git-annex-webapp view
@@ -1,5 +1,11 @@ #!/bin/sh-base="$(dirname "$0")"+link="$(readlink "$0")" || true+if [ -n "$link" ]; then+	base="$(dirname "$link")"+else+	base="$(dirname "$0")"+fi+ if [ ! -d "$base" ]; then 	echo "** cannot find base directory (I seem to be $0)" >&2 	exit 1
− standalone/linux/glibc-libs 
@@ -1,43 +0,0 @@-libanl-.*.so-libutil-.*.so-libnss_hesiod-.*.so-libcrypt-.*.so-libnss_compat-.*.so-libm-.*.so-libr.so-libpcprofile.so-libnss_nis-.*.so-libSegFault.so-libpthread-.*.so-librt-.*.so-libnss_dns-.*.so-libdl-.*.so-libBrokenLocale-.*.so-libnss_nisplus-.*.so-libthread_db-1.0.so-libmemusage.so-libcidn-.*.so-libnss_files-.*.so-libnsl-.*.so-libc-.*.so-ld-.*.so-libnss_nis.so-libthread_db.so-libanl.so-libr.so-libnss_compat.so-libm.so-libnss_dns.so-libpthread.so-libc.so-librt.so-libcidn.so-libnss_nisplus.so-libnsl.so-libutil.so-libBrokenLocale.so-ld-linux.so-libnss_files.so-libdl.so-libnss_hesiod.so-libcrypt.so
+ standalone/linux/install-haskell-packages view
@@ -0,0 +1,96 @@+#!/bin/bash+# Bootstraps from an empty cabal (plus apt-get build-dep git-annex)+# to all the necessary haskell packages being installed, with the+# necessary patches to work on architectures that lack 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+#+# Future work: Convert to using the method used here:+# https://github.com/kaoskorobase/ghc-ios-cabal-scripts/++set -e++if [ ! -d ../haskell-patches ]; then+	cd standalone/linux+fi++cabalopts="$@"++cabalinstall () {+	echo cabal install "$@" "$cabalopts"+	eval cabal install "$@" "$cabalopts"+}++patched () {+	pkg=$1+	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 ../../../no-th/haskell-patches/${pkg}_*; do+		if [ -e "$patch" ]; then+			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+		fi+	done+	cabalinstall "$@"+	rm -rf $pkg*+	cd ..+}++installgitannexdeps () {+	pushd ../..+	echo cabal install --only-dependencies "$@"+	cabal install --only-dependencies "$@"+	popd+}++install_pkgs () {+	rm -rf tmp+	mkdir tmp+	cd tmp++	patched wai-app-static+	patched shakespeare+	patched shakespeare-css+	patched yesod-routes+	patched hamlet+	patched monad-logger+	patched shakespeare-i18n+	patched shakespeare-js+	patched yesod-core+	patched persistent+	patched persistent-template+	patched yesod+	patched process-conduit+	patched yesod-static+	patched yesod-form+	patched file-embed+	patched yesod-auth+	patched yesod+	patched generic-deriving+	patched profunctors+	patched reflection+	patched lens+	patched xml-hamlet+	patched shakespeare-text+	patched DAV++	cd ..++	installgitannexdeps+}++cabal update+install_pkgs
standalone/linux/runshell view
@@ -46,13 +46,21 @@ PATH=$base/bin:$PATH export PATH -ORIG_LD_LIBRARY_PATH="$LD_LIBRARY_PATH"-export ORIG_LD_LIBRARY_PATH+# This is used by the shim wrapper around each binary. for lib in $(cat $base/libdirs); do-	LD_LIBRARY_PATH="$base/$lib:$LD_LIBRARY_PATH"+	GIT_ANNEX_LD_LIBRARY_PATH="$base/$lib:$GIT_ANNEX_LD_LIBRARY_PATH" done-export LD_LIBRARY_PATH+export GIT_ANNEX_LD_LIBRARY_PATH+GIT_ANNEX_LINKER="$base/$(cat $base/linker)"+export GIT_ANNEX_LINKER+GIT_ANNEX_SHIMMED="$base/shimmed"+export GIT_ANNEX_SHIMMED +ORIG_GCONV_PATH="$GCONV_PATH"+export ORIG_GCONV_PATH+GCONV_PATH=$base/$(cat $base/gconvdir)+export GCONV_PATH+ ORIG_GIT_EXEC_PATH="$GIT_EXEC_PATH" export ORIG_GIT_EXEC_PATH GIT_EXEC_PATH=$base/git-core@@ -63,8 +71,14 @@ GIT_TEMPLATE_DIR="$base/templates" export GIT_TEMPLATE_DIR -# Indicate which variables were exported above.-GIT_ANNEX_STANDLONE_ENV="PATH LD_LIBRARY_PATH GIT_EXEC_PATH GIT_TEMPLATE_DIR"+ORIG_MANPATH="$MANPATH"+export ORIG_MANPATH+MANPATH="$base/usr/share/man:$MANPATH"+export MANPATH++# Indicate which variables were exported above and should be cleaned+# when running non-bundled programs.+GIT_ANNEX_STANDLONE_ENV="PATH GCONV_PATH GIT_EXEC_PATH GIT_TEMPLATE_DIR MANPATH" export GIT_ANNEX_STANDLONE_ENV  if [ "$1" ]; then
+ standalone/no-th/evilsplicer-headers.hs view
@@ -0,0 +1,34 @@+++{- This file was modified by the EvilSplicer, adding these headers,+ - and expanding Template Haskell. + -+ - ** DO NOT COMMIT ** + -}+import qualified Data.Monoid+import qualified Data.Set+import qualified Data.Set as Data.Set.Base+import qualified Data.Map+import qualified Data.Map as Data.Map.Base+import qualified Data.Foldable+import qualified Data.Text+import qualified Data.Text.Lazy.Builder+import qualified Text.Shakespeare+import qualified Text.Hamlet+import qualified Text.Julius+import qualified Text.Css+import qualified "blaze-markup" Text.Blaze.Internal+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 Network.Wai as Network.Wai.Internal+import qualified Yesod.Core.Types+{- End EvilSplicer headers. -}++
+ standalone/no-th/haskell-patches/DAV_build-without-TH.patch view
@@ -0,0 +1,414 @@+From 67e5fc4eb21fe801f7ab4c01b98c02912c5cb43f Mon Sep 17 00:00:00 2001+From: Joey Hess <joey@kitenet.net>+Date: Wed, 18 Dec 2013 05:44:10 +0000+Subject: [PATCH] expand TH++plus manual fixups+---+ DAV.cabal                       |  22 +---+ Network/Protocol/HTTP/DAV.hs    |  96 +++++++++++++----+ Network/Protocol/HTTP/DAV/TH.hs | 232 +++++++++++++++++++++++++++++++++++++++-+ 3 files changed, 307 insertions(+), 43 deletions(-)++diff --git a/DAV.cabal b/DAV.cabal+index 1f1eb1f..ea117ff 100644+--- a/DAV.cabal++++ b/DAV.cabal+@@ -36,27 +36,7 @@ library+                      , lifted-base >= 0.1+                      , monad-control+                      , mtl >= 2.1+-                     , transformers >= 0.3+-                     , transformers-base+-                     , 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-client >= 0.2+-                     , http-client-tls >= 0.2+-                     , http-types >= 0.7+-                     , lens >= 3.0+-                     , lifted-base >= 0.1+-                     , monad-control+-                     , mtl >= 2.1+-                     , network >= 2.3+-                     , optparse-applicative++                     , text+                      , transformers >= 0.3+                      , transformers-base+                      , xml-conduit >= 1.0          && <= 1.2+diff --git a/Network/Protocol/HTTP/DAV.hs b/Network/Protocol/HTTP/DAV.hs+index 9d8c070..5993fca 100644+--- a/Network/Protocol/HTTP/DAV.hs++++ b/Network/Protocol/HTTP/DAV.hs+@@ -77,7 +77,7 @@ 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 qualified Data.Text+ + import Data.CaseInsensitive (mk)+ +@@ -335,28 +335,84 @@ makeCollection url username password = choke $ evalDAVT url $ do+ 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+-|]++ 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")]]))]]+++ + 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">+-|]++        root = XML.Element "C:calendar-query" (Map.fromList [("xmlns:D", "DAV:"),("xmlns:C", "urn:ietf:params:xml:ns:caldav")])  $         concat++          [[XML.NodeElement++              (XML.Element++                 (XML.Name (Data.Text.pack "D:prop") Nothing Nothing)++                 Map.empty++                 (concat++                    [[XML.NodeElement++                        (XML.Element++                           (XML.Name++                              (Data.Text.pack "D:getetag") Nothing Nothing)++                           Map.empty++                           (concat []))],++                     [XML.NodeElement++                        (XML.Element++                           (XML.Name++                              (Data.Text.pack "C:calendar-data") Nothing Nothing)++                           Map.empty++                           (concat []))]]))],++           [XML.NodeElement++              (XML.Element++                 (XML.Name++                    (Data.Text.pack "C:filter") Nothing Nothing)++                 Map.empty++                 (concat++                    [[XML.NodeElement++                        (XML.Element++                           (XML.Name++                              (Data.Text.pack "C:comp-filter") Nothing Nothing)++                           (Map.insert++                              (XML.Name (Data.Text.pack "name") Nothing Nothing)++                              (Data.Text.concat++                                 [Data.Text.pack "VCALENDAR"])++                              Map.empty)++                           (concat []))]]))]]+++diff --git a/Network/Protocol/HTTP/DAV/TH.hs b/Network/Protocol/HTTP/DAV/TH.hs+index b072116..5a01bf9 100644+--- a/Network/Protocol/HTTP/DAV/TH.hs++++ b/Network/Protocol/HTTP/DAV/TH.hs+@@ -20,9 +20,11 @@+ + module Network.Protocol.HTTP.DAV.TH where+ +-import Control.Lens (makeLenses)++import Control.Lens+ import qualified Data.ByteString as B+ import Network.HTTP.Client (Manager, Request)++import qualified Control.Lens.Type++import qualified Data.Functor+ + data Depth = Depth0 | Depth1 | DepthInfinity+ instance Read Depth where+@@ -47,4 +49,230 @@ data DAVContext = DAVContext {+   , _lockToken :: Maybe B.ByteString+   , _userAgent :: B.ByteString+ }+-makeLenses ''DAVContext++allowedMethods :: Control.Lens.Type.Lens' DAVContext [B.ByteString]++allowedMethods++  _f_a2PF++  (DAVContext __allowedMethods'_a2PG++              __baseRequest_a2PI++              __basicusername_a2PJ++              __basicpassword_a2PK++              __complianceClasses_a2PL++              __depth_a2PM++              __httpManager_a2PN++              __lockToken_a2PO++              __userAgent_a2PP)++  = ((\ __allowedMethods_a2PH++        -> DAVContext++             __allowedMethods_a2PH++             __baseRequest_a2PI++             __basicusername_a2PJ++             __basicpassword_a2PK++             __complianceClasses_a2PL++             __depth_a2PM++             __httpManager_a2PN++             __lockToken_a2PO++             __userAgent_a2PP)++     Data.Functor.<$> (_f_a2PF __allowedMethods'_a2PG))++{-# INLINE allowedMethods #-}++baseRequest :: Control.Lens.Type.Lens' DAVContext Request++baseRequest++  _f_a2PQ++  (DAVContext __allowedMethods_a2PR++              __baseRequest'_a2PS++              __basicusername_a2PU++              __basicpassword_a2PV++              __complianceClasses_a2PW++              __depth_a2PX++              __httpManager_a2PY++              __lockToken_a2PZ++              __userAgent_a2Q0)++  = ((\ __baseRequest_a2PT++        -> DAVContext++             __allowedMethods_a2PR++             __baseRequest_a2PT++             __basicusername_a2PU++             __basicpassword_a2PV++             __complianceClasses_a2PW++             __depth_a2PX++             __httpManager_a2PY++             __lockToken_a2PZ++             __userAgent_a2Q0)++     Data.Functor.<$> (_f_a2PQ __baseRequest'_a2PS))++{-# INLINE baseRequest #-}++basicpassword :: Control.Lens.Type.Lens' DAVContext B.ByteString++basicpassword++  _f_a2Q1++  (DAVContext __allowedMethods_a2Q2++              __baseRequest_a2Q3++              __basicusername_a2Q4++              __basicpassword'_a2Q5++              __complianceClasses_a2Q7++              __depth_a2Q8++              __httpManager_a2Q9++              __lockToken_a2Qa++              __userAgent_a2Qb)++  = ((\ __basicpassword_a2Q6++        -> DAVContext++             __allowedMethods_a2Q2++             __baseRequest_a2Q3++             __basicusername_a2Q4++             __basicpassword_a2Q6++             __complianceClasses_a2Q7++             __depth_a2Q8++             __httpManager_a2Q9++             __lockToken_a2Qa++             __userAgent_a2Qb)++     Data.Functor.<$> (_f_a2Q1 __basicpassword'_a2Q5))++{-# INLINE basicpassword #-}++basicusername :: Control.Lens.Type.Lens' DAVContext B.ByteString++basicusername++  _f_a2Qc++  (DAVContext __allowedMethods_a2Qd++              __baseRequest_a2Qe++              __basicusername'_a2Qf++              __basicpassword_a2Qh++              __complianceClasses_a2Qi++              __depth_a2Qj++              __httpManager_a2Qk++              __lockToken_a2Ql++              __userAgent_a2Qm)++  = ((\ __basicusername_a2Qg++        -> DAVContext++             __allowedMethods_a2Qd++             __baseRequest_a2Qe++             __basicusername_a2Qg++             __basicpassword_a2Qh++             __complianceClasses_a2Qi++             __depth_a2Qj++             __httpManager_a2Qk++             __lockToken_a2Ql++             __userAgent_a2Qm)++     Data.Functor.<$> (_f_a2Qc __basicusername'_a2Qf))++{-# INLINE basicusername #-}++complianceClasses ::++  Control.Lens.Type.Lens' DAVContext [B.ByteString]++complianceClasses++  _f_a2Qn++  (DAVContext __allowedMethods_a2Qo++              __baseRequest_a2Qp++              __basicusername_a2Qq++              __basicpassword_a2Qr++              __complianceClasses'_a2Qs++              __depth_a2Qu++              __httpManager_a2Qv++              __lockToken_a2Qw++              __userAgent_a2Qx)++  = ((\ __complianceClasses_a2Qt++        -> DAVContext++             __allowedMethods_a2Qo++             __baseRequest_a2Qp++             __basicusername_a2Qq++             __basicpassword_a2Qr++             __complianceClasses_a2Qt++             __depth_a2Qu++             __httpManager_a2Qv++             __lockToken_a2Qw++             __userAgent_a2Qx)++     Data.Functor.<$> (_f_a2Qn __complianceClasses'_a2Qs))++{-# INLINE complianceClasses #-}++depth :: Control.Lens.Type.Lens' DAVContext (Maybe Depth)++depth++  _f_a2Qy++  (DAVContext __allowedMethods_a2Qz++              __baseRequest_a2QA++              __basicusername_a2QB++              __basicpassword_a2QC++              __complianceClasses_a2QD++              __depth'_a2QE++              __httpManager_a2QG++              __lockToken_a2QH++              __userAgent_a2QI)++  = ((\ __depth_a2QF++        -> DAVContext++             __allowedMethods_a2Qz++             __baseRequest_a2QA++             __basicusername_a2QB++             __basicpassword_a2QC++             __complianceClasses_a2QD++             __depth_a2QF++             __httpManager_a2QG++             __lockToken_a2QH++             __userAgent_a2QI)++     Data.Functor.<$> (_f_a2Qy __depth'_a2QE))++{-# INLINE depth #-}++httpManager :: Control.Lens.Type.Lens' DAVContext Manager++httpManager++  _f_a2QJ++  (DAVContext __allowedMethods_a2QK++              __baseRequest_a2QL++              __basicusername_a2QM++              __basicpassword_a2QN++              __complianceClasses_a2QO++              __depth_a2QP++              __httpManager'_a2QQ++              __lockToken_a2QS++              __userAgent_a2QT)++  = ((\ __httpManager_a2QR++        -> DAVContext++             __allowedMethods_a2QK++             __baseRequest_a2QL++             __basicusername_a2QM++             __basicpassword_a2QN++             __complianceClasses_a2QO++             __depth_a2QP++             __httpManager_a2QR++             __lockToken_a2QS++             __userAgent_a2QT)++     Data.Functor.<$> (_f_a2QJ __httpManager'_a2QQ))++{-# INLINE httpManager #-}++lockToken ::++  Control.Lens.Type.Lens' DAVContext (Maybe B.ByteString)++lockToken++  _f_a2QU++  (DAVContext __allowedMethods_a2QV++              __baseRequest_a2QW++              __basicusername_a2QX++              __basicpassword_a2QY++              __complianceClasses_a2QZ++              __depth_a2R0++              __httpManager_a2R1++              __lockToken'_a2R2++              __userAgent_a2R4)++  = ((\ __lockToken_a2R3++        -> DAVContext++             __allowedMethods_a2QV++             __baseRequest_a2QW++             __basicusername_a2QX++             __basicpassword_a2QY++             __complianceClasses_a2QZ++             __depth_a2R0++             __httpManager_a2R1++             __lockToken_a2R3++             __userAgent_a2R4)++     Data.Functor.<$> (_f_a2QU __lockToken'_a2R2))++{-# INLINE lockToken #-}++userAgent :: Control.Lens.Type.Lens' DAVContext B.ByteString++userAgent++  _f_a2R5++  (DAVContext __allowedMethods_a2R6++              __baseRequest_a2R7++              __basicusername_a2R8++              __basicpassword_a2R9++              __complianceClasses_a2Ra++              __depth_a2Rb++              __httpManager_a2Rc++              __lockToken_a2Rd++              __userAgent'_a2Re)++  = ((\ __userAgent_a2Rf++        -> DAVContext++             __allowedMethods_a2R6++             __baseRequest_a2R7++             __basicusername_a2R8++             __basicpassword_a2R9++             __complianceClasses_a2Ra++             __depth_a2Rb++             __httpManager_a2Rc++             __lockToken_a2Rd++             __userAgent_a2Rf)++     Data.Functor.<$> (_f_a2R5 __userAgent'_a2Re))++{-# INLINE userAgent #-}+-- +1.8.5.1+
+ standalone/no-th/haskell-patches/file-embed_remove-TH.patch view
@@ -0,0 +1,131 @@+From cd49a96991dc3dd8867038fa9d426a8ccdb25f8d Mon Sep 17 00:00:00 2001+From: Joey Hess <joey@kitenet.net>+Date: Tue, 17 Dec 2013 18:40:48 +0000+Subject: [PATCH] remove TH++---+ Data/FileEmbed.hs | 87 ++++---------------------------------------------------+ 1 file changed, 5 insertions(+), 82 deletions(-)++diff --git a/Data/FileEmbed.hs b/Data/FileEmbed.hs+index 5617493..ad92cdc 100644+--- a/Data/FileEmbed.hs++++ b/Data/FileEmbed.hs+@@ -17,13 +17,13 @@+ -- > {-# LANGUAGE TemplateHaskell #-}+ module Data.FileEmbed+     ( -- * Embed at compile time+-      embedFile+-    , embedOneFileOf+-    , embedDir+-    , getDir++   --   embedFile++    --, embedOneFileOf++    --, embedDir++      getDir+       -- * Inject into an executable+ #if MIN_VERSION_template_haskell(2,5,0)+-    , dummySpace++    --, dummySpace+ #endif+     , inject+     , injectFile+@@ -56,72 +56,11 @@ 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 single existing file in your source code+--- out of list a list of paths supplied.+---+--- > import qualified Data.ByteString+--- >+--- > myFile :: Data.ByteString.ByteString+--- > myFile = $(embedFile' [ "dirName/fileName", "src/dirName/fileName" ])+-embedOneFileOf :: [FilePath] -> Q Exp+-embedOneFileOf ps =+-  (runIO $ readExistingFile ps) >>= \ ( path, content ) -> do+-#if MIN_VERSION_template_haskell(2,7,0)+-    qAddDependentFile path+-#endif+-    bsToExp content+-  where+-    readExistingFile :: [FilePath] -> IO ( FilePath, B.ByteString )+-    readExistingFile xs = do+-      ys <- filterM doesFileExist xs+-      case ys of+-        (p:_) -> B.readFile p >>= \ c -> return ( p, c )+-        _ -> throw $ ErrorCall "Cannot find file to embed as resource"+-+--- | Embed a directory recursively 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+@@ -164,22 +103,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+-- +1.8.5.1+
+ standalone/no-th/haskell-patches/generic-deriving_remove-TH.patch view
@@ -0,0 +1,394 @@+From 9a41401d903f160e11d56fff35c24eb59d97885d Mon Sep 17 00:00:00 2001+From: Joey Hess <joey@kitenet.net>+Date: Tue, 17 Dec 2013 19:04:40 +0000+Subject: [PATCH] remove TH++---+ src/Generics/Deriving/TH.hs | 354 --------------------------------------------+ 1 file changed, 354 deletions(-)++diff --git a/src/Generics/Deriving/TH.hs b/src/Generics/Deriving/TH.hs+index 783cb65..9aab713 100644+--- a/src/Generics/Deriving/TH.hs++++ b/src/Generics/Deriving/TH.hs+@@ -19,18 +19,6 @@+ 
+ -- Adapted from Generics.Regular.TH
+ module Generics.Deriving.TH (
+-      
+-      deriveMeta
+-    , deriveData
+-    , deriveConstructors
+-    , deriveSelectors
+-
+-#if __GLASGOW_HASKELL__ < 701
+-    , deriveAll
+-    , deriveRepresentable0
+-    , deriveRep0
+-    , simplInstance
+-#endif
+   ) where
+ 
+ import Generics.Deriving.Base
+@@ -41,124 +29,6 @@ import Language.Haskell.TH.Syntax (Lift(..))+ import Data.List (intercalate)
+ import Control.Monad
+ 
+--- | Given the names of a generic class, a type to instantiate, a function in
+--- the class and the default implementation, generates the code for a basic
+--- generic instance.
+-simplInstance :: Name -> Name -> Name -> Name -> Q [Dec]
+-simplInstance cl ty fn df = do
+-  i <- reify (genRepName 0 ty)
+-  x <- newName "x"
+-  let typ = ForallT [PlainTV x] [] 
+-        ((foldl (\a -> AppT a . VarT . tyVarBndrToName) (ConT (genRepName 0 ty)) 
+-          (typeVariables i)) `AppT` (VarT x))
+-  fmap (: []) $ instanceD (cxt []) (conT cl `appT` conT ty)
+-    [funD fn [clause [] (normalB (varE df `appE` 
+-      (sigE (global 'undefined) (return typ)))) []]]
+-
+-
+--- | Given the type and the name (as string) for the type to derive,
+--- generate the 'Data' instance, the 'Constructor' instances, the 'Selector'
+--- instances, and the 'Representable0' instance.
+-deriveAll :: Name -> Q [Dec]
+-deriveAll n =
+-  do a <- deriveMeta n
+-     b <- deriveRepresentable0 n
+-     return (a ++ b)
+-
+--- | Given the type and the name (as string) for the type to derive,
+--- generate the 'Data' instance, the 'Constructor' instances, and the 'Selector'
+--- instances.
+-deriveMeta :: Name -> Q [Dec]
+-deriveMeta n =
+-  do a <- deriveData n
+-     b <- deriveConstructors n
+-     c <- deriveSelectors n
+-     return (a ++ b ++ c)
+-
+--- | Given a datatype name, derive a datatype and instance of class 'Datatype'.
+-deriveData :: Name -> Q [Dec]
+-deriveData = dataInstance
+-
+--- | Given a datatype name, derive datatypes and 
+--- instances of class 'Constructor'.
+-deriveConstructors :: Name -> Q [Dec]
+-deriveConstructors = constrInstance
+-
+--- | Given a datatype name, derive datatypes and instances of class 'Selector'.
+-deriveSelectors :: Name -> Q [Dec]
+-deriveSelectors = selectInstance
+-
+--- | Given the type and the name (as string) for the Representable0 type
+--- synonym to derive, generate the 'Representable0' instance.
+-deriveRepresentable0 :: Name -> Q [Dec]
+-deriveRepresentable0 n = do
+-    rep0 <- deriveRep0 n
+-    inst <- deriveInst n
+-    return $ rep0 ++ inst
+-
+--- | Derive only the 'Rep0' type synonym. Not needed if 'deriveRepresentable0'
+--- is used.
+-deriveRep0 :: Name -> Q [Dec]
+-deriveRep0 n = do
+-  i <- reify n
+-  fmap (:[]) $ tySynD (genRepName 0 n) (typeVariables i) (rep0Type n)
+-
+-deriveInst :: Name -> Q [Dec]
+-deriveInst t = do
+-  i <- reify t
+-  let typ q = foldl (\a -> AppT a . VarT . tyVarBndrToName) (ConT q) 
+-                (typeVariables i)
+-#if __GLASGOW_HASKELL__ >= 707
+-  let tyIns = TySynInstD ''Rep (TySynEqn [typ t] (typ (genRepName 0 t)))
+-#else
+-  let tyIns = TySynInstD ''Rep [typ t] (typ (genRepName 0 t))
+-#endif
+-  fcs <- mkFrom t 1 0 t
+-  tcs <- mkTo   t 1 0 t
+-  liftM (:[]) $
+-    instanceD (cxt []) (conT ''Generic `appT` return (typ t))
+-                         [return tyIns, funD 'from fcs, funD 'to tcs]
+-
+-
+-dataInstance :: Name -> Q [Dec]
+-dataInstance n = do
+-  i <- reify n
+-  case i of
+-    TyConI (DataD    _ n _ _ _) -> mkInstance n
+-    TyConI (NewtypeD _ n _ _ _) -> mkInstance n
+-    _ -> return []
+-  where
+-    mkInstance n = do
+-      ds <- mkDataData n
+-      is <- mkDataInstance n
+-      return $ [ds,is]
+-
+-constrInstance :: Name -> Q [Dec]
+-constrInstance n = do
+-  i <- reify n
+-  case i of
+-    TyConI (DataD    _ n _ cs _) -> mkInstance n cs
+-    TyConI (NewtypeD _ n _ c  _) -> mkInstance n [c]
+-    _ -> return []
+-  where
+-    mkInstance n cs = do
+-      ds <- mapM (mkConstrData n) cs
+-      is <- mapM (mkConstrInstance n) cs
+-      return $ ds ++ is
+-
+-selectInstance :: Name -> Q [Dec]
+-selectInstance n = do
+-  i <- reify n
+-  case i of
+-    TyConI (DataD    _ n _ cs _) -> mkInstance n cs
+-    TyConI (NewtypeD _ n _ c  _) -> mkInstance n [c]
+-    _ -> return []
+-  where
+-    mkInstance n cs = do
+-      ds <- mapM (mkSelectData n) cs
+-      is <- mapM (mkSelectInstance n) cs
+-      return $ concat (ds ++ is)
+-
+ typeVariables :: Info -> [TyVarBndr]
+ typeVariables (TyConI (DataD    _ _ tv _ _)) = tv
+ typeVariables (TyConI (NewtypeD _ _ tv _ _)) = tv
+@@ -179,233 +49,9 @@ genName = mkName . (++"_") . intercalate "_" . map nameBase+ genRepName :: Int -> Name -> Name
+ genRepName n = mkName . (++"_") . (("Rep" ++ show n) ++) . nameBase
+ 
+-mkDataData :: Name -> Q Dec
+-mkDataData n = dataD (cxt []) (genName [n]) [] [] []
+-
+-mkConstrData :: Name -> Con -> Q Dec
+-mkConstrData dt (NormalC n _) =
+-  dataD (cxt []) (genName [dt, n]) [] [] [] 
+-mkConstrData dt r@(RecC _ _) =
+-  mkConstrData dt (stripRecordNames r)
+-mkConstrData dt (InfixC t1 n t2) =
+-  mkConstrData dt (NormalC n [t1,t2])
+-
+-mkSelectData :: Name -> Con -> Q [Dec]
+-mkSelectData dt r@(RecC n fs) = return (map one fs)
+-  where one (f, _, _) = DataD [] (genName [dt, n, f]) [] [] []
+-mkSelectData dt _ = return []
+-
+-
+-mkDataInstance :: Name -> Q Dec
+-mkDataInstance n =
+-  instanceD (cxt []) (appT (conT ''Datatype) (conT $ genName [n]))
+-    [funD 'datatypeName [clause [wildP] (normalB (stringE (nameBase n))) []]
+-    ,funD 'moduleName   [clause [wildP] (normalB (stringE name)) []]]
+-  where
+-    name = maybe (error "Cannot fetch module name!") id (nameModule n)
+-
+-instance Lift Fixity where
+-  lift Prefix      = conE 'Prefix
+-  lift (Infix a n) = conE 'Infix `appE` [| a |] `appE` [| n |]
+-
+-instance Lift Associativity where
+-  lift LeftAssociative  = conE 'LeftAssociative
+-  lift RightAssociative = conE 'RightAssociative
+-  lift NotAssociative   = conE 'NotAssociative
+-
+-mkConstrInstance :: Name -> Con -> Q Dec
+-mkConstrInstance dt (NormalC n _) = mkConstrInstanceWith dt n []
+-mkConstrInstance dt (RecC    n _) = mkConstrInstanceWith dt n
+-      [ funD 'conIsRecord [clause [wildP] (normalB (conE 'True)) []]]
+-mkConstrInstance dt (InfixC t1 n t2) =
+-    do
+-      i <- reify n
+-      let fi = case i of
+-                 DataConI _ _ _ f -> convertFixity f
+-                 _ -> Prefix
+-      instanceD (cxt []) (appT (conT ''Constructor) (conT $ genName [dt, n]))
+-        [funD 'conName   [clause [wildP] (normalB (stringE (nameBase n))) []],
+-         funD 'conFixity [clause [wildP] (normalB [| fi |]) []]]
+-  where
+-    convertFixity (Fixity n d) = Infix (convertDirection d) n
+-    convertDirection InfixL = LeftAssociative
+-    convertDirection InfixR = RightAssociative
+-    convertDirection InfixN = NotAssociative
+-
+-mkConstrInstanceWith :: Name -> Name -> [Q Dec] -> Q Dec
+-mkConstrInstanceWith dt n extra = 
+-  instanceD (cxt []) (appT (conT ''Constructor) (conT $ genName [dt, n]))
+-    (funD 'conName [clause [wildP] (normalB (stringE (nameBase n))) []] : extra)
+-
+-mkSelectInstance :: Name -> Con -> Q [Dec]
+-mkSelectInstance dt r@(RecC n fs) = return (map one fs) where
+-  one (f, _, _) = 
+-    InstanceD ([]) (AppT (ConT ''Selector) (ConT $ genName [dt, n, f]))
+-      [FunD 'selName [Clause [WildP] 
+-        (NormalB (LitE (StringL (nameBase f)))) []]]
+-mkSelectInstance _ _ = return []
+-
+-rep0Type :: Name -> Q Type
+-rep0Type n =
+-    do
+-      -- runIO $ putStrLn $ "processing " ++ show n
+-      i <- reify n
+-      let b = case i of
+-                TyConI (DataD _ dt vs cs _) ->
+-                  (conT ''D1) `appT` (conT $ genName [dt]) `appT` 
+-                    (foldr1' sum (conT ''V1) 
+-                      (map (rep0Con (dt, map tyVarBndrToName vs)) cs))
+-                TyConI (NewtypeD _ dt vs c _) ->
+-                  (conT ''D1) `appT` (conT $ genName [dt]) `appT`
+-                    (rep0Con (dt, map tyVarBndrToName vs) c)
+-                TyConI (TySynD t _ _) -> error "type synonym?" 
+-                _ -> error "unknown construct" 
+-      --appT b (conT $ mkName (nameBase n))
+-      b where
+-    sum :: Q Type -> Q Type -> Q Type
+-    sum a b = conT ''(:+:) `appT` a `appT` b
+-
+-
+-rep0Con :: (Name, [Name]) -> Con -> Q Type
+-rep0Con (dt, vs) (NormalC n []) =
+-    conT ''C1 `appT` (conT $ genName [dt, n]) `appT` 
+-     (conT ''S1 `appT` conT ''NoSelector `appT` conT ''U1)
+-rep0Con (dt, vs) (NormalC n fs) =
+-    conT ''C1 `appT` (conT $ genName [dt, n]) `appT` 
+-     (foldr1 prod (map (repField (dt, vs) . snd) fs)) where
+-    prod :: Q Type -> Q Type -> Q Type
+-    prod a b = conT ''(:*:) `appT` a `appT` b
+-rep0Con (dt, vs) r@(RecC n []) =
+-    conT ''C1 `appT` (conT $ genName [dt, n]) `appT` conT ''U1
+-rep0Con (dt, vs) r@(RecC n fs) =
+-    conT ''C1 `appT` (conT $ genName [dt, n]) `appT` 
+-      (foldr1 prod (map (repField' (dt, vs) n) fs)) where
+-    prod :: Q Type -> Q Type -> Q Type
+-    prod a b = conT ''(:*:) `appT` a `appT` b
+-
+-rep0Con d (InfixC t1 n t2) = rep0Con d (NormalC n [t1,t2])
+-
+---dataDeclToType :: (Name, [Name]) -> Type
+---dataDeclToType (dt, vs) = foldl (\a b -> AppT a (VarT b)) (ConT dt) vs
+-
+-repField :: (Name, [Name]) -> Type -> Q Type
+---repField d t | t == dataDeclToType d = conT ''I
+-repField d t = conT ''S1 `appT` conT ''NoSelector `appT`
+-                 (conT ''Rec0 `appT` return t)
+-
+-repField' :: (Name, [Name]) -> Name -> (Name, Strict, Type) -> Q Type
+---repField' d ns (_, _, t) | t == dataDeclToType d = conT ''I
+-repField' (dt, vs) ns (f, _, t) = conT ''S1 `appT` conT (genName [dt, ns, f]) 
+-                                    `appT` (conT ''Rec0 `appT` return t)
+--- Note: we should generate Par0 too, at some point
+-
+-
+-mkFrom :: Name -> Int -> Int -> Name -> Q [Q Clause]
+-mkFrom ns m i n =
+-    do
+-      -- runIO $ putStrLn $ "processing " ++ show n
+-      let wrapE e = lrE m i e
+-      i <- reify n
+-      let b = case i of
+-                TyConI (DataD _ dt vs cs _) ->
+-                  zipWith (fromCon wrapE ns (dt, map tyVarBndrToName vs)
+-                    (length cs)) [0..] cs
+-                TyConI (NewtypeD _ dt vs c _) ->
+-                  [fromCon wrapE ns (dt, map tyVarBndrToName vs) 1 0 c]
+-                TyConI (TySynD t _ _) -> error "type synonym?" 
+-                  -- [clause [varP (field 0)] (normalB (wrapE $ conE 'K1 `appE` varE (field 0))) []]
+-                _ -> error "unknown construct"
+-      return b
+-
+-mkTo :: Name -> Int -> Int -> Name -> Q [Q Clause]
+-mkTo ns m i n =
+-    do
+-      -- runIO $ putStrLn $ "processing " ++ show n
+-      let wrapP p = lrP m i p
+-      i <- reify n
+-      let b = case i of
+-                TyConI (DataD _ dt vs cs _) ->
+-                  zipWith (toCon wrapP ns (dt, map tyVarBndrToName vs)
+-                    (length cs)) [0..] cs
+-                TyConI (NewtypeD _ dt vs c _) ->
+-                  [toCon wrapP ns (dt, map tyVarBndrToName vs) 1 0 c]
+-                TyConI (TySynD t _ _) -> error "type synonym?" 
+-                  -- [clause [wrapP $ conP 'K1 [varP (field 0)]] (normalB $ varE (field 0)) []]
+-                _ -> error "unknown construct" 
+-      return b
+-
+-fromCon :: (Q Exp -> Q Exp) -> Name -> (Name, [Name]) -> Int -> Int -> Con -> Q Clause
+-fromCon wrap ns (dt, vs) m i (NormalC cn []) =
+-  clause
+-    [conP cn []]
+-    (normalB $ appE (conE 'M1) $ wrap $ lrE m i $ appE (conE 'M1) $ 
+-      conE 'M1 `appE` (conE 'U1)) []
+-fromCon wrap ns (dt, vs) m i (NormalC cn fs) =
+-  -- runIO (putStrLn ("constructor " ++ show ix)) >>
+-  clause
+-    [conP cn (map (varP . field) [0..length fs - 1])]
+-    (normalB $ appE (conE 'M1) $ wrap $ lrE m i $ conE 'M1 `appE` 
+-      foldr1 prod (zipWith (fromField (dt, vs)) [0..] (map snd fs))) []
+-  where prod x y = conE '(:*:) `appE` x `appE` y
+-fromCon wrap ns (dt, vs) m i r@(RecC cn []) =
+-  clause
+-    [conP cn []]
+-    (normalB $ appE (conE 'M1) $ wrap $ lrE m i $ conE 'M1 `appE` (conE 'U1)) []
+-fromCon wrap ns (dt, vs) m i r@(RecC cn fs) =
+-  clause
+-    [conP cn (map (varP . field) [0..length fs - 1])]
+-    (normalB $ appE (conE 'M1) $ wrap $ lrE m i $ conE 'M1 `appE` 
+-      foldr1 prod (zipWith (fromField (dt, vs)) [0..] (map trd fs))) []
+-  where prod x y = conE '(:*:) `appE` x `appE` y
+-fromCon wrap ns (dt, vs) m i (InfixC t1 cn t2) =
+-  fromCon wrap ns (dt, vs) m i (NormalC cn [t1,t2])
+-
+-fromField :: (Name, [Name]) -> Int -> Type -> Q Exp
+---fromField (dt, vs) nr t | t == dataDeclToType (dt, vs) = conE 'I `appE` varE (field nr)
+-fromField (dt, vs) nr t = conE 'M1 `appE` (conE 'K1 `appE` varE (field nr))
+-
+-toCon :: (Q Pat -> Q Pat) -> Name -> (Name, [Name]) -> Int -> Int -> Con -> Q Clause
+-toCon wrap ns (dt, vs) m i (NormalC cn []) =
+-    clause
+-      [wrap $ conP 'M1 [lrP m i $ conP 'M1 [conP 'M1 [conP 'U1 []]]]]
+-      (normalB $ conE cn) []
+-toCon wrap ns (dt, vs) m i (NormalC cn fs) =
+-    -- runIO (putStrLn ("constructor " ++ show ix)) >>
+-    clause
+-      [wrap $ conP 'M1 [lrP m i $ conP 'M1
+-        [foldr1 prod (zipWith (toField (dt, vs)) [0..] (map snd fs))]]]
+-      (normalB $ foldl appE (conE cn) (map (varE . field) [0..length fs - 1])) []
+-  where prod x y = conP '(:*:) [x,y]
+-toCon wrap ns (dt, vs) m i r@(RecC cn []) =
+-    clause
+-      [wrap $ conP 'M1 [lrP m i $ conP 'M1 [conP 'U1 []]]]
+-      (normalB $ conE cn) []
+-toCon wrap ns (dt, vs) m i r@(RecC cn fs) =
+-    clause
+-      [wrap $ conP 'M1 [lrP m i $ conP 'M1
+-        [foldr1 prod (zipWith (toField (dt, vs)) [0..] (map trd fs))]]]
+-      (normalB $ foldl appE (conE cn) (map (varE . field) [0..length fs - 1])) []
+-  where prod x y = conP '(:*:) [x,y]
+-toCon wrap ns (dt, vs) m i (InfixC t1 cn t2) =
+-  toCon wrap ns (dt, vs) m i (NormalC cn [t1,t2])
+-
+-toField :: (Name, [Name]) -> Int -> Type -> Q Pat
+---toField (dt, vs) nr t | t == dataDeclToType (dt, vs) = conP 'I [varP (field nr)]
+-toField (dt, vs) nr t = conP 'M1 [conP 'K1 [varP (field nr)]]
+-
+-
+ field :: Int -> Name
+ field n = mkName $ "f" ++ show n
+ 
+-lrP :: Int -> Int -> (Q Pat -> Q Pat)
+-lrP 1 0 p = p
+-lrP m 0 p = conP 'L1 [p]
+-lrP m i p = conP 'R1 [lrP (m-1) (i-1) p]
+-
+-lrE :: Int -> Int -> (Q Exp -> Q Exp)
+-lrE 1 0 e = e
+-lrE m 0 e = conE 'L1 `appE` e
+-lrE m i e = conE 'R1 `appE` lrE (m-1) (i-1) e
+ 
+ trd (_,_,c) = c
+ 
+-- +1.8.5.1+
+ standalone/no-th/haskell-patches/hamlet_remove-TH.patch view
@@ -0,0 +1,365 @@+From f500a9e447912e68c12f011fe97b62e6a6c5c3ce Mon Sep 17 00:00:00 2001+From: Joey Hess <joey@kitenet.net>+Date: Tue, 17 Dec 2013 16:16:32 +0000+Subject: [PATCH] remove TH++---+ Text/Hamlet.hs | 310 ++++-----------------------------------------------------+ 1 file changed, 17 insertions(+), 293 deletions(-)++diff --git a/Text/Hamlet.hs b/Text/Hamlet.hs+index 4f873f4..10d8ba6 100644+--- a/Text/Hamlet.hs++++ b/Text/Hamlet.hs+@@ -11,34 +11,34 @@+ module Text.Hamlet+     ( -- * Plain HTML+       Html+-    , shamlet+-    , shamletFile+-    , xshamlet+-    , xshamletFile++    --, shamlet++    --, shamletFile++    --, xshamlet++    --, xshamletFile+       -- * Hamlet+     , HtmlUrl+-    , hamlet+-    , hamletFile+-    , xhamlet+-    , xhamletFile++    --, hamlet++    --, hamletFile++    --, xhamlet++    --, xhamletFile+       -- * I18N Hamlet+     , HtmlUrlI18n+-    , ihamlet+-    , ihamletFile++    --, ihamlet++    --, ihamletFile+       -- * Type classes+     , ToAttributes (..)+       -- * Internal, for making more+     , HamletSettings (..)+     , NewlineStyle (..)+-    , hamletWithSettings+-    , hamletFileWithSettings++    --, hamletWithSettings++    --, hamletFileWithSettings+     , defaultHamletSettings+     , xhtmlHamletSettings+-    , Env (..)+-    , HamletRules (..)+-    , hamletRules+-    , ihamletRules+-    , htmlRules++    --, Env (..)++    --, HamletRules (..)++    --, hamletRules++    --, ihamletRules++    --, htmlRules+     , CloseStyle (..)+       -- * Used by generated code+     , condH+@@ -100,47 +100,9 @@ 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+ +-bindingPattern :: Binding -> Q (Pat, [(Ident, Exp)])+-bindingPattern (BindAs i@(Ident s) b) = do+-    name <- newName s+-    (pattern, scope) <- bindingPattern b+-    return (AsP name pattern, (i, VarE name):scope)+-bindingPattern (BindVar i@(Ident s))+-    | all isDigit s = do+-        return (LitP $ IntegerL $ read s, [])+-    | otherwise = do+-        name <- newName s+-        return (VarP name, [(i, VarE name)])+-bindingPattern (BindTuple is) = do+-    (patterns, scopes) <- fmap unzip $ mapM bindingPattern is+-    return (TupP patterns, concat scopes)+-bindingPattern (BindList is) = do+-    (patterns, scopes) <- fmap unzip $ mapM bindingPattern is+-    return (ListP patterns, concat scopes)+-bindingPattern (BindConstr con is) = do+-    (patterns, scopes) <- fmap unzip $ mapM bindingPattern is+-    return (ConP (mkConName con) patterns, concat scopes)+-bindingPattern (BindRecord con fields wild) = do+-    let f (Ident field,b) =+-           do (p,s) <- bindingPattern b+-              return ((mkName field,p),s)+-    (patterns, scopes) <- fmap unzip $ mapM f fields+-    (patterns1, scopes1) <- if wild+-       then bindWildFields con $ map fst fields+-       else return ([],[])+-    return (RecP (mkConName con) (patterns++patterns1), concat scopes ++ scopes1)+-+ mkConName :: DataConstr -> Name+ mkConName = mkName . conToStr+ +@@ -148,248 +110,10 @@ conToStr :: DataConstr -> String+ conToStr (DCUnqualified (Ident x)) = x+ conToStr (DCQualified (Module xs) (Ident x)) = intercalate "." $ xs ++ [x]+ +--- Wildcards bind all of the unbound fields to variables whose name+--- matches the field name.+---+--- For example: data R = C { f1, f2 :: Int }+--- C {..}           is equivalent to   C {f1=f1, f2=f2}+--- C {f1 = a, ..}   is equivalent to   C {f1=a,  f2=f2}+--- C {f2 = a, ..}   is equivalent to   C {f1=f1, f2=a}+-bindWildFields :: DataConstr -> [Ident] -> Q ([(Name, Pat)], [(Ident, Exp)])+-bindWildFields conName fields = do+-  fieldNames <- recordToFieldNames conName+-  let available n     = nameBase n `notElem` map unIdent fields+-  let remainingFields = filter available fieldNames+-  let mkPat n = do+-        e <- newName (nameBase n)+-        return ((n,VarP e), (Ident (nameBase n), VarE e))+-  fmap unzip $ mapM mkPat remainingFields+-+--- Important note! reify will fail if the record type is defined in the+--- same module as the reify is used. This means quasi-quoted Hamlet+--- literals will not be able to use wildcards to match record types+--- defined in the same module.+-recordToFieldNames :: DataConstr -> Q [Name]+-recordToFieldNames conStr = do+-  -- use 'lookupValueName' instead of just using 'mkName' so we reify the+-  -- data constructor and not the type constructor if their names match.+-  Just conName                <- lookupValueName $ conToStr conStr+-  DataConI _ _ typeName _     <- reify conName+-  TyConI (DataD _ _ _ cons _) <- reify typeName+-  [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 ((specialOrIdent, VarE 'or):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 :: (Binding, [Doc]) -> Q Match+-    toMatch (idents, inside) = do+-        (pat, extraScope) <- bindingPattern idents+-        let scope' = extraScope ++ scope+-        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+-    , hrEmbed :: Env -> Exp -> Q Exp+-    }+-+-data Env = Env+-    { urlRender :: Maybe ((Exp -> Q Exp) -> Q Exp)+-    , 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+-+-strToExp :: String -> Exp+-strToExp s@(c:_)+-    | all isDigit s = LitE $ IntegerL $ read s+-    | isUpper c = ConE $ mkName s+-    | otherwise = VarE $ mkName s+-strToExp "" = error "strToExp on empty string"+ + -- | Checks for truth in the left value in each pair in the first argument. If+ -- a true exists, then the corresponding right action is performed. Only the+-- +1.8.5.1+
+ standalone/no-th/haskell-patches/lens_no-TH.patch view
@@ -0,0 +1,175 @@+From 2b5fa1851a84f58b43e7c4224bd5695a32a80de9 Mon Sep 17 00:00:00 2001+From: dummy <dummy@example.com>+Date: Wed, 18 Dec 2013 03:27:54 +0000+Subject: [PATCH] avoid TH++---+ lens.cabal                             | 13 +------------+ src/Control/Lens.hs                    |  4 ++--+ src/Control/Lens/Internal/Exception.hs | 30 ------------------------------+ src/Control/Lens/Prism.hs              |  2 --+ 4 files changed, 3 insertions(+), 46 deletions(-)++diff --git a/lens.cabal b/lens.cabal+index 8477892..a6ac7a5 100644+--- a/lens.cabal++++ b/lens.cabal+@@ -10,7 +10,7 @@ stability:     provisional+ homepage:      http://github.com/ekmett/lens/+ bug-reports:   http://github.com/ekmett/lens/issues+ copyright:     Copyright (C) 2012-2013 Edward A. Kmett+-build-type:    Custom++build-type:    Simple+ tested-with:   GHC == 7.6.3+ synopsis:      Lenses, Folds and Traversals+ description:+@@ -173,7 +173,6 @@ library+     containers                >= 0.4.0    && < 0.6,+     distributive              >= 0.3      && < 1,+     filepath                  >= 1.2.0.0  && < 1.4,+-    generic-deriving          >= 1.4      && < 1.7,+     ghc-prim,+     hashable                  >= 1.1.2.3  && < 1.3,+     MonadCatchIO-transformers >= 0.3      && < 0.4,+@@ -235,14 +234,12 @@ library+     Control.Lens.Review+     Control.Lens.Setter+     Control.Lens.Simple+-    Control.Lens.TH+     Control.Lens.Traversal+     Control.Lens.Tuple+     Control.Lens.Type+     Control.Lens.Wrapped+     Control.Lens.Zipper+     Control.Lens.Zoom+-    Control.Monad.Error.Lens+     Control.Parallel.Strategies.Lens+     Control.Seq.Lens+     Data.Array.Lens+@@ -266,12 +263,8 @@ library+     Data.Typeable.Lens+     Data.Vector.Lens+     Data.Vector.Generic.Lens+-    Generics.Deriving.Lens+-    GHC.Generics.Lens+     System.Exit.Lens+     System.FilePath.Lens+-    System.IO.Error.Lens+-    Language.Haskell.TH.Lens+     Numeric.Lens+ +   if flag(safe)+@@ -370,7 +363,6 @@ test-suite doctests+       deepseq,+       doctest        >= 0.9.1,+       filepath,+-      generic-deriving,+       mtl,+       nats,+       parallel,+@@ -396,7 +388,6 @@ benchmark plated+     comonad,+     criterion,+     deepseq,+-    generic-deriving,+     lens,+     transformers+ +@@ -431,7 +422,6 @@ benchmark unsafe+     comonads-fd,+     criterion,+     deepseq,+-    generic-deriving,+     lens,+     transformers+ +@@ -448,6 +438,5 @@ benchmark zipper+     comonads-fd,+     criterion,+     deepseq,+-    generic-deriving,+     lens,+     transformers+diff --git a/src/Control/Lens.hs b/src/Control/Lens.hs+index f7c6548..125153e 100644+--- a/src/Control/Lens.hs++++ b/src/Control/Lens.hs+@@ -59,7 +59,7 @@ module Control.Lens+   , module Control.Lens.Review+   , module Control.Lens.Setter+   , module Control.Lens.Simple+-#ifndef DISABLE_TEMPLATE_HASKELL++#if 0+   , module Control.Lens.TH+ #endif+   , module Control.Lens.Traversal+@@ -89,7 +89,7 @@ import Control.Lens.Reified+ import Control.Lens.Review+ import Control.Lens.Setter+ import Control.Lens.Simple+-#ifndef DISABLE_TEMPLATE_HASKELL++#if 0+ import Control.Lens.TH+ #endif+ import Control.Lens.Traversal+diff --git a/src/Control/Lens/Internal/Exception.hs b/src/Control/Lens/Internal/Exception.hs+index 387203e..bb1ca10 100644+--- a/src/Control/Lens/Internal/Exception.hs++++ b/src/Control/Lens/Internal/Exception.hs+@@ -128,18 +128,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 +147,3 @@ 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/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+-- +1.8.5.1+
+ standalone/no-th/haskell-patches/monad-logger_remove-TH.patch view
@@ -0,0 +1,150 @@+From 08aa9d495cb486c45998dfad95518c646b5fa8cc Mon Sep 17 00:00:00 2001+From: Joey Hess <joey@kitenet.net>+Date: Tue, 17 Dec 2013 16:24:31 +0000+Subject: [PATCH] remove TH++---+ Control/Monad/Logger.hs | 109 ++++++++++--------------------------------------+ 1 file changed, 21 insertions(+), 88 deletions(-)++diff --git a/Control/Monad/Logger.hs b/Control/Monad/Logger.hs+index be756d7..d4979f8 100644+--- a/Control/Monad/Logger.hs++++ b/Control/Monad/Logger.hs+@@ -31,31 +31,31 @@ module Control.Monad.Logger+     , withChannelLogger+     , NoLoggingT (..)+     -- * TH logging+-    , logDebug+-    , logInfo+-    , logWarn+-    , logError+-    , logOther++    --, logDebug++    --, logInfo++    --, logWarn++    --, logError++    --, logOther+     -- * TH logging with source+-    , logDebugS+-    , logInfoS+-    , logWarnS+-    , logErrorS+-    , logOtherS++    --, logDebugS++    --, logInfoS++    --, logWarnS++    --, logErrorS++    --, logOtherS+     -- * TH util+-    , liftLoc++    -- , liftLoc+     -- * Non-TH logging+-    , logDebugN+-    , logInfoN+-    , logWarnN+-    , logErrorN+-    , logOtherN++    --, logDebugN++    --, logInfoN++    --, logWarnN++    --, logErrorN++    --, logOtherN+     -- * Non-TH logging with source+-    , logDebugNS+-    , logInfoNS+-    , logWarnNS+-    , logErrorNS+-    , logOtherNS++    --, logDebugNS++    --, logInfoNS++    --, logWarnNS++    --, logErrorNS++    --, logOtherNS+     ) where+ + import Language.Haskell.TH.Syntax (Lift (lift), Q, Exp, Loc (..), qLocation)+@@ -115,13 +115,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+@@ -152,66 +145,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) (pack "") $(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+-+--- | Lift a location into an Exp.+---+--- Since 0.3.1+-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:+---+--- > $logDebugS "SomeSource" "This is a debug log message"+-logDebugS :: Q Exp+-logDebugS = [|\a b -> monadLoggerLog $(qLocation >>= liftLoc) a LevelDebug (b :: Text)|]+-+--- | See 'logDebugS'+-logInfoS :: Q Exp+-logInfoS = [|\a b -> monadLoggerLog $(qLocation >>= liftLoc) a LevelInfo (b :: Text)|]+--- | See 'logDebugS'+-logWarnS :: Q Exp+-logWarnS = [|\a b -> monadLoggerLog $(qLocation >>= liftLoc) a LevelWarn (b :: Text)|]+--- | See 'logDebugS'+-logErrorS :: Q Exp+-logErrorS = [|\a b -> monadLoggerLog $(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:+---+--- > $logOtherS "SomeSource" "My new level" "This is a log message"+-logOtherS :: Q Exp+-logOtherS = [|\src level msg -> monadLoggerLog $(qLocation >>= liftLoc) src (LevelOther level) (msg :: Text)|]+-+ -- | Monad transformer that disables logging.+ --+ -- Since 0.2.4+-- +1.8.5.1+
+ standalone/no-th/haskell-patches/persistent-template_stub-out.patch view
@@ -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+
+ standalone/no-th/haskell-patches/persistent_1.1.5.1_0001-disable-TH.patch view
@@ -0,0 +1,41 @@+From efd18199fa245e51e6137036062ded8b0b26f78c Mon Sep 17 00:00:00 2001+From: dummy <dummy@example.com>+Date: Tue, 17 Dec 2013 18:08:22 +0000+Subject: [PATCH] disable TH++---+ Database/Persist/Sql/Raw.hs | 4 +---+ 1 file changed, 1 insertion(+), 3 deletions(-)++diff --git a/Database/Persist/Sql/Raw.hs b/Database/Persist/Sql/Raw.hs+index 73189dd..d432790 100644+--- a/Database/Persist/Sql/Raw.hs++++ b/Database/Persist/Sql/Raw.hs+@@ -11,7 +11,7 @@ import Data.IORef (writeIORef, readIORef, newIORef)+ import Control.Exception (throwIO)+ import Control.Monad (when, liftM)+ import Data.Text (Text, pack)+-import Control.Monad.Logger (logDebugS)++--import Control.Monad.Logger (logDebugS)+ import Data.Int (Int64)+ import Control.Monad.Trans.Class (lift)+ import qualified Data.Text as T+@@ -22,7 +22,6 @@ rawQuery :: (MonadSqlPersist m, MonadResource m)+          -> [PersistValue]+          -> Source m [PersistValue]+ rawQuery sql vals = do+-    lift $ $logDebugS (pack "SQL") $ pack $ show sql ++ " " ++ show vals+     conn <- lift askSqlConn+     bracketP+         (getStmtConn conn sql)+@@ -34,7 +33,6 @@ rawExecute x y = liftM (const ()) $ rawExecuteCount x y+ + rawExecuteCount :: MonadSqlPersist m => Text -> [PersistValue] -> m Int64+ rawExecuteCount sql vals = do+-    $logDebugS (pack "SQL") $ pack $ show sql ++ " " ++ show vals+     stmt <- getStmt sql+     res <- liftIO $ stmtExecute stmt vals+     liftIO $ stmtReset stmt+-- +1.8.5.1+
+ standalone/no-th/haskell-patches/process-conduit_avoid-TH.patch view
@@ -0,0 +1,24 @@+From c9f40fae5f7f44c7c28b243bf924606ef4f26700 Mon Sep 17 00:00:00 2001+From: Joey Hess <joey@kitenet.net>+Date: Wed, 18 Dec 2013 04:17:59 +0000+Subject: [PATCH] avoid TH++---+ process-conduit.cabal | 1 -+ 1 file changed, 1 deletion(-)++diff --git a/process-conduit.cabal b/process-conduit.cabal+index c917d90..4410e2c 100644+--- a/process-conduit.cabal++++ b/process-conduit.cabal+@@ -24,7 +24,6 @@ source-repository head+ 
+ library
+   exposed-modules:     Data.Conduit.Process
+-                       System.Process.QQ
+   
+   build-depends:       base             == 4.*
+                      , template-haskell >= 2.4
+-- +1.8.5.1+
+ standalone/no-th/haskell-patches/profunctors_3.3-0001-fix-cross-build.patch view
@@ -0,0 +1,26 @@+From 392602f5ff14c0b5a801397d075ddcbcd890aa83 Mon Sep 17 00:00:00 2001+From: Joey Hess <joey@kitenet.net>+Date: Thu, 18 Apr 2013 17:50:59 -0400+Subject: [PATCH] fix cross build++---+ src/Data/Profunctor/Unsafe.hs | 3 ---+ 1 file changed, 3 deletions(-)++diff --git a/src/Data/Profunctor/Unsafe.hs b/src/Data/Profunctor/Unsafe.hs+index 025c7c4..0249274 100644+--- a/src/Data/Profunctor/Unsafe.hs++++ b/src/Data/Profunctor/Unsafe.hs+@@ -40,9 +40,6 @@ import Data.Tagged+ import Prelude hiding (id,(.),sequence)+ import Unsafe.Coerce+ +-{-# ANN module "Hlint: ignore Redundant lambda" #-}+-{-# ANN module "Hlint: ignore Collapse lambdas" #-}+-+ infixr 9 #.+ infixl 8 .#+ +-- +1.8.2.rc3+
+ standalone/no-th/haskell-patches/reflection_remove-TH.patch view
@@ -0,0 +1,113 @@+From 22c68b43dce437b3c22956f5a968f1b886e60e0c Mon Sep 17 00:00:00 2001+From: Joey Hess <joey@kitenet.net>+Date: Tue, 17 Dec 2013 19:15:16 +0000+Subject: [PATCH] remove TH++---+ fast/Data/Reflection.hs | 80 +------------------------------------------------+ 1 file changed, 1 insertion(+), 79 deletions(-)++diff --git a/fast/Data/Reflection.hs b/fast/Data/Reflection.hs+index 119d773..cf99efa 100644+--- a/fast/Data/Reflection.hs++++ b/fast/Data/Reflection.hs+@@ -58,7 +58,7 @@ module Data.Reflection+     , Given(..)+     , give+     -- * Template Haskell reflection+-    , int, nat++    --, int, nat+     -- * Useful compile time naturals+     , Z, D, SD, PD+     ) where+@@ -151,87 +151,9 @@ instance Reifies n Int => Reifies (PD n) Int where+   reflect = (\n -> n + n - 1) <$> retagPD reflect+   {-# INLINE reflect #-}+ +--- | This can be used to generate a template haskell splice for a type level version of a given 'int'.+---+--- This does not use GHC TypeLits, instead it generates a numeric type by hand similar to the ones used+--- in the \"Functional Pearl: Implicit Configurations\" paper by Oleg Kiselyov and Chung-Chieh Shan.+-int :: Int -> TypeQ+-int n = case quotRem n 2 of+-  (0, 0) -> conT ''Z+-  (q,-1) -> conT ''PD `appT` int q+-  (q, 0) -> conT ''D  `appT` int q+-  (q, 1) -> conT ''SD `appT` int q+-  _     -> error "ghc is bad at math"+-+--- | This is a restricted version of 'int' that can only generate natural numbers. Attempting to generate+--- a negative number results in a compile time error. Also the resulting sequence will consist entirely of+--- Z, D, and SD constructors representing the number in zeroless binary.+-nat :: Int -> TypeQ+-nat n+-  | n >= 0 = int n+-  | otherwise = error "nat: negative"+-+-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL < 704+-instance Show (Q a)+-instance Eq (Q a)+-#endif+-instance Num a => Num (Q a) where+-  (+) = liftM2 (+)+-  (*) = liftM2 (*)+-  (-) = liftM2 (-)+-  negate = fmap negate+-  abs = fmap abs+-  signum = fmap signum+-  fromInteger = return . fromInteger+-+-instance Fractional a => Fractional (Q a) where+-  (/) = liftM2 (/)+-  recip = fmap recip+-  fromRational = return . fromRational+-+--- | This permits the use of $(5) as a type splice.+-instance Num Type where+-#ifdef USE_TYPE_LITS+-  a + b = AppT (AppT (VarT ''(+)) a) b+-  a * b = AppT (AppT (VarT ''(*)) a) b+-#if MIN_VERSION_base(4,8,0)+-  a - b = AppT (AppT (VarT ''(-)) a) b+-#else+-  (-) = error "Type.(-): undefined"+-#endif+-  fromInteger = LitT . NumTyLit+-#else+-  (+) = error "Type.(+): undefined"+-  (*) = error "Type.(*): undefined"+-  (-) = error "Type.(-): undefined"+-  fromInteger n = case quotRem n 2 of+-      (0, 0) -> ConT ''Z+-      (q,-1) -> ConT ''PD `AppT` fromInteger q+-      (q, 0) -> ConT ''D  `AppT` fromInteger q+-      (q, 1) -> ConT ''SD `AppT` fromInteger q+-      _ -> error "ghc is bad at math"+-#endif+-  abs = error "Type.abs"+-  signum = error "Type.signum"+-+ plus, times, minus :: Num a => a -> a -> a+ plus = (+)+ times = (*)+ minus = (-)+ fract :: Fractional a => a -> a -> a+ fract = (/)+-+--- | This permits the use of $(5) as an expression splice.+-instance Num Exp where+-  a + b = AppE (AppE (VarE 'plus) a) b+-  a * b = AppE (AppE (VarE 'times) a) b+-  a - b = AppE (AppE (VarE 'minus) a) b+-  negate = AppE (VarE 'negate)+-  signum = AppE (VarE 'signum)+-  abs = AppE (VarE 'abs)+-  fromInteger = LitE . IntegerL+-+-instance Fractional Exp where+-  a / b = AppE (AppE (VarE 'fract) a) b+-  recip = AppE (VarE 'recip)+-  fromRational = LitE . RationalL+-- +1.8.5.1+
+ standalone/no-th/haskell-patches/shakespeare-i18n_0001-remove-TH.patch view
@@ -0,0 +1,215 @@+From 57ad7d1512a3144fd0b00f9796d5fd9e0ea86852 Mon Sep 17 00:00:00 2001+From: Joey Hess <joey@kitenet.net>+Date: Tue, 17 Dec 2013 16:30:59 +0000+Subject: [PATCH] remove TH++---+ Text/Shakespeare/I18N.hs | 178 ++---------------------------------------------+ 1 file changed, 4 insertions(+), 174 deletions(-)++diff --git a/Text/Shakespeare/I18N.hs b/Text/Shakespeare/I18N.hs+index 2077914..2289214 100644+--- a/Text/Shakespeare/I18N.hs++++ b/Text/Shakespeare/I18N.hs+@@ -51,10 +51,10 @@+ --+ -- You can also adapt those instructions for use with other systems.+ module Text.Shakespeare.I18N+-    ( mkMessage+-    , mkMessageFor+-    , mkMessageVariant+-    , RenderMessage (..)++    --( mkMessage++    --, mkMessageFor++    ---, mkMessageVariant++    ( RenderMessage (..)+     , ToMessage (..)+     , SomeMessage (..)+     , Lang+@@ -105,143 +105,6 @@ instance RenderMessage master Text where+ -- | an RFC1766 / ISO 639-1 language code (eg, @fr@, @en-GB@, etc).+ type Lang = Text+ +--- |generate translations from translation files+---+--- This function will:+---+---  1. look in the supplied subdirectory for files ending in @.msg@+---+---  2. generate a type based on the constructors found+---+---  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+@@ -257,39 +120,6 @@ varName a y =+     upper (x:xs) = toUpper x : xs+     upper [] = []+ +-checkDef :: [SDef] -> [Def] -> Q ()+-checkDef x y =+-    go (sortBy (comparing sconstr) x) (sortBy (comparing constr) y)+-  where+-    go _ [] = return ()+-    go [] (b:_) = error $ "Extra message constructor: " ++ constr b+-    go (a:as) (b:bs)+-        | sconstr a < constr b = go as (b:bs)+-        | sconstr a > constr b = error $ "Extra message constructor: " ++ constr b+-        | otherwise = do+-            go' (svars a) (vars b)+-            go as bs+-    go' ((an, at):as) ((bn, mbt):bs)+-        | an /= bn = error "Mismatched variable names"+-        | otherwise =+-            case mbt of+-                Nothing -> go' as bs+-                Just bt+-                    | at == bt -> go' as bs+-                    | otherwise -> error "Mismatched variable types"+-    go' [] [] = return ()+-    go' _ _ = error "Mistmached variable count"+-+-toSDefs :: [Def] -> Q [SDef]+-toSDefs = mapM toSDef+-+-toSDef :: Def -> Q SDef+-toSDef d = do+-    vars' <- mapM go $ vars d+-    return $ SDef (constr d) vars' (content d)+-  where+-    go (a, Just b) = return (a, b)+-    go (a, Nothing) = error $ "Main language missing type for " ++ show (constr d, a)+ + data SDef = SDef+     { sconstr :: String+-- +1.8.5.1+
+ standalone/no-th/haskell-patches/shakespeare-js_0001-remove-TH.patch view
@@ -0,0 +1,316 @@+From be50798c9abc22648a0a3eb81db462abea79698c Mon Sep 17 00:00:00 2001+From: Joey Hess <joey@kitenet.net>+Date: Tue, 17 Dec 2013 16:47:03 +0000+Subject: [PATCH] remove TH++---+ Text/Coffee.hs     | 56 ++++-----------------------------------------+ Text/Julius.hs     | 67 +++++++++---------------------------------------------+ Text/Roy.hs        | 51 ++++-------------------------------------+ Text/TypeScript.hs | 51 ++++-------------------------------------+ 4 files changed, 24 insertions(+), 201 deletions(-)++diff --git a/Text/Coffee.hs b/Text/Coffee.hs+index 488c81b..61db85b 100644+--- a/Text/Coffee.hs++++ b/Text/Coffee.hs+@@ -51,13 +51,13 @@ 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++    --  coffee++    --, coffeeFile++    --, coffeeFileReload++    --, coffeeFileDebug+ + #ifdef TEST_EXPORT+-    , coffeeSettings++    --, coffeeSettings+ #endif+     ) where+ +@@ -65,49 +65,3 @@ import Language.Haskell.TH.Quote (QuasiQuoter (..))+ 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 = ""+-      , wrapInsertionAddParens = False+-      }+-    }+-  }+-+--- | 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 ec30690..5b5a075 100644+--- a/Text/Julius.hs++++ b/Text/Julius.hs+@@ -14,17 +14,17 @@ 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++    -- js++    -- julius++    -- juliusFile++    -- jsFile++    --, juliusFileDebug++    --, jsFileDebug++    --, juliusFileReload++    --, jsFileReload+ +       -- * Datatypes+-    , JavascriptUrl++      JavascriptUrl+     , Javascript (..)+     , RawJavascript (..)+ +@@ -37,9 +37,9 @@ module Text.Julius+     , renderJavascriptUrl+ +       -- ** internal, used by 'Text.Coffee'+-    , javascriptSettings++    --, javascriptSettings+       -- ** internal+-    , juliusUsedIdentifiers++    --, juliusUsedIdentifiers+     , asJavascriptUrl+     ) where+ +@@ -102,48 +102,3 @@ instance RawJS TL.Text where rawJS = RawJavascript . fromLazyText+ instance RawJS Builder where rawJS = RawJavascript+ instance RawJS Bool where rawJS = RawJavascript . unJavascript . 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)]+-juliusUsedIdentifiers = shakespeareUsedIdentifiers defaultShakespeareSettings+diff --git a/Text/Roy.hs b/Text/Roy.hs+index 8bffc5a..8bf2a09 100644+--- a/Text/Roy.hs++++ b/Text/Roy.hs+@@ -39,12 +39,12 @@ 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++    --  roy++    --, royFile++    --, royFileReload+ + #ifdef TEST_EXPORT+-    , roySettings++    --, roySettings+ #endif+     ) where+ +@@ -53,46 +53,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", "--browser"]+-    , preEscapeIgnoreBalanced = "'\""+-    , preEscapeIgnoreLine = "//"+-    , wrapInsertion = Just WrapInsertion {+-        wrapInsertionIndent = Just "  "+-      , wrapInsertionStartBegin = "(\\"+-      , wrapInsertionSeparator = " "+-      , wrapInsertionStartClose = " ->\n"+-      , wrapInsertionEnd = ")"+-      , wrapInsertionAddParens = True+-      }+-    }+-  }+-+--- | 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 70c8820..5be994a 100644+--- a/Text/TypeScript.hs++++ b/Text/TypeScript.hs+@@ -57,12 +57,12 @@ module Text.TypeScript+       -- ** Template-Reading Functions+       -- | These QuasiQuoter and Template Haskell methods return values of+       -- type @'JavascriptUrl' url@. See the Yesod book for details.+-      tsc+-    , typeScriptFile+-    , typeScriptFileReload++    --  tsc++    --, typeScriptFile++    --, typeScriptFileReload+ + #ifdef TEST_EXPORT+-    , typeScriptSettings++    --, typeScriptSettings+ #endif+     ) where+ +@@ -71,46 +71,3 @@ 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 = "})"+-      , wrapInsertionAddParens = False+-      }+-    }+-  }+-+--- | Read inline, quasiquoted TypeScript+-tsc :: QuasiQuoter+-tsc = QuasiQuoter { quoteExp = \s -> do+-    rs <- typeScriptSettings+-    quoteExp (shakespeare rs) s+-    }+-+--- | Read in a TypeScript 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.8.5.1+
+ standalone/no-th/haskell-patches/shakespeare-text_remove-TH.patch view
@@ -0,0 +1,153 @@+From f94ab5c4fe8f01cb9353a9d246e8f7c48475d834 Mon Sep 17 00:00:00 2001+From: Joey Hess <joey@kitenet.net>+Date: Wed, 18 Dec 2013 04:10:23 +0000+Subject: [PATCH] remove TH++---+ Text/Shakespeare/Text.hs | 125 +++++------------------------------------------+ 1 file changed, 11 insertions(+), 114 deletions(-)++diff --git a/Text/Shakespeare/Text.hs b/Text/Shakespeare/Text.hs+index 738164b..65818ee 100644+--- a/Text/Shakespeare/Text.hs++++ b/Text/Shakespeare/Text.hs+@@ -7,18 +7,18 @@ module Text.Shakespeare.Text+     ( TextUrl+     , ToText (..)+     , renderTextUrl+-    , stext+-    , text+-    , textFile+-    , textFileDebug+-    , textFileReload+-    , st -- | strict text+-    , lt -- | lazy text, same as stext :)++    --, stext++    --, text++    --, textFile++    --, textFileDebug++    --, textFileReload++    --, st -- | strict text++    --, lt -- | lazy text, same as stext :)+     -- * Yesod code generation+-    , codegen+-    , codegenSt+-    , codegenFile+-    , codegenFileReload++    --, codegen++    --, codegenSt++    --, codegenFile++    --, codegenFileReload+     ) where+ + import Language.Haskell.TH.Quote (QuasiQuoter (..))+@@ -43,106 +43,3 @@ instance ToText TL.Text where toText = fromLazyText+ instance ToText Int32 where toText = toText . show+ instance ToText Int64 where toText = toText . show+ +-settings :: Q ShakespeareSettings+-settings = do+-  toTExp <- [|toText|]+-  wrapExp <- [|id|]+-  unWrapExp <- [|id|]+-  return $ defaultShakespeareSettings { toBuilder = toTExp+-  , wrap = wrapExp+-  , unwrap = unWrapExp+-  }+-+-+-stext, lt, st, text :: QuasiQuoter+-stext = +-  QuasiQuoter { quoteExp = \s -> do+-    rs <- settings+-    render <- [|toLazyText|]+-    rendered <- shakespeareFromString rs { justVarInterpolation = True } s+-    return (render `AppE` rendered)+-    }+-lt = stext+-+-st = +-  QuasiQuoter { quoteExp = \s -> do+-    rs <- settings+-    render <- [|TL.toStrict . toLazyText|]+-    rendered <- shakespeareFromString rs { justVarInterpolation = True } s+-    return (render `AppE` rendered)+-    }+-+-text = QuasiQuoter { quoteExp = \s -> do+-    rs <- settings+-    quoteExp (shakespeare rs) $ filter (/='\r') s+-    }+-+-+-textFile :: FilePath -> Q Exp+-textFile fp = do+-    rs <- settings+-    shakespeareFile rs fp+-+-+-textFileDebug :: FilePath -> Q Exp+-textFileDebug = textFileReload+-{-# DEPRECATED textFileDebug "Please use textFileReload instead" #-}+-+-textFileReload :: FilePath -> Q Exp+-textFileReload fp = do+-    rs <- settings+-    shakespeareFileReload rs fp+-+--- | codegen is designed for generating Yesod code, including templates+--- So it uses different interpolation characters that won't clash with templates.+-codegenSettings :: Q ShakespeareSettings+-codegenSettings = do+-  toTExp <- [|toText|]+-  wrapExp <- [|id|]+-  unWrapExp <- [|id|]+-  return $ defaultShakespeareSettings { toBuilder = toTExp+-  , wrap = wrapExp+-  , unwrap = unWrapExp+-  , varChar = '~'+-  , urlChar = '*'+-  , intChar = '&'+-  , justVarInterpolation = True -- always!+-  }+-+--- | codegen is designed for generating Yesod code, including templates+--- So it uses different interpolation characters that won't clash with templates.+--- You can use the normal text quasiquoters to generate code+-codegen :: QuasiQuoter+-codegen =+-  QuasiQuoter { quoteExp = \s -> do+-    rs <- codegenSettings+-    render <- [|toLazyText|]+-    rendered <- shakespeareFromString rs { justVarInterpolation = True } s+-    return (render `AppE` rendered)+-    }+-+--- | Generates strict Text+--- codegen is designed for generating Yesod code, including templates+--- So it uses different interpolation characters that won't clash with templates.+-codegenSt :: QuasiQuoter+-codegenSt =+-  QuasiQuoter { quoteExp = \s -> do+-    rs <- codegenSettings+-    render <- [|TL.toStrict . toLazyText|]+-    rendered <- shakespeareFromString rs { justVarInterpolation = True } s+-    return (render `AppE` rendered)+-    }+-+-codegenFileReload :: FilePath -> Q Exp+-codegenFileReload fp = do+-    rs <- codegenSettings+-    render <- [|TL.toStrict . toLazyText|]+-    rendered <- shakespeareFileReload rs{ justVarInterpolation = True } fp+-    return (render `AppE` rendered)+-+-codegenFile :: FilePath -> Q Exp+-codegenFile fp = do+-    rs <- codegenSettings+-    render <- [|TL.toStrict . toLazyText|]+-    rendered <- shakespeareFile rs{ justVarInterpolation = True } fp+-    return (render `AppE` rendered)+-- +1.8.5.1+
+ standalone/no-th/haskell-patches/shakespeare_1.0.3_0002-remove-TH.patch view
@@ -0,0 +1,223 @@+From b66f160fea86d8839572620892181eb4ada2ad29 Mon Sep 17 00:00:00 2001+From: Joey Hess <joey@kitenet.net>+Date: Tue, 17 Dec 2013 06:17:26 +0000+Subject: [PATCH 2/2] remove TH++---+ Text/Shakespeare.hs      | 131 +++--------------------------------------------+ Text/Shakespeare/Base.hs |  28 ----------+ 2 files changed, 6 insertions(+), 153 deletions(-)++diff --git a/Text/Shakespeare.hs b/Text/Shakespeare.hs+index f908ff4..55cd1d1 100644+--- a/Text/Shakespeare.hs++++ b/Text/Shakespeare.hs+@@ -12,14 +12,14 @@ module Text.Shakespeare+     , WrapInsertion (..)+     , PreConversion (..)+     , defaultShakespeareSettings+-    , shakespeare+-    , shakespeareFile+-    , shakespeareFileReload++    --, shakespeare++    --, shakespeareFile++    -- , shakespeareFileReload+     -- * low-level+-    , shakespeareFromString+-    , shakespeareUsedIdentifiers++    -- , shakespeareFromString++    --, shakespeareUsedIdentifiers+     , RenderUrl+-    , VarType++    --, VarType+     , Deref+     , Parser+ +@@ -151,38 +151,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 wp) =+-        [|WrapInsertion $(lift indent) $(lift sb) $(lift sep) $(lift sc) $(lift e) $(lift wp)|]+-+-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)+@@ -346,77 +314,12 @@ 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 $ (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 Nothing r $+-#ifdef WINDOWS+-          filter (/='\r')+-#endif+-          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)]+-getVars ContentRaw{} = []+-getVars (ContentVar d) = [(d, VTPlain)]+-getVars (ContentUrl d) = [(d, VTUrl)]+-getVars (ContentUrlParam d) = [(d, VTUrlParam)]+-getVars (ContentMix d) = [(d, VTMixin)]+ + data VarExp url = EPlain Builder+                 | EUrl url+                 | EUrlParam (url, [(TS.Text, TS.Text)])+                 | EMixin (Shakespeare url)+ +--- | Determine which identifiers are used by the given template, useful for+--- creating systems like yesod devel.+-shakespeareUsedIdentifiers :: ShakespeareSettings -> String -> [(Deref, VarType)]+-shakespeareUsedIdentifiers settings = concatMap getVars . contentFromString settings+-+ type MTime = UTCTime+ + {-# NOINLINE reloadMapRef #-}+@@ -432,28 +335,6 @@ insertReloadMap :: FilePath -> (MTime, [Content]) -> IO [Content]+ insertReloadMap fp (mt, content) = atomicModifyIORef reloadMapRef+   (\reloadMap -> (M.insert fp (mt, content) reloadMap, content))+ +-shakespeareFileReload :: ShakespeareSettings -> FilePath -> Q Exp+-shakespeareFileReload settings fp = do+-    str <- readFileQ fp+-    s <- qRunIO $ preFilter (Just fp) settings str+-    let b = shakespeareUsedIdentifiers settings s+-    c <- mapM vtToExp b+-    rt <- [|shakespeareRuntime settings fp|]+-    wrap' <- [|\x -> $(return $ wrap settings) . x|]+-    return $ wrap' `AppE` (rt `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 $+-          InfixE (Just $ unwrap settings) (VarE '(.)) (Just $ toBuilder settings))|]+-        c VTUrl = [|EUrl|]+-        c VTUrlParam = [|EUrlParam|]+-        c VTMixin = [|\x -> EMixin $ \r -> $(return $ unwrap settings) $ x r|]+ + + +diff --git a/Text/Shakespeare/Base.hs b/Text/Shakespeare/Base.hs+index 9573533..49f1995 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+-- +1.8.5.1+
+ standalone/no-th/haskell-patches/wai-app-static_deal-with-TH.patch view
@@ -0,0 +1,82 @@+From 8cc398092892377d5fdbda990a2e860155422afa 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 ----+ WaiAppStatic/Storage/Embedded.hs  | 8 ++++----+ wai-app-static.cabal              | 4 +---+ 3 files changed, 5 insertions(+), 11 deletions(-)++diff --git a/Network/Wai/Application/Static.hs b/Network/Wai/Application/Static.hs+index f2fa743..1a82b30 100644+--- a/Network/Wai/Application/Static.hs++++ b/Network/Wai/Application/Static.hs+@@ -33,8 +33,6 @@ import Control.Monad.IO.Class (liftIO)+ + import Blaze.ByteString.Builder (toByteString)+ +-import Data.FileEmbed (embedFile)+-+ import Data.Text (Text)+ import qualified Data.Text as T+ +@@ -198,8 +196,6 @@ staticAppPieces _ _ req+         H.status405+         [("Content-Type", "text/plain")]+         "Only GET is supported"+-staticAppPieces _ [".hidden", "folder.png"] _  = return $ W.responseLBS H.status200 [("Content-Type", "image/png")] $ L.fromChunks [$(embedFile "images/folder.png")]+-staticAppPieces _ [".hidden", "haskell.png"] _ = return $ W.responseLBS H.status200 [("Content-Type", "image/png")] $ L.fromChunks [$(embedFile "images/haskell.png")]+ staticAppPieces ss rawPieces req = liftIO $ do+     case toPieces rawPieces of+         Just pieces -> checkPieces ss pieces req >>= response+diff --git a/WaiAppStatic/Storage/Embedded.hs b/WaiAppStatic/Storage/Embedded.hs+index daa6e50..9873d4e 100644+--- a/WaiAppStatic/Storage/Embedded.hs++++ b/WaiAppStatic/Storage/Embedded.hs+@@ -3,10 +3,10 @@ module WaiAppStatic.Storage.Embedded(+       embeddedSettings+ +     -- * Template Haskell+-    , Etag+-    , EmbeddableEntry(..)+-    , mkSettings++    --, Etag++    --, EmbeddableEntry(..)++    --, mkSettings+     ) where+ + import WaiAppStatic.Storage.Embedded.Runtime+-import WaiAppStatic.Storage.Embedded.TH++--import WaiAppStatic.Storage.Embedded.TH+diff --git a/wai-app-static.cabal b/wai-app-static.cabal+index 5d81150..8f8c144 100644+--- a/wai-app-static.cabal++++ b/wai-app-static.cabal+@@ -33,7 +33,6 @@ library+                    , containers                >= 0.2+                    , time                      >= 1.1.4+                    , old-locale                >= 1.0.0.2+-                   , file-embed                >= 0.0.3.1+                    , text                      >= 0.7+                    , blaze-builder             >= 0.2.1.4+                    , base64-bytestring         >= 0.1+@@ -57,9 +56,8 @@ 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.5.1+
+ standalone/no-th/haskell-patches/xml-hamlet_remove_TH.patch view
@@ -0,0 +1,108 @@+From b53713fbb4f3bb6bdd25b07afcaed4940b32dfa8 Mon Sep 17 00:00:00 2001+From: Joey Hess <joey@kitenet.net>+Date: Wed, 18 Dec 2013 03:32:44 +0000+Subject: [PATCH] remove TH++---+ 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..4e830bd 100644+--- a/Text/Hamlet/XML.hs++++ b/Text/Hamlet/XML.hs+@@ -1,9 +1,7 @@+ {-# LANGUAGE TemplateHaskell #-}+ {-# OPTIONS_GHC -fno-warn-missing-fields #-}+ module Text.Hamlet.XML+-    ( xml+-    , xmlFile+-    ) where++    () where+ + import Language.Haskell.TH.Syntax+ import Language.Haskell.TH.Quote+@@ -19,80 +17,3 @@ 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.5.1+
+ standalone/no-th/haskell-patches/yesod-auth_don-t-really-build.patch view
@@ -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+
+ standalone/no-th/haskell-patches/yesod-core_expand_TH.patch view
@@ -0,0 +1,684 @@+From 08cc43788c16fb91f63bc0bd520eeccdcdab477a Mon Sep 17 00:00:00 2001+From: dummy <dummy@example.com>+Date: Tue, 17 Dec 2013 17:15:33 +0000+Subject: [PATCH] remove and expand TH++---+ Yesod/Core.hs              |  30 +++---+ Yesod/Core/Class/Yesod.hs  | 249 +++++++++++++++++++++++++++++++--------------+ Yesod/Core/Dispatch.hs     |  27 ++---+ Yesod/Core/Handler.hs      |  25 ++---+ Yesod/Core/Internal/Run.hs |   4 +-+ Yesod/Core/Internal/TH.hs  | 111 --------------------+ Yesod/Core/Widget.hs       |  32 +-----+ 7 files changed, 209 insertions(+), 269 deletions(-)++diff --git a/Yesod/Core.hs b/Yesod/Core.hs+index 12e59d5..2817a69 100644+--- a/Yesod/Core.hs++++ b/Yesod/Core.hs+@@ -29,16 +29,16 @@ module Yesod.Core+     , unauthorizedI+       -- * Logging+     , LogLevel (..)+-    , logDebug+-    , logInfo+-    , logWarn+-    , logError+-    , logOther+-    , logDebugS+-    , logInfoS+-    , logWarnS+-    , logErrorS+-    , logOtherS++    --, logDebug++    --, logInfo++    --, logWarn++    --, logError++    --, logOther++    --, logDebugS++    --, logInfoS++    --, logWarnS++    --, logErrorS++    --, logOtherS+       -- * Sessions+     , SessionBackend (..)+     , customizeSessionCookies+@@ -85,17 +85,15 @@ module Yesod.Core+     , readIntegral+       -- * Shakespeare+       -- ** Hamlet+-    , hamlet+-    , shamlet+-    , xhamlet++    --, hamlet++    -- , shamlet++    --, xhamlet+     , HtmlUrl+       -- ** Julius+-    , julius++    --, julius+     , JavascriptUrl+     , renderJavascriptUrl+       -- ** Cassius/Lucius+-    , cassius+-    , lucius+     , CssUrl+     , renderCssUrl+     ) where+diff --git a/Yesod/Core/Class/Yesod.hs b/Yesod/Core/Class/Yesod.hs+index a64d6eb..5dffbfa 100644+--- a/Yesod/Core/Class/Yesod.hs++++ b/Yesod/Core/Class/Yesod.hs+@@ -5,11 +5,15 @@+ {-# LANGUAGE CPP               #-}+ module Yesod.Core.Class.Yesod where+ +-import           Control.Monad.Logger               (logErrorS)++--import           Control.Monad.Logger               (logErrorS)+ 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)+@@ -94,18 +98,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+@@ -370,45 +383,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+@@ -438,10 +509,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.+@@ -451,10 +525,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+@@ -476,10 +551,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)+@@ -488,30 +566,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 df822e2..5583495 100644+--- a/Yesod/Core/Dispatch.hs++++ b/Yesod/Core/Dispatch.hs+@@ -6,18 +6,18 @@+ {-# LANGUAGE CPP #-}+ module Yesod.Core.Dispatch+     ( -- * Quasi-quoted routing+-      parseRoutes+-    , parseRoutesNoCheck+-    , parseRoutesFile+-    , parseRoutesFileNoCheck+-    , mkYesod++    --  parseRoutes++    --, parseRoutesNoCheck++    --, parseRoutesFile++    --, parseRoutesFileNoCheck++    --, mkYesod+       -- ** More fine-grained+-    , mkYesodData+-    , mkYesodSubData+-    , mkYesodDispatch+-    , mkYesodSubDispatch++    --, mkYesodData++    --, mkYesodSubData++    --, mkYesodDispatch++    --, mkYesodSubDispatch+       -- ** Path pieces+-    , PathPiece (..)++      PathPiece (..)+     , PathMultiPiece (..)+     , Texts+       -- * Convert to WAI+@@ -124,13 +124,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 3581dbc..908256e 100644+--- a/Yesod/Core/Handler.hs++++ b/Yesod/Core/Handler.hs+@@ -164,7 +164,7 @@ import           Data.Text.Encoding            (decodeUtf8With, encodeUtf8)+ import           Data.Text.Encoding.Error      (lenientDecode)+ import qualified Data.Text.Lazy                as TL+ import qualified Text.Blaze.Html.Renderer.Text as RenderText+-import           Text.Hamlet                   (Html, HtmlUrl, hamlet)++import           Text.Hamlet                   (Html, HtmlUrl)+ + import qualified Data.ByteString               as S+ import qualified Data.ByteString.Lazy          as L+@@ -198,6 +198,7 @@ import Data.CaseInsensitive (CI)+ #if MIN_VERSION_wai(2, 0, 0)+ import qualified System.PosixCompat.Files as PC+ #endif++import qualified Text.Blaze.Internal+ + get :: MonadHandler m => m GHState+ get = liftHandlerT $ HandlerT $ I.readIORef . handlerState+@@ -743,19 +744,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 25f51f1..d04d2cd 100644+--- a/Yesod/Core/Internal/Run.hs++++ b/Yesod/Core/Internal/Run.hs+@@ -15,7 +15,7 @@ import           Control.Exception.Lifted     (catch)+ import           Control.Monad.IO.Class       (MonadIO)+ import           Control.Monad.IO.Class       (liftIO)+ import           Control.Monad.Logger         (LogLevel (LevelError), LogSource,+-                                               liftLoc)++                                               )+ import           Control.Monad.Trans.Resource (runResourceT, withInternalState, runInternalState, createInternalState, closeInternalState)+ import qualified Data.ByteString              as S+ import qualified Data.ByteString.Char8        as S8+@@ -128,8 +128,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/Internal/TH.hs b/Yesod/Core/Internal/TH.hs+index 7e84c1c..a273c29 100644+--- a/Yesod/Core/Internal/TH.hs++++ b/Yesod/Core/Internal/TH.hs+@@ -23,114 +23,3 @@ import Yesod.Core.Content+ import Yesod.Core.Class.Dispatch+ import Yesod.Core.Internal.Run+ +--- | 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+-+--- | 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 -> [ResourceTree String] -> Q [Dec]+-mkYesodSubData name res = mkYesodDataGeneral name True res+-+-mkYesodDataGeneral :: String -> Bool -> [ResourceTree String] -> Q [Dec]+-mkYesodDataGeneral name isSub res = do+-    let (name':rest) = words name+-    fmap fst $ mkYesodGeneral name' rest isSub res+-+--- | See 'mkYesodData'.+-mkYesodDispatch :: String -> [ResourceTree String] -> Q [Dec]+-mkYesodDispatch name = fmap snd . mkYesodGeneral name [] False+-+--- | Get the Handler and Widget type synonyms for the given site.+-masterTypeSyns :: Type -> [Dec]+-masterTypeSyns site =+-    [ TySynD (mkName "Handler") []+-      $ ConT ''HandlerT `AppT` site `AppT` ConT ''IO+-    , TySynD (mkName "Widget")  []+-      $ ConT ''WidgetT `AppT` site `AppT` ConT ''IO `AppT` ConT ''()+-    ]+-+-mkYesodGeneral :: String                   -- ^ foundation type+-               -> [String]                 -- ^ arguments for the type+-               -> Bool                     -- ^ it this a subsite+-               -> [ResourceTree String]+-               -> Q([Dec],[Dec])+-mkYesodGeneral name args isSub resS = do+-    renderRouteDec <- mkRenderRouteInstance site res+-    routeAttrsDec  <- mkRouteAttrsInstance site res+-    dispatchDec    <- mkDispatchInstance site res+-    parse <- mkParseRouteInstance site res+-    let rname = mkName $ "resources" ++ name+-    eres <- lift resS+-    let resourcesDec =+-            [ SigD rname $ ListT `AppT` (ConT ''ResourceTree `AppT` ConT ''String)+-            , FunD rname [Clause [] (NormalB eres) []]+-            ]+-    let dataDec = concat+-            [ [parse]+-            , renderRouteDec+-            , [routeAttrsDec]+-            , resourcesDec+-            , if isSub then [] else masterTypeSyns site+-            ]+-    return (dataDec, dispatchDec)+-  where site    = foldl' AppT (ConT $ mkName name) (map (VarT . mkName) args)+-        res     = map (fmap parseType) resS+-+-mkMDS :: Q Exp -> MkDispatchSettings+-mkMDS rh = MkDispatchSettings+-    { mdsRunHandler = rh+-    , mdsSubDispatcher =+-        [|\parentRunner getSub toParent env -> yesodSubDispatch+-                                 YesodSubRunnerEnv+-                                    { ysreParentRunner = parentRunner+-                                    , ysreGetSub = getSub+-                                    , ysreToParentRoute = toParent+-                                    , ysreParentEnv = env+-                                    }+-                              |]+-    , mdsGetPathInfo = [|W.pathInfo|]+-    , mdsSetPathInfo = [|\p r -> r { W.pathInfo = p }|]+-    , mdsMethod = [|W.requestMethod|]+-    , mds404 = [|notFound >> return ()|]+-    , mds405 = [|badMethod >> return ()|]+-    , mdsGetHandler = defaultGetHandler+-    }+-+--- | 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 :: Type                -- ^ The master site type+-                   -> [ResourceTree a]    -- ^ The resource+-                   -> DecsQ+-mkDispatchInstance master res = do+-    clause' <- mkDispatchClause (mkMDS [|yesodRunner|]) res+-    let thisDispatch = FunD 'yesodDispatch [clause']+-    return [InstanceD [] yDispatch [thisDispatch]]+-  where+-    yDispatch = ConT ''YesodDispatch `AppT` master+-+-mkYesodSubDispatch :: [ResourceTree a] -> Q Exp+-mkYesodSubDispatch res = do+-    clause' <- mkDispatchClause (mkMDS [|subHelper . fmap toTypedContent|]) res+-    inner <- newName "inner"+-    let innerFun = FunD inner [clause']+-    helper <- newName "helper"+-    let fun = FunD helper+-                [ Clause+-                    []+-                    (NormalB $ VarE inner)+-                    [innerFun]+-                ]+-    return $ LetE [fun] (VarE helper)+diff --git a/Yesod/Core/Widget.hs b/Yesod/Core/Widget.hs+index a972efa..156cd45 100644+--- a/Yesod/Core/Widget.hs++++ b/Yesod/Core/Widget.hs+@@ -16,8 +16,8 @@ module Yesod.Core.Widget+       WidgetT+     , PageContent (..)+       -- * Special Hamlet quasiquoter/TH for Widgets+-    , whamlet+-    , whamletFile++    --, whamlet++    --, whamletFile+     , ihamletToRepHtml+     , ihamletToHtml+       -- * Convert to Widget+@@ -46,7 +46,7 @@ module Yesod.Core.Widget+     , widgetToParentWidget+     , handlerToWidget+       -- * Internal+-    , whamletFileWithSettings++    --, whamletFileWithSettings+     , asWidgetT+     ) where+ +@@ -189,35 +189,9 @@ addScriptRemote = flip addScriptRemoteAttrs []+ addScriptRemoteAttrs :: MonadWidget m => Text -> [(Text, Text)] -> m ()+ addScriptRemoteAttrs x y = tell $ GWData mempty mempty (toUnique $ Script (Remote x) y) mempty mempty mempty mempty+ +-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+-+ asWidgetT :: WidgetT site m () -> WidgetT site m ()+ asWidgetT = id+ +-rules :: Q NP.HamletRules+-rules = do+-    ah <- [|asWidgetT . 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 [|getUrlRenderParams|])+-                    (Just $ helper [|liftM (toHtml .) getMessageRender|])+-            f env+-    return $ NP.HamletRules ah ur $ \_ b -> return $ ah `AppE` b+-+ -- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.+ ihamletToRepHtml :: (MonadHandler m, RenderMessage (HandlerSite m) message)+                  => HtmlUrlI18n message (Route (HandlerSite m))+-- +1.8.5.1+
+ standalone/no-th/haskell-patches/yesod-form_spliced-TH.patch view
@@ -0,0 +1,1805 @@+From fbd8f048c239e34625e438a24213534f6f68c3e8 Mon Sep 17 00:00:00 2001+From: dummy <dummy@example.com>+Date: Tue, 17 Dec 2013 18:34:25 +0000+Subject: [PATCH] spliced TH++---+ Yesod/Form/Fields.hs    | 771 ++++++++++++++++++++++++++++++++++++------------+ Yesod/Form/Functions.hs | 239 ++++++++++++---+ Yesod/Form/Jquery.hs    | 129 ++++++--+ Yesod/Form/MassInput.hs | 233 ++++++++++++---+ Yesod/Form/Nic.hs       |  65 +++-+ yesod-form.cabal        |   1 ++ 6 files changed, 1127 insertions(+), 311 deletions(-)++diff --git a/Yesod/Form/Fields.hs b/Yesod/Form/Fields.hs+index b2a47c6..016c98b 100644+--- a/Yesod/Form/Fields.hs++++ b/Yesod/Form/Fields.hs+@@ -1,4 +1,3 @@+-{-# LANGUAGE QuasiQuotes #-}+ {-# LANGUAGE TypeFamilies #-}+ {-# LANGUAGE OverloadedStrings #-}+ {-# LANGUAGE GeneralizedNewtypeDeriving #-}+@@ -36,15 +35,11 @@ module Yesod.Form.Fields+     , selectFieldList+     , radioField+     , radioFieldList+-    , checkboxesFieldList+-    , checkboxesField+     , multiSelectField+     , multiSelectFieldList+     , Option (..)+     , OptionList (..)+     , mkOptionList+-    , optionsPersist+-    , optionsPersistKey+     , optionsPairs+     , optionsEnum+     ) where+@@ -70,6 +65,15 @@ import Text.HTML.SanitizeXSS (sanitizeBalance)+ import Control.Monad (when, unless)+ import Data.Maybe (listToMaybe, fromMaybe)+ ++import qualified Text.Blaze as Text.Blaze.Internal++import qualified Text.Blaze.Internal++import qualified Text.Hamlet++import qualified Yesod.Core.Widget++import qualified Text.Css++import qualified Data.Monoid++import qualified Data.Foldable++import qualified Control.Monad+++ import qualified Blaze.ByteString.Builder.Html.Utf8 as B+ import Blaze.ByteString.Builder (writeByteString, toLazyByteString)+ import Blaze.ByteString.Builder.Internal.Write (fromWriteList)+@@ -82,14 +86,12 @@ import Data.Text (Text, unpack, pack)+ import qualified Data.Text.Read+ + import qualified Data.Map as Map+-import Yesod.Persist (selectList, runDB, Filter, SelectOpt, Key, YesodPersist, PersistEntity, PersistQuery, YesodDB)+ import Control.Arrow ((&&&))+ + import Control.Applicative ((<$>), (<|>))+ + import Data.Attoparsec.Text (Parser, char, string, digit, skipSpace, endOfInput, parseOnly)+ +-import Yesod.Persist.Core+ + defaultFormMessage :: FormMessage -> Text+ defaultFormMessage = englishFormMessage+@@ -102,10 +104,24 @@ intField = Field+             Right (a, "") -> Right a+             _ -> Left $ MsgInvalidInteger s+ +-    , fieldView = \theId name attrs val isReq -> toWidget [hamlet|+-$newline never+-<input id="#{theId}" name="#{name}" *{attrs} type="number" :isReq:required="" value="#{showVal val}">+-|]++    , fieldView = \theId name attrs val isReq -> toWidget  $     \ _render_arOn++      -> do { id++                ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");++              id (toHtml theId);++              id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");++              id (toHtml name);++              id++                ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"number\"");++              Text.Hamlet.condH++                [(isReq, ++                  id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]++                Nothing;++              id ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");++              id (toHtml (showVal val));++              id ((Text.Blaze.Internal.preEscapedText . pack) "\"");++              id ((Text.Hamlet.attrsToHtml . toAttributes) attrs);++              id ((Text.Blaze.Internal.preEscapedText . pack) ">") }+++     , fieldEnctype = UrlEncoded+     }+   where+@@ -119,10 +135,24 @@ doubleField = Field+             Right (a, "") -> Right a+             _ -> Left $ MsgInvalidNumber s+ +-    , fieldView = \theId name attrs val isReq -> toWidget [hamlet|+-$newline never+-<input id="#{theId}" name="#{name}" *{attrs} type="text" :isReq:required="" value="#{showVal val}">+-|]++    , fieldView = \theId name attrs val isReq -> toWidget  $     \ _render_arOz++      -> do { id++                ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");++              id (toHtml theId);++              id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");++              id (toHtml name);++              id++                ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"text\"");++              Text.Hamlet.condH++                [(isReq, ++                  id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]++                Nothing;++              id ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");++              id (toHtml (showVal val));++              id ((Text.Blaze.Internal.preEscapedText . pack) "\"");++              id ((Text.Hamlet.attrsToHtml . toAttributes) attrs);++              id ((Text.Blaze.Internal.preEscapedText . pack) ">") }+++     , fieldEnctype = UrlEncoded+     }+   where showVal = either id (pack . show)+@@ -130,10 +160,24 @@ $newline never+ dayField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Day+ dayField = Field+     { fieldParse = parseHelper $ parseDate . unpack+-    , fieldView = \theId name attrs val isReq -> toWidget [hamlet|+-$newline never+-<input id="#{theId}" name="#{name}" *{attrs} type="date" :isReq:required="" value="#{showVal val}">+-|]++    , fieldView = \theId name attrs val isReq -> toWidget  $     \ _render_arOJ++      -> do { id++                ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");++              id (toHtml theId);++              id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");++              id (toHtml name);++              id++                ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"date\"");++              Text.Hamlet.condH++                [(isReq, ++                  id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]++                Nothing;++              id ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");++              id (toHtml (showVal val));++              id ((Text.Blaze.Internal.preEscapedText . pack) "\"");++              id ((Text.Hamlet.attrsToHtml . toAttributes) attrs);++              id ((Text.Blaze.Internal.preEscapedText . pack) ">") }+++     , fieldEnctype = UrlEncoded+     }+   where showVal = either id (pack . show)+@@ -141,10 +185,23 @@ $newline never+ timeField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m TimeOfDay+ timeField = Field+     { fieldParse = parseHelper parseTime+-    , fieldView = \theId name attrs val isReq -> toWidget [hamlet|+-$newline never+-<input id="#{theId}" name="#{name}" *{attrs} :isReq:required="" value="#{showVal val}">+-|]++    , fieldView = \theId name attrs val isReq -> toWidget  $     \ _render_arOW++      -> do { id++                ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");++              id (toHtml theId);++              id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");++              id (toHtml name);++              id ((Text.Blaze.Internal.preEscapedText . pack) "\"");++              Text.Hamlet.condH++                [(isReq, ++                  id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]++                Nothing;++              id ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");++              id (toHtml (showVal val));++              id ((Text.Blaze.Internal.preEscapedText . pack) "\"");++              id ((Text.Hamlet.attrsToHtml . toAttributes) attrs);++              id ((Text.Blaze.Internal.preEscapedText . pack) ">") }+++     , fieldEnctype = UrlEncoded+     }+   where+@@ -157,10 +214,18 @@ $newline never+ htmlField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Html+ htmlField = Field+     { fieldParse = parseHelper $ Right . preEscapedText . sanitizeBalance+-    , fieldView = \theId name attrs val _isReq -> toWidget [hamlet|+-$newline never+-<textarea id="#{theId}" name="#{name}" *{attrs}>#{showVal val}+-|]++    , fieldView = \theId name attrs val _isReq -> toWidget  $     \ _render_arP6++      -> do { id++                ((Text.Blaze.Internal.preEscapedText . pack) "<textarea id=\"");++              id (toHtml theId);++              id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");++              id (toHtml name);++              id ((Text.Blaze.Internal.preEscapedText . pack) "\"");++              id ((Text.Hamlet.attrsToHtml . toAttributes) attrs);++              id ((Text.Blaze.Internal.preEscapedText . pack) ">");++              id (toHtml (showVal val));++              id ((Text.Blaze.Internal.preEscapedText . pack) "</textarea>") }+++     , fieldEnctype = UrlEncoded+     }+   where showVal = either id (pack . renderHtml)+@@ -169,8 +234,6 @@ $newline never+ -- br-tags.+ newtype Textarea = Textarea { unTextarea :: Text }+     deriving (Show, Read, Eq, PersistField, Ord)+-instance PersistFieldSql Textarea where+-    sqlType _ = SqlString+ instance ToHtml Textarea where+     toHtml =+         unsafeByteString+@@ -188,10 +251,18 @@ instance ToHtml Textarea where+ textareaField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Textarea+ textareaField = Field+     { fieldParse = parseHelper $ Right . Textarea+-    , fieldView = \theId name attrs val _isReq -> toWidget [hamlet|+-$newline never+-<textarea id="#{theId}" name="#{name}" *{attrs}>#{either id unTextarea val}+-|]++    , fieldView = \theId name attrs val _isReq -> toWidget  $     \ _render_arPf++      -> do { id++                ((Text.Blaze.Internal.preEscapedText . pack) "<textarea id=\"");++              id (toHtml theId);++              id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");++              id (toHtml name);++              id ((Text.Blaze.Internal.preEscapedText . pack) "\"");++              id ((Text.Hamlet.attrsToHtml . toAttributes) attrs);++              id ((Text.Blaze.Internal.preEscapedText . pack) ">");++              id (toHtml (either id unTextarea val));++              id ((Text.Blaze.Internal.preEscapedText . pack) "</textarea>") }+++     , fieldEnctype = UrlEncoded+     }+ +@@ -199,10 +270,19 @@ hiddenField :: (Monad m, PathPiece p, RenderMessage (HandlerSite m) FormMessage)+             => Field m p+ hiddenField = Field+     { fieldParse = parseHelper $ maybe (Left MsgValueRequired) Right . fromPathPiece+-    , fieldView = \theId name attrs val _isReq -> toWidget [hamlet|+-$newline never+-<input type="hidden" id="#{theId}" name="#{name}" *{attrs} value="#{either id toPathPiece val}">+-|]++    , fieldView = \theId name attrs val _isReq -> toWidget  $     \ _render_arPo++      -> do { id++                ((Text.Blaze.Internal.preEscapedText . pack)++                   "<input type=\"hidden\" id=\"");++              id (toHtml theId);++              id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");++              id (toHtml name);++              id ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"");++              id (toHtml (either id toPathPiece val));++              id ((Text.Blaze.Internal.preEscapedText . pack) "\"");++              id ((Text.Hamlet.attrsToHtml . toAttributes) attrs);++              id ((Text.Blaze.Internal.preEscapedText . pack) ">") }+++     , fieldEnctype = UrlEncoded+     }+ +@@ -210,20 +290,55 @@ textField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Tex+ textField = Field+     { fieldParse = parseHelper $ Right+     , fieldView = \theId name attrs val isReq ->+-        [whamlet|+-$newline never+-<input id="#{theId}" name="#{name}" *{attrs} type="text" :isReq:required value="#{either id id val}">+-|]++        do { (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");++             (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");++             (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name);++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"text\"");++             Text.Hamlet.condH++               [(isReq, ++                 (Yesod.Core.Widget.asWidgetT . toWidget)++                   ((Text.Blaze.Internal.preEscapedText . pack) " required"))]++               Nothing;++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");++             (Yesod.Core.Widget.asWidgetT . toWidget)++               (toHtml (either id id val));++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . pack) "\"");++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Hamlet.attrsToHtml . toAttributes) attrs);++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . pack) ">") }+++     , fieldEnctype = UrlEncoded+     }+ + passwordField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Text+ passwordField = Field+     { fieldParse = parseHelper $ Right+-    , fieldView = \theId name attrs val isReq -> toWidget [hamlet|+-$newline never+-<input id="#{theId}" name="#{name}" *{attrs} type="password" :isReq:required="" value="#{either id id val}">+-|]++    , fieldView = \theId name attrs val isReq -> toWidget  $     \ _render_arPF++      -> do { id++                ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");++              id (toHtml theId);++              id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");++              id (toHtml name);++              id++                ((Text.Blaze.Internal.preEscapedText . pack)++                   "\" type=\"password\"");++              Text.Hamlet.condH++                [(isReq, ++                  id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]++                Nothing;++              id ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");++              id (toHtml (either id id val));++              id ((Text.Blaze.Internal.preEscapedText . pack) "\"");++              id ((Text.Hamlet.attrsToHtml . toAttributes) attrs);++              id ((Text.Blaze.Internal.preEscapedText . pack) ">") }+++     , fieldEnctype = UrlEncoded+     }+ +@@ -295,10 +410,24 @@ emailField = Field+             case Email.canonicalizeEmail $ encodeUtf8 s of+                 Just e -> Right $ decodeUtf8With lenientDecode e+                 Nothing -> Left $ MsgInvalidEmail s+-    , fieldView = \theId name attrs val isReq -> toWidget [hamlet|+-$newline never+-<input id="#{theId}" name="#{name}" *{attrs} type="email" :isReq:required="" value="#{either id id val}">+-|]++    , fieldView = \theId name attrs val isReq -> toWidget  $     \ _render_arQe++      -> do { id++                ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");++              id (toHtml theId);++              id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");++              id (toHtml name);++              id++                ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"email\"");++              Text.Hamlet.condH++                [(isReq, ++                  id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]++                Nothing;++              id ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");++              id (toHtml (either id id val));++              id ((Text.Blaze.Internal.preEscapedText . pack) "\"");++              id ((Text.Hamlet.attrsToHtml . toAttributes) attrs);++              id ((Text.Blaze.Internal.preEscapedText . pack) ">") }+++     , fieldEnctype = UrlEncoded+     }+ +@@ -307,20 +436,78 @@ searchField :: Monad m => RenderMessage (HandlerSite m) FormMessage => AutoFocus+ searchField autoFocus = Field+     { fieldParse = parseHelper Right+     , fieldView = \theId name attrs val isReq -> do+-        [whamlet|\+-$newline never+-<input id="#{theId}" name="#{name}" *{attrs} type="search" :isReq:required="" :autoFocus:autofocus="" value="#{either id id val}">+-|]++        do { (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");++             (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");++             (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name);++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"search\"");++             Text.Hamlet.condH++               [(isReq, ++                 (Yesod.Core.Widget.asWidgetT . toWidget)++                   ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]++               Nothing;++             Text.Hamlet.condH++               [(autoFocus, ++                 (Yesod.Core.Widget.asWidgetT . toWidget)++                   ((Text.Blaze.Internal.preEscapedText . pack) " autofocus=\"\""))]++               Nothing;++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");++             (Yesod.Core.Widget.asWidgetT . toWidget)++               (toHtml (either id id val));++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . pack) "\"");++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Hamlet.attrsToHtml . toAttributes) attrs);++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . pack) ">") }+++         when autoFocus $ do+           -- we want this javascript to be placed immediately after the field+-          [whamlet|+-$newline never+-<script>if (!('autofocus' in document.createElement('input'))) {document.getElementById('#{theId}').focus();}+-|]+-          toWidget [cassius|+-            ##{theId}+-              -webkit-appearance: textfield+-            |]++          do { (Yesod.Core.Widget.asWidgetT . toWidget)++                 ((Text.Blaze.Internal.preEscapedText . pack)++                    "<script>if (!('autofocus' in document.createElement('input'))) {document.getElementById('");++               (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);++               (Yesod.Core.Widget.asWidgetT . toWidget)++                 ((Text.Blaze.Internal.preEscapedText . pack)++                    "').focus();}</script>") }++++          toWidget  $           \ _render_arQv++            -> (Text.Css.CssNoWhitespace++                . (foldr ($) []))++                 [((++)++                   $ (map++                        Text.Css.TopBlock++                        (((Text.Css.Block++                             {Text.Css.blockSelector = Data.Monoid.mconcat++                                                                                 [(Text.Css.fromText++                                                                                   . Text.Css.pack)++                                                                                    "#",++                                                                                  toCss theId],++                              Text.Css.blockAttrs = (concat++                                                                             $ ([Text.Css.Attr++                                                                                   (Data.Monoid.mconcat++                                                                                      [(Text.Css.fromText++                                                                                        . Text.Css.pack)++                                                                                         "-webkit-appearance"])++                                                                                   (Data.Monoid.mconcat++                                                                                      [(Text.Css.fromText++                                                                                        . Text.Css.pack)++                                                                                         "textfield"])]++                                                                                :++                                                                                  (map++                                                                                     Text.Css.mixinAttrs++                                                                                     []))),++                              Text.Css.blockBlocks = (),++                              Text.Css.blockMixins = ()}++                         :)++                          . ((foldr (.) id [])++                             . (concatMap Text.Css.mixinBlocks [] ++)))++                           [])))]+++     , fieldEnctype = UrlEncoded+     }+ +@@ -331,7 +518,30 @@ urlField = Field+             Nothing -> Left $ MsgInvalidUrl s+             Just _ -> Right s+     , fieldView = \theId name attrs val isReq ->+-        [whamlet|<input ##{theId} name=#{name} *{attrs} type=url :isReq:required value=#{either id id val}>|]++        do { (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");++             (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");++             (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name);++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"url\"");++             Text.Hamlet.condH++               [(isReq, ++                 (Yesod.Core.Widget.asWidgetT . toWidget)++                   ((Text.Blaze.Internal.preEscapedText . pack) " required"))]++               Nothing;++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");++             (Yesod.Core.Widget.asWidgetT . toWidget)++               (toHtml (either id id val));++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . pack) "\"");++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Hamlet.attrsToHtml . toAttributes) attrs);++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . pack) ">") }+++     , fieldEnctype = UrlEncoded+     }+ +@@ -344,18 +554,56 @@ selectField :: (Eq a, RenderMessage site FormMessage)+             => HandlerT site IO (OptionList a)+             -> Field (HandlerT site IO) a+ selectField = selectFieldHelper+-    (\theId name attrs inside -> [whamlet|+-$newline never+-<select ##{theId} name=#{name} *{attrs}>^{inside}+-|]) -- outside+-    (\_theId _name isSel -> [whamlet|+-$newline never+-<option value=none :isSel:selected>_{MsgSelectNone}+-|]) -- onOpt+-    (\_theId _name _attrs value isSel text -> [whamlet|+-$newline never+-<option value=#{value} :isSel:selected>#{text}+-|]) -- inside++    (\theId name attrs inside ->     do { (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack) "<select id=\"");++         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);++         (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");++         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name);++         (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack) "\"");++         (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Hamlet.attrsToHtml . toAttributes) attrs);++         (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack) ">");++         (Yesod.Core.Widget.asWidgetT . toWidget) inside;++         (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack) "</select>") })++ -- outside++    (\_theId _name isSel ->     do { (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack)++              "<option value=\"none\"");++         Text.Hamlet.condH++           [(isSel, ++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . pack) " selected"))]++           Nothing;++         (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack) ">");++         ((Control.Monad.liftM (toHtml .) getMessageRender)++          >>=++            (\ urender_arQS++               -> (Yesod.Core.Widget.asWidgetT . toWidget)++                    (urender_arQS MsgSelectNone)));++         (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack) "</option>") })++ -- onOpt++    (\_theId _name _attrs value isSel text ->     do { (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack) "<option value=\"");++         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml value);++         (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack) "\"");++         Text.Hamlet.condH++           [(isSel, ++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . pack) " selected"))]++           Nothing;++         (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack) ">");++         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml text);++         (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack) "</option>") })++ -- inside+ + multiSelectFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg)+                      => [(msg, a)]+@@ -378,11 +626,48 @@ multiSelectField ioptlist =+     view theId name attrs val isReq = do+         opts <- fmap olOptions $ handlerToWidget ioptlist+         let selOpts = map (id &&& (optselected val)) opts+-        [whamlet|+-            <select ##{theId} name=#{name} :isReq:required multiple *{attrs}>+-                $forall (opt, optsel) <- selOpts+-                    <option value=#{optionExternalValue opt} :optsel:selected>#{optionDisplay opt}+-                |]++        do { (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . pack) "<select id=\"");++             (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");++             (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name);++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . pack) "\"");++             Text.Hamlet.condH++               [(isReq, ++                 (Yesod.Core.Widget.asWidgetT . toWidget)++                   ((Text.Blaze.Internal.preEscapedText . pack) " required"))]++               Nothing;++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . pack) " multiple");++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Hamlet.attrsToHtml . toAttributes) attrs);++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . pack) ">");++             Data.Foldable.mapM_++               (\ (opt_arRl, optsel_arRm)++                  -> do { (Yesod.Core.Widget.asWidgetT . toWidget)++                            ((Text.Blaze.Internal.preEscapedText . pack) "<option value=\"");++                          (Yesod.Core.Widget.asWidgetT . toWidget)++                            (toHtml (optionExternalValue opt_arRl));++                          (Yesod.Core.Widget.asWidgetT . toWidget)++                            ((Text.Blaze.Internal.preEscapedText . pack) "\"");++                          Text.Hamlet.condH++                            [(optsel_arRm, ++                              (Yesod.Core.Widget.asWidgetT . toWidget)++                                ((Text.Blaze.Internal.preEscapedText . pack) " selected"))]++                            Nothing;++                          (Yesod.Core.Widget.asWidgetT . toWidget)++                            ((Text.Blaze.Internal.preEscapedText . pack) ">");++                          (Yesod.Core.Widget.asWidgetT . toWidget)++                            (toHtml (optionDisplay opt_arRl));++                          (Yesod.Core.Widget.asWidgetT . toWidget)++                            ((Text.Blaze.Internal.preEscapedText . pack) "</option>") })++               selOpts;++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . pack) "</select>") }+++         where+             optselected (Left _) _ = False+             optselected (Right vals) opt = (optionInternalValue opt) `elem` vals+@@ -392,67 +677,172 @@ radioFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg)+                -> Field (HandlerT site IO) a+ radioFieldList = radioField . optionsPairs+ +-checkboxesFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg) => [(msg, a)]+-                     -> Field (HandlerT site IO) [a]+-checkboxesFieldList = checkboxesField . optionsPairs+-+-checkboxesField :: (Eq a, RenderMessage site FormMessage)+-                 => HandlerT site IO (OptionList a)+-                 -> Field (HandlerT site IO) [a]+-checkboxesField ioptlist = (multiSelectField ioptlist)+-    { fieldView =+-        \theId name attrs val isReq -> do+-            opts <- fmap olOptions $ handlerToWidget ioptlist+-            let optselected (Left _) _ = False+-                optselected (Right vals) opt = (optionInternalValue opt) `elem` vals+-            [whamlet|+-                <span ##{theId}>+-                    $forall opt <- opts+-                        <label>+-                            <input type=checkbox name=#{name} value=#{optionExternalValue opt} *{attrs} :optselected val opt:checked>+-                            #{optionDisplay opt}+-                |]+-    }+ + radioField :: (Eq a, RenderMessage site FormMessage)+            => HandlerT site IO (OptionList a)+            -> Field (HandlerT site IO) a+ radioField = selectFieldHelper+-    (\theId _name _attrs inside -> [whamlet|+-$newline never+-<div ##{theId}>^{inside}+-|])+-    (\theId name isSel -> [whamlet|+-$newline never+-<label .radio for=#{theId}-none>+-    <div>+-        <input id=#{theId}-none type=radio name=#{name} value=none :isSel:checked>+-        _{MsgSelectNone}+-|])+-    (\theId name attrs value isSel text -> [whamlet|+-$newline never+-<label .radio for=#{theId}-#{value}>+-    <div>+-        <input id=#{theId}-#{value} type=radio name=#{name} value=#{value} :isSel:checked *{attrs}>+-        \#{text}+-|])++    (\theId _name _attrs inside ->     do { (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack) "<div id=\"");++         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);++         (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack) "\">");++         (Yesod.Core.Widget.asWidgetT . toWidget) inside;++         (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack) "</div>") })++++    (\theId name isSel ->     do { (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack)++              "<label class=\"radio\" for=\"");++         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);++         (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack)++              "-none\"><div><input id=\"");++         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);++         (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack)++              "-none\" type=\"radio\" name=\"");++         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name);++         (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"none\"");++         Text.Hamlet.condH++           [(isSel, ++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . pack) " checked"))]++           Nothing;++         (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack) ">");++         ((Control.Monad.liftM (toHtml .) getMessageRender)++          >>=++            (\ urender_arRA++               -> (Yesod.Core.Widget.asWidgetT . toWidget)++                    (urender_arRA MsgSelectNone)));++         (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack) "</div></label>") })++++    (\theId name attrs value isSel text ->     do { (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack)++              "<label class=\"radio\" for=\"");++         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);++         (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack) "-");++         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml value);++         (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack)++              "\"><div><input id=\"");++         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);++         (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack) "-");++         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml value);++         (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack)++              "\" type=\"radio\" name=\"");++         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name);++         (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"");++         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml value);++         (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack) "\"");++         Text.Hamlet.condH++           [(isSel, ++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . pack) " checked"))]++           Nothing;++         (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Hamlet.attrsToHtml . toAttributes) attrs);++         (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack) ">");++         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml text);++         (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack) "</div></label>") })+++ + boolField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Bool+ boolField = Field+       { fieldParse = \e _ -> return $ boolParser e+-      , fieldView = \theId name attrs val isReq -> [whamlet|+-$newline never+-  $if not isReq+-      <input id=#{theId}-none *{attrs} type=radio name=#{name} value=none checked>+-      <label for=#{theId}-none>_{MsgSelectNone}++      , fieldView = \theId name attrs val isReq ->       do { Text.Hamlet.condH++             [(not isReq, ++               do { (Yesod.Core.Widget.asWidgetT . toWidget)++                      ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");++                    (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);++                    (Yesod.Core.Widget.asWidgetT . toWidget)++                      ((Text.Blaze.Internal.preEscapedText . pack)++                         "-none\" type=\"radio\" name=\"");++                    (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name);++                    (Yesod.Core.Widget.asWidgetT . toWidget)++                      ((Text.Blaze.Internal.preEscapedText . pack)++                         "\" value=\"none\" checked");++                    (Yesod.Core.Widget.asWidgetT . toWidget)++                      ((Text.Hamlet.attrsToHtml . toAttributes) attrs);++                    (Yesod.Core.Widget.asWidgetT . toWidget)++                      ((Text.Blaze.Internal.preEscapedText . pack) "><label for=\"");++                    (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);++                    (Yesod.Core.Widget.asWidgetT . toWidget)++                      ((Text.Blaze.Internal.preEscapedText . pack) "-none\">");++                    ((Control.Monad.liftM (toHtml .) getMessageRender)++                     >>=++                       (\ urender_arRX++                          -> (Yesod.Core.Widget.asWidgetT . toWidget)++                               (urender_arRX MsgSelectNone)));++                    (Yesod.Core.Widget.asWidgetT . toWidget)++                      ((Text.Blaze.Internal.preEscapedText . pack) "</label>") })]++             Nothing;++           (Yesod.Core.Widget.asWidgetT . toWidget)++             ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");++           (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);++           (Yesod.Core.Widget.asWidgetT . toWidget)++             ((Text.Blaze.Internal.preEscapedText . pack)++                "-yes\" type=\"radio\" name=\"");++           (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name);++           (Yesod.Core.Widget.asWidgetT . toWidget)++             ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"yes\"");++           Text.Hamlet.condH++             [(showVal id val, ++               (Yesod.Core.Widget.asWidgetT . toWidget)++                 ((Text.Blaze.Internal.preEscapedText . pack) " checked"))]++             Nothing;++           (Yesod.Core.Widget.asWidgetT . toWidget)++             ((Text.Hamlet.attrsToHtml . toAttributes) attrs);++           (Yesod.Core.Widget.asWidgetT . toWidget)++             ((Text.Blaze.Internal.preEscapedText . pack) "><label for=\"");++           (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);++           (Yesod.Core.Widget.asWidgetT . toWidget)++             ((Text.Blaze.Internal.preEscapedText . pack) "-yes\">");++           ((Control.Monad.liftM (toHtml .) getMessageRender)++            >>=++              (\ urender_arRY++                 -> (Yesod.Core.Widget.asWidgetT . toWidget)++                      (urender_arRY MsgBoolYes)));++           (Yesod.Core.Widget.asWidgetT . toWidget)++             ((Text.Blaze.Internal.preEscapedText . pack)++                "</label><input id=\"");++           (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);++           (Yesod.Core.Widget.asWidgetT . toWidget)++             ((Text.Blaze.Internal.preEscapedText . pack)++                "-no\" type=\"radio\" name=\"");++           (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name);++           (Yesod.Core.Widget.asWidgetT . toWidget)++             ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"no\"");++           Text.Hamlet.condH++             [(showVal not val, ++               (Yesod.Core.Widget.asWidgetT . toWidget)++                 ((Text.Blaze.Internal.preEscapedText . pack) " checked"))]++             Nothing;++           (Yesod.Core.Widget.asWidgetT . toWidget)++             ((Text.Hamlet.attrsToHtml . toAttributes) attrs);++           (Yesod.Core.Widget.asWidgetT . toWidget)++             ((Text.Blaze.Internal.preEscapedText . pack) "><label for=\"");++           (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);++           (Yesod.Core.Widget.asWidgetT . toWidget)++             ((Text.Blaze.Internal.preEscapedText . pack) "-no\">");++           ((Control.Monad.liftM (toHtml .) getMessageRender)++            >>=++              (\ urender_arRZ++                 -> (Yesod.Core.Widget.asWidgetT . toWidget)++                      (urender_arRZ MsgBoolNo)));++           (Yesod.Core.Widget.asWidgetT . toWidget)++             ((Text.Blaze.Internal.preEscapedText . pack) "</label>") }+ +-+-<input id=#{theId}-yes *{attrs} type=radio name=#{name} value=yes :showVal id val:checked>+-<label for=#{theId}-yes>_{MsgBoolYes}+-+-<input id=#{theId}-no *{attrs} type=radio name=#{name} value=no :showVal not val:checked>+-<label for=#{theId}-no>_{MsgBoolNo}+-|]+     , fieldEnctype = UrlEncoded+     }+   where+@@ -478,10 +868,25 @@ $newline never+ checkBoxField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Bool+ checkBoxField = Field+     { fieldParse = \e _ -> return $ checkBoxParser e+-    , fieldView  = \theId name attrs val _ -> [whamlet|+-$newline never+-<input id=#{theId} *{attrs} type=checkbox name=#{name} value=yes :showVal id val:checked>+-|]++    , fieldView  = \theId name attrs val _ ->     do { (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");++         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml theId);++         (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack)++              "\" type=\"checkbox\" name=\"");++         (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name);++         (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"yes\"");++         Text.Hamlet.condH++           [(showVal id val, ++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . pack) " checked"))]++           Nothing;++         (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Hamlet.attrsToHtml . toAttributes) attrs);++         (Yesod.Core.Widget.asWidgetT . toWidget)++           ((Text.Blaze.Internal.preEscapedText . pack) ">") }+++     , fieldEnctype = UrlEncoded+     }+ +@@ -525,49 +930,7 @@ optionsPairs opts = do+ optionsEnum :: (MonadHandler m, Show a, Enum a, Bounded a) => m (OptionList a)+ optionsEnum = optionsPairs $ map (\x -> (pack $ show x, x)) [minBound..maxBound]+ +-optionsPersist :: ( YesodPersist site, PersistEntity a+-                  , PersistQuery (YesodDB site)+-                  , PathPiece (Key a)+-                  , PersistEntityBackend a ~ PersistMonadBackend (YesodDB site)+-                  , RenderMessage site msg+-                  )+-               => [Filter a]+-               -> [SelectOpt a]+-               -> (a -> msg)+-               -> HandlerT site IO (OptionList (Entity a))+-optionsPersist filts ords toDisplay = fmap mkOptionList $ do+-    mr <- getMessageRender+-    pairs <- runDB $ selectList filts ords+-    return $ map (\(Entity key value) -> Option+-        { optionDisplay = mr (toDisplay value)+-        , optionInternalValue = Entity key value+-        , optionExternalValue = toPathPiece key+-        }) pairs+-+--- | An alternative to 'optionsPersist' which returns just the @Key@ instead of+--- the entire @Entity@.+---+--- Since 1.3.2+-optionsPersistKey+-  :: (YesodPersist site+-     , PersistEntity a+-     , PersistQuery (YesodPersistBackend site (HandlerT site IO))+-     , PathPiece (Key a)+-     , RenderMessage site msg+-     , PersistEntityBackend a ~ PersistMonadBackend (YesodDB site))+-  => [Filter a]+-  -> [SelectOpt a]+-  -> (a -> msg)+-  -> HandlerT site IO (OptionList (Key a))+-+-optionsPersistKey filts ords toDisplay = fmap mkOptionList $ do+-    mr <- getMessageRender+-    pairs <- runDB $ selectList filts ords+-    return $ map (\(Entity key value) -> Option+-        { optionDisplay = mr (toDisplay value)+-        , optionInternalValue = key+-        , optionExternalValue = toPathPiece key+-        }) pairs+++ + selectFieldHelper+         :: (Eq a, RenderMessage site FormMessage)+@@ -611,9 +974,21 @@ fileField = Field+         case files of+             [] -> Right Nothing+             file:_ -> Right $ Just file+-    , fieldView = \id' name attrs _ isReq -> toWidget [hamlet|+-            <input id=#{id'} name=#{name} *{attrs} type=file :isReq:required>+-        |]++    , fieldView = \id' name attrs _ isReq -> toWidget  $     \ _render_arSN++      -> do { id++                ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");++              id (toHtml id');++              id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");++              id (toHtml name);++              id++                ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"file\"");++              Text.Hamlet.condH++                [(isReq, ++                  id ((Text.Blaze.Internal.preEscapedText . pack) " required"))]++                Nothing;++              id ((Text.Hamlet.attrsToHtml . toAttributes) attrs);++              id ((Text.Blaze.Internal.preEscapedText . pack) ">") }+++     , fieldEnctype = Multipart+     }+ +@@ -640,10 +1015,20 @@ fileAFormReq fs = AForm $ \(site, langs) menvs ints -> do+             { fvLabel = toHtml $ renderMessage site langs $ fsLabel fs+             , fvTooltip = fmap (toHtml . renderMessage site langs) $ fsTooltip fs+             , fvId = id'+-            , fvInput = [whamlet|+-$newline never+-<input type=file name=#{name} ##{id'} *{fsAttrs fs}>+-|]++            , fvInput =             do { (Yesod.Core.Widget.asWidgetT . toWidget)++                   ((Text.Blaze.Internal.preEscapedText . pack)++                      "<input type=\"file\" name=\"");++                 (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name);++                 (Yesod.Core.Widget.asWidgetT . toWidget)++                   ((Text.Blaze.Internal.preEscapedText . pack) "\" id=\"");++                 (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml id');++                 (Yesod.Core.Widget.asWidgetT . toWidget)++                   ((Text.Blaze.Internal.preEscapedText . pack) "\"");++                 (Yesod.Core.Widget.asWidgetT . toWidget)++                   ((Text.Hamlet.attrsToHtml . toAttributes) (fsAttrs fs));++                 (Yesod.Core.Widget.asWidgetT . toWidget)++                   ((Text.Blaze.Internal.preEscapedText . pack) ">") }+++             , fvErrors = errs+             , fvRequired = True+             }+@@ -672,10 +1057,20 @@ fileAFormOpt fs = AForm $ \(master, langs) menvs ints -> do+             { fvLabel = toHtml $ renderMessage master langs $ fsLabel fs+             , fvTooltip = fmap (toHtml . renderMessage master langs) $ fsTooltip fs+             , fvId = id'+-            , fvInput = [whamlet|+-$newline never+-<input type=file name=#{name} ##{id'} *{fsAttrs fs}>+-|]++            , fvInput =             do { (Yesod.Core.Widget.asWidgetT . toWidget)++                   ((Text.Blaze.Internal.preEscapedText . pack)++                      "<input type=\"file\" name=\"");++                 (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml name);++                 (Yesod.Core.Widget.asWidgetT . toWidget)++                   ((Text.Blaze.Internal.preEscapedText . pack) "\" id=\"");++                 (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml id');++                 (Yesod.Core.Widget.asWidgetT . toWidget)++                   ((Text.Blaze.Internal.preEscapedText . pack) "\"");++                 (Yesod.Core.Widget.asWidgetT . toWidget)++                   ((Text.Hamlet.attrsToHtml . toAttributes) (fsAttrs fs));++                 (Yesod.Core.Widget.asWidgetT . toWidget)++                   ((Text.Blaze.Internal.preEscapedText . pack) ">") }+++             , fvErrors = errs+             , fvRequired = False+             }+diff --git a/Yesod/Form/Functions.hs b/Yesod/Form/Functions.hs+index 8a36710..8675a10 100644+--- a/Yesod/Form/Functions.hs++++ b/Yesod/Form/Functions.hs+@@ -53,12 +53,16 @@ import Text.Blaze (Markup, toMarkup)+ #define toHtml toMarkup+ import Yesod.Core+ import Network.Wai (requestMethod)+-import Text.Hamlet (shamlet)++--`import Text.Hamlet (shamlet)+ import Data.Monoid (mempty)+ import Data.Maybe (listToMaybe, fromMaybe)+ import qualified Data.Map as Map+ import qualified Data.Text.Encoding as TE+ import Control.Arrow (first)++import qualified Text.Blaze.Internal++import qualified Yesod.Core.Widget++import qualified Data.Foldable++import qualified Text.Hamlet+ + -- | Get a unique identifier.+ newFormIdent :: Monad m => MForm m Text+@@ -210,7 +214,14 @@ postHelper form env = do+     let token =+             case reqToken req of+                 Nothing -> mempty+-                Just n -> [shamlet|<input type=hidden name=#{tokenKey} value=#{n}>|]++                Just n ->                 do { id++                       ((Text.Blaze.Internal.preEscapedText . pack)++                          "<input type=\"hidden\" name=\"");++                     id (toHtml tokenKey);++                     id ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"");++                     id (toHtml n);++                     id ((Text.Blaze.Internal.preEscapedText . pack) "\">") }+++     m <- getYesod+     langs <- languages+     ((res, xml), enctype) <- runFormGeneric (form token) m langs env+@@ -279,7 +290,12 @@ getHelper :: MonadHandler m+           -> Maybe (Env, FileEnv)+           -> m (a, Enctype)+ getHelper form env = do+-    let fragment = [shamlet|<input type=hidden name=#{getKey}>|]++    let fragment =     do { id++           ((Text.Blaze.Internal.preEscapedText . pack)++              "<input type=\"hidden\" name=\"");++         id (toHtml getKey);++         id ((Text.Blaze.Internal.preEscapedText . pack) "\">") }+++     langs <- languages+     m <- getYesod+     runFormGeneric (form fragment) m langs env+@@ -293,19 +309,66 @@ renderTable, renderDivs, renderDivsNoLabels :: Monad m => FormRender m a+ renderTable aform fragment = do+     (res, views') <- aFormToForm aform+     let views = views' []+-    let widget = [whamlet|+-$newline never+-\#{fragment}+-$forall view <- views+-    <tr :fvRequired view:.required :not $ fvRequired view:.optional>+-        <td>+-            <label for=#{fvId view}>#{fvLabel view}+-            $maybe tt <- fvTooltip view+-                <div .tooltip>#{tt}+-        <td>^{fvInput view}+-        $maybe err <- fvErrors view+-            <td .errors>#{err}+-|]++    let widget =     do { (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml fragment);++         Data.Foldable.mapM_++           (\ view_aagq++              -> do { (Yesod.Core.Widget.asWidgetT . toWidget)++                        ((Text.Blaze.Internal.preEscapedText . pack) "<tr");++                      Text.Hamlet.condH++                        [(or [fvRequired view_aagq, not (fvRequired view_aagq)], ++                          do { (Yesod.Core.Widget.asWidgetT . toWidget)++                                 ((Text.Blaze.Internal.preEscapedText . pack) " class=\"");++                               Text.Hamlet.condH++                                 [(fvRequired view_aagq, ++                                   (Yesod.Core.Widget.asWidgetT . toWidget)++                                     ((Text.Blaze.Internal.preEscapedText . pack) "required "))]++                                 Nothing;++                               Text.Hamlet.condH++                                 [(not (fvRequired view_aagq), ++                                   (Yesod.Core.Widget.asWidgetT . toWidget)++                                     ((Text.Blaze.Internal.preEscapedText . pack) "optional"))]++                                 Nothing;++                               (Yesod.Core.Widget.asWidgetT . toWidget)++                                 ((Text.Blaze.Internal.preEscapedText . pack) "\"") })]++                        Nothing;++                      (Yesod.Core.Widget.asWidgetT . toWidget)++                        ((Text.Blaze.Internal.preEscapedText . pack) "><td><label for=\"");++                      (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml (fvId view_aagq));++                      (Yesod.Core.Widget.asWidgetT . toWidget)++                        ((Text.Blaze.Internal.preEscapedText . pack) "\">");++                      (Yesod.Core.Widget.asWidgetT . toWidget)++                        (toHtml (fvLabel view_aagq));++                      (Yesod.Core.Widget.asWidgetT . toWidget)++                        ((Text.Blaze.Internal.preEscapedText . pack) "</label>");++                      Text.Hamlet.maybeH++                        (fvTooltip view_aagq)++                        (\ tt_aagr++                           -> do { (Yesod.Core.Widget.asWidgetT . toWidget)++                                     ((Text.Blaze.Internal.preEscapedText . pack)++                                        "<div class=\"tooltip\">");++                                   (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml tt_aagr);++                                   (Yesod.Core.Widget.asWidgetT . toWidget)++                                     ((Text.Blaze.Internal.preEscapedText . pack) "</div>") })++                        Nothing;++                      (Yesod.Core.Widget.asWidgetT . toWidget)++                        ((Text.Blaze.Internal.preEscapedText . pack) "</td><td>");++                      (Yesod.Core.Widget.asWidgetT . toWidget) (fvInput view_aagq);++                      (Yesod.Core.Widget.asWidgetT . toWidget)++                        ((Text.Blaze.Internal.preEscapedText . pack) "</td>");++                      Text.Hamlet.maybeH++                        (fvErrors view_aagq)++                        (\ err_aags++                           -> do { (Yesod.Core.Widget.asWidgetT . toWidget)++                                     ((Text.Blaze.Internal.preEscapedText . pack)++                                        "<td class=\"errors\">");++                                   (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml err_aags);++                                   (Yesod.Core.Widget.asWidgetT . toWidget)++                                     ((Text.Blaze.Internal.preEscapedText . pack) "</td>") })++                        Nothing;++                      (Yesod.Core.Widget.asWidgetT . toWidget)++                        ((Text.Blaze.Internal.preEscapedText . pack) "</tr>") })++           views }+++     return (res, widget)+ + -- | render a field inside a div+@@ -318,19 +381,67 @@ renderDivsMaybeLabels :: Monad m => Bool -> FormRender m a+ renderDivsMaybeLabels withLabels aform fragment = do+     (res, views') <- aFormToForm aform+     let views = views' []+-    let widget = [whamlet|+-$newline never+-\#{fragment}+-$forall view <- views+-    <div :fvRequired view:.required :not $ fvRequired view:.optional>+-        $if withLabels+-                <label for=#{fvId view}>#{fvLabel view}+-        $maybe tt <- fvTooltip view+-            <div .tooltip>#{tt}+-        ^{fvInput view}+-        $maybe err <- fvErrors view+-            <div .errors>#{err}+-|]++    let widget =     do { (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml fragment);++         Data.Foldable.mapM_++           (\ view_aagE++              -> do { (Yesod.Core.Widget.asWidgetT . toWidget)++                        ((Text.Blaze.Internal.preEscapedText . pack) "<div");++                      Text.Hamlet.condH++                        [(or [fvRequired view_aagE, not (fvRequired view_aagE)], ++                          do { (Yesod.Core.Widget.asWidgetT . toWidget)++                                 ((Text.Blaze.Internal.preEscapedText . pack) " class=\"");++                               Text.Hamlet.condH++                                 [(fvRequired view_aagE, ++                                   (Yesod.Core.Widget.asWidgetT . toWidget)++                                     ((Text.Blaze.Internal.preEscapedText . pack) "required "))]++                                 Nothing;++                               Text.Hamlet.condH++                                 [(not (fvRequired view_aagE), ++                                   (Yesod.Core.Widget.asWidgetT . toWidget)++                                     ((Text.Blaze.Internal.preEscapedText . pack) "optional"))]++                                 Nothing;++                               (Yesod.Core.Widget.asWidgetT . toWidget)++                                 ((Text.Blaze.Internal.preEscapedText . pack) "\"") })]++                        Nothing;++                      (Yesod.Core.Widget.asWidgetT . toWidget)++                        ((Text.Blaze.Internal.preEscapedText . pack) ">");++                      Text.Hamlet.condH++                        [(withLabels, ++                          do { (Yesod.Core.Widget.asWidgetT . toWidget)++                                 ((Text.Blaze.Internal.preEscapedText . pack) "<label for=\"");++                               (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml (fvId view_aagE));++                               (Yesod.Core.Widget.asWidgetT . toWidget)++                                 ((Text.Blaze.Internal.preEscapedText . pack) "\">");++                               (Yesod.Core.Widget.asWidgetT . toWidget)++                                 (toHtml (fvLabel view_aagE));++                               (Yesod.Core.Widget.asWidgetT . toWidget)++                                 ((Text.Blaze.Internal.preEscapedText . pack) "</label>") })]++                        Nothing;++                      Text.Hamlet.maybeH++                        (fvTooltip view_aagE)++                        (\ tt_aagF++                           -> do { (Yesod.Core.Widget.asWidgetT . toWidget)++                                     ((Text.Blaze.Internal.preEscapedText . pack)++                                        "<div class=\"tooltip\">");++                                   (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml tt_aagF);++                                   (Yesod.Core.Widget.asWidgetT . toWidget)++                                     ((Text.Blaze.Internal.preEscapedText . pack) "</div>") })++                        Nothing;++                      (Yesod.Core.Widget.asWidgetT . toWidget) (fvInput view_aagE);++                      Text.Hamlet.maybeH++                        (fvErrors view_aagE)++                        (\ err_aagG++                           -> do { (Yesod.Core.Widget.asWidgetT . toWidget)++                                     ((Text.Blaze.Internal.preEscapedText . pack)++                                        "<div class=\"errors\">");++                                   (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml err_aagG);++                                   (Yesod.Core.Widget.asWidgetT . toWidget)++                                     ((Text.Blaze.Internal.preEscapedText . pack) "</div>") })++                        Nothing;++                      (Yesod.Core.Widget.asWidgetT . toWidget)++                        ((Text.Blaze.Internal.preEscapedText . pack) "</div>") })++           views }+++     return (res, widget)+ + -- | Render a form using Bootstrap-friendly shamlet syntax.+@@ -354,19 +465,63 @@ renderBootstrap aform fragment = do+     let views = views' []+         has (Just _) = True+         has Nothing  = False+-    let widget = [whamlet|+-                $newline never+-                \#{fragment}+-                $forall view <- views+-                    <div .control-group .clearfix :fvRequired view:.required :not $ fvRequired view:.optional :has $ fvErrors view:.error>+-                        <label .control-label for=#{fvId view}>#{fvLabel view}+-                        <div .controls .input>+-                            ^{fvInput view}+-                            $maybe tt <- fvTooltip view+-                                <span .help-block>#{tt}+-                            $maybe err <- fvErrors view+-                                <span .help-block>#{err}+-                |]++    let widget =     do { (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml fragment);++         Data.Foldable.mapM_++           (\ view_aagR++              -> do { (Yesod.Core.Widget.asWidgetT . toWidget)++                        ((Text.Blaze.Internal.preEscapedText . pack)++                           "<div class=\"control-group clearfix ");++                      Text.Hamlet.condH++                        [(fvRequired view_aagR, ++                          (Yesod.Core.Widget.asWidgetT . toWidget)++                            ((Text.Blaze.Internal.preEscapedText . pack) "required "))]++                        Nothing;++                      Text.Hamlet.condH++                        [(not (fvRequired view_aagR), ++                          (Yesod.Core.Widget.asWidgetT . toWidget)++                            ((Text.Blaze.Internal.preEscapedText . pack) "optional "))]++                        Nothing;++                      Text.Hamlet.condH++                        [(has (fvErrors view_aagR), ++                          (Yesod.Core.Widget.asWidgetT . toWidget)++                            ((Text.Blaze.Internal.preEscapedText . pack) "error"))]++                        Nothing;++                      (Yesod.Core.Widget.asWidgetT . toWidget)++                        ((Text.Blaze.Internal.preEscapedText . pack)++                           "\"><label class=\"control-label\" for=\"");++                      (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml (fvId view_aagR));++                      (Yesod.Core.Widget.asWidgetT . toWidget)++                        ((Text.Blaze.Internal.preEscapedText . pack) "\">");++                      (Yesod.Core.Widget.asWidgetT . toWidget)++                        (toHtml (fvLabel view_aagR));++                      (Yesod.Core.Widget.asWidgetT . toWidget)++                        ((Text.Blaze.Internal.preEscapedText . pack)++                           "</label><div class=\"controls input\">");++                      (Yesod.Core.Widget.asWidgetT . toWidget) (fvInput view_aagR);++                      Text.Hamlet.maybeH++                        (fvTooltip view_aagR)++                        (\ tt_aagS++                           -> do { (Yesod.Core.Widget.asWidgetT . toWidget)++                                     ((Text.Blaze.Internal.preEscapedText . pack)++                                        "<span class=\"help-block\">");++                                   (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml tt_aagS);++                                   (Yesod.Core.Widget.asWidgetT . toWidget)++                                     ((Text.Blaze.Internal.preEscapedText . pack) "</span>") })++                        Nothing;++                      Text.Hamlet.maybeH++                        (fvErrors view_aagR)++                        (\ err_aagT++                           -> do { (Yesod.Core.Widget.asWidgetT . toWidget)++                                     ((Text.Blaze.Internal.preEscapedText . pack)++                                        "<span class=\"help-block\">");++                                   (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml err_aagT);++                                   (Yesod.Core.Widget.asWidgetT . toWidget)++                                     ((Text.Blaze.Internal.preEscapedText . pack) "</span>") })++                        Nothing;++                      (Yesod.Core.Widget.asWidgetT . toWidget)++                        ((Text.Blaze.Internal.preEscapedText . pack) "</div></div>") })++           views }+++     return (res, widget)+ + check :: (Monad m, RenderMessage (HandlerSite m) msg)+diff --git a/Yesod/Form/Jquery.hs b/Yesod/Form/Jquery.hs+index 2c4ae25..ed9b366 100644+--- a/Yesod/Form/Jquery.hs++++ b/Yesod/Form/Jquery.hs+@@ -12,12 +12,24 @@ module Yesod.Form.Jquery+     , Default (..)+     ) where+ ++import qualified Text.Blaze as Text.Blaze.Internal++import qualified Text.Blaze.Internal++import qualified Text.Hamlet++import qualified Yesod.Core.Widget++import qualified Text.Css++import qualified Data.Monoid++import qualified Data.Foldable++import qualified Control.Monad++import qualified Text.Julius++import qualified Data.Text.Lazy.Builder++import qualified Text.Shakespeare+++ import Yesod.Core+ import Yesod.Form+ import Data.Time (Day)+ import Data.Default+-import Text.Hamlet (shamlet)+-import Text.Julius (julius, rawJS)++--import Text.Hamlet (shamlet)++import Text.Julius (rawJS)+ import Data.Text (Text, pack, unpack)+ import Data.Monoid (mconcat)+ +@@ -60,27 +72,59 @@ jqueryDayField jds = Field+               . readMay+               . unpack+     , fieldView = \theId name attrs val isReq -> do+-        toWidget [shamlet|+-$newline never+-<input id="#{theId}" name="#{name}" *{attrs} type="date" :isReq:required="" value="#{showVal val}">+-|]++        toWidget  $         do { id++               ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");++             id (toHtml theId);++             id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");++             id (toHtml name);++             id++               ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"date\"");++             Text.Hamlet.condH++               [(isReq, ++                 id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]++               Nothing;++             id ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");++             id (toHtml (showVal val));++             id ((Text.Blaze.Internal.preEscapedText . pack) "\"");++             id ((Text.Hamlet.attrsToHtml . Text.Hamlet.toAttributes) attrs);++             id ((Text.Blaze.Internal.preEscapedText . pack) ">") }+++         addScript' urlJqueryJs+         addScript' urlJqueryUiJs+         addStylesheet' urlJqueryUiCss+-        toWidget [julius|+-$(function(){+-    var i = document.getElementById("#{rawJS theId}");+-    if (i.type != "date") {+-        $(i).datepicker({+-            dateFormat:'yy-mm-dd',+-            changeMonth:#{jsBool $ jdsChangeMonth jds},+-            changeYear:#{jsBool $ jdsChangeYear jds},+-            numberOfMonths:#{rawJS $ mos $ jdsNumberOfMonths jds},+-            yearRange:#{toJSON $ jdsYearRange jds}+-        });+-    }+-});+-|]++        toWidget  $         Text.Julius.asJavascriptUrl++          (\ _render_a1lYC++             -> mconcat++                  [Text.Julius.Javascript++                     ((Data.Text.Lazy.Builder.fromText++                       . Text.Shakespeare.pack')++                        "\n$(function(){\n    var i = document.getElementById(\""),++                   Text.Julius.toJavascript (rawJS theId),++                   Text.Julius.Javascript++                     ((Data.Text.Lazy.Builder.fromText++                       . Text.Shakespeare.pack')++                        "\");\n    if (i.type != \"date\") {\n        $(i).datepicker({\n            dateFormat:'yy-mm-dd',\n            changeMonth:"),++                   Text.Julius.toJavascript (jsBool (jdsChangeMonth jds)),++                   Text.Julius.Javascript++                     ((Data.Text.Lazy.Builder.fromText++                       . Text.Shakespeare.pack')++                        ",\n            changeYear:"),++                   Text.Julius.toJavascript (jsBool (jdsChangeYear jds)),++                   Text.Julius.Javascript++                     ((Data.Text.Lazy.Builder.fromText++                       . Text.Shakespeare.pack')++                        ",\n            numberOfMonths:"),++                   Text.Julius.toJavascript (rawJS (mos (jdsNumberOfMonths jds))),++                   Text.Julius.Javascript++                     ((Data.Text.Lazy.Builder.fromText++                       . Text.Shakespeare.pack')++                        ",\n            yearRange:"),++                   Text.Julius.toJavascript (toJSON (jdsYearRange jds)),++                   Text.Julius.Javascript++                     ((Data.Text.Lazy.Builder.fromText++                       . Text.Shakespeare.pack')++                        "\n        });\n    }\n});")])+++     , fieldEnctype = UrlEncoded+     }+   where+@@ -101,16 +145,47 @@ jqueryAutocompleteField :: (RenderMessage site FormMessage, YesodJquery site)+ jqueryAutocompleteField src = Field+     { fieldParse = parseHelper $ Right+     , fieldView = \theId name attrs val isReq -> do+-        toWidget [shamlet|+-$newline never+-<input id="#{theId}" name="#{name}" *{attrs} type="text" :isReq:required="" value="#{either id id val}" .autocomplete>+-|]++        toWidget  $         do { id++               ((Text.Blaze.Internal.preEscapedText . pack)++                  "<input class=\"autocomplete\" id=\"");++             id (toHtml theId);++             id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");++             id (toHtml name);++             id++               ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"text\"");++             Text.Hamlet.condH++               [(isReq, ++                 id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]++               Nothing;++             id ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");++             id (toHtml (either id id val));++             id ((Text.Blaze.Internal.preEscapedText . pack) "\"");++             id ((Text.Hamlet.attrsToHtml . Text.Hamlet.toAttributes) attrs);++             id ((Text.Blaze.Internal.preEscapedText . pack) ">") }+++         addScript' urlJqueryJs+         addScript' urlJqueryUiJs+         addStylesheet' urlJqueryUiCss+-        toWidget [julius|+-$(function(){$("##{rawJS theId}").autocomplete({source:"@{src}",minLength:2})});+-|]++        toWidget  $         Text.Julius.asJavascriptUrl++          (\ _render_a1lYP++             -> mconcat++                  [Text.Julius.Javascript++                     ((Data.Text.Lazy.Builder.fromText++                       . Text.Shakespeare.pack')++                        "\n$(function(){$(\"#"),++                   Text.Julius.toJavascript (rawJS theId),++                   Text.Julius.Javascript++                     ((Data.Text.Lazy.Builder.fromText++                       . Text.Shakespeare.pack')++                        "\").autocomplete({source:\""),++                   Text.Julius.Javascript++                     (Data.Text.Lazy.Builder.fromText++                        (_render_a1lYP src [])),++                   Text.Julius.Javascript++                     ((Data.Text.Lazy.Builder.fromText++                       . Text.Shakespeare.pack')++                        "\",minLength:2})});")])+++     , fieldEnctype = UrlEncoded+     }+ +diff --git a/Yesod/Form/MassInput.hs b/Yesod/Form/MassInput.hs+index 332eb66..5015e7b 100644+--- a/Yesod/Form/MassInput.hs++++ b/Yesod/Form/MassInput.hs+@@ -9,6 +9,16 @@ module Yesod.Form.MassInput+     , massTable+     ) where+ ++import qualified Data.Text++import qualified Text.Blaze as Text.Blaze.Internal++import qualified Text.Blaze.Internal++import qualified Text.Hamlet++import qualified Yesod.Core.Widget++import qualified Text.Css++import qualified Data.Monoid++import qualified Data.Foldable++import qualified Control.Monad+++ import Yesod.Form.Types+ import Yesod.Form.Functions+ import Yesod.Form.Fields (boolField)+@@ -70,16 +80,28 @@ inputList label fixXml single mdef = formToAForm $ do+         { fvLabel = label+         , fvTooltip = Nothing+         , fvId = theId+-        , fvInput = [whamlet|+-$newline never+-^{fixXml views}+-<p>+-    $forall xml <- xmls+-        ^{xml}+-    <input .count type=hidden name=#{countName} value=#{count}>+-    <input type=checkbox name=#{addName}>+-    Add another row+-|]++        , fvInput =         do { (Yesod.Core.Widget.asWidgetT . toWidget) (fixXml views);++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "<p>");++             Data.Foldable.mapM_++               (\ xml_aUS3 -> (Yesod.Core.Widget.asWidgetT . toWidget) xml_aUS3)++               xmls;++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)++                  "<input class=\"count\" type=\"hidden\" name=\"");++             (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml countName);++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)++                  "\" value=\"");++             (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml count);++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)++                  "\"><input type=\"checkbox\" name=\"");++             (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml addName);++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)++                  "\">Add another row</p>") }+++         , fvErrors = Nothing+         , fvRequired = False+         }])+@@ -92,10 +114,14 @@ withDelete af = do+     deleteName <- newFormIdent+     (menv, _, _) <- ask+     res <- case menv >>= Map.lookup deleteName . fst of+-        Just ("yes":_) -> return $ Left [whamlet|+-$newline never+-<input type=hidden name=#{deleteName} value=yes>+-|]++        Just ("yes":_) -> return $ Left  $         do { (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)++                  "<input type=\"hidden\" name=\"");++             (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml deleteName);++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)++                  "\" value=\"yes\">") }+++         _ -> do+             (_, xml2) <- aFormToForm $ areq boolField FieldSettings+                 { fsLabel = SomeMessage MsgDelete+@@ -121,32 +147,155 @@ fixme eithers =+ massDivs, massTable+          :: [[FieldView site]]+          -> WidgetT site IO ()+-massDivs viewss = [whamlet|+-$newline never+-$forall views <- viewss+-    <fieldset>+-        $forall view <- views+-            <div :fvRequired view:.required :not $ fvRequired view:.optional>+-                <label for=#{fvId view}>#{fvLabel view}+-                $maybe tt <- fvTooltip view+-                    <div .tooltip>#{tt}+-                ^{fvInput view}+-                $maybe err <- fvErrors view+-                    <div .errors>#{err}+-|]++massDivs viewss = Data.Foldable.mapM_++  (\ views_aUSm++     -> do { (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)++                  "<fieldset>");++             Data.Foldable.mapM_++               (\ view_aUSn++                  -> do { (Yesod.Core.Widget.asWidgetT . toWidget)++                            ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "<div");++                          Text.Hamlet.condH++                            [(or [fvRequired view_aUSn, not (fvRequired view_aUSn)], ++                              do { (Yesod.Core.Widget.asWidgetT . toWidget)++                                     ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)++                                        " class=\"");++                                   Text.Hamlet.condH++                                     [(fvRequired view_aUSn, ++                                       (Yesod.Core.Widget.asWidgetT . toWidget)++                                         ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)++                                            "required "))]++                                     Nothing;++                                   Text.Hamlet.condH++                                     [(not (fvRequired view_aUSn), ++                                       (Yesod.Core.Widget.asWidgetT . toWidget)++                                         ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)++                                            "optional"))]++                                     Nothing;++                                   (Yesod.Core.Widget.asWidgetT . toWidget)++                                     ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)++                                        "\"") })]++                            Nothing;++                          (Yesod.Core.Widget.asWidgetT . toWidget)++                            ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)++                               "><label for=\"");++                          (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml (fvId view_aUSn));++                          (Yesod.Core.Widget.asWidgetT . toWidget)++                            ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "\">");++                          (Yesod.Core.Widget.asWidgetT . toWidget)++                            (toHtml (fvLabel view_aUSn));++                          (Yesod.Core.Widget.asWidgetT . toWidget)++                            ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</label>");++                          Text.Hamlet.maybeH++                            (fvTooltip view_aUSn)++                            (\ tt_aUSo++                               -> do { (Yesod.Core.Widget.asWidgetT . toWidget)++                                         ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)++                                            "<div class=\"tooltip\">");++                                       (Yesod.Core.Widget.asWidgetT . toWidget)++                                         (toHtml tt_aUSo);++                                       (Yesod.Core.Widget.asWidgetT . toWidget)++                                         ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)++                                            "</div>") })++                            Nothing;++                          (Yesod.Core.Widget.asWidgetT . toWidget) (fvInput view_aUSn);++                          Text.Hamlet.maybeH++                            (fvErrors view_aUSn)++                            (\ err_aUSp++                               -> do { (Yesod.Core.Widget.asWidgetT . toWidget)++                                         ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)++                                            "<div class=\"errors\">");++                                       (Yesod.Core.Widget.asWidgetT . toWidget)++                                         (toHtml err_aUSp);++                                       (Yesod.Core.Widget.asWidgetT . toWidget)++                                         ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)++                                            "</div>") })++                            Nothing;++                          (Yesod.Core.Widget.asWidgetT . toWidget)++                            ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</div>") })++               views_aUSm;++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)++                  "</fieldset>") })++  viewss++++++massTable viewss = Data.Foldable.mapM_++  (\ views_aUSu++     -> do { (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)++                  "<fieldset><table>");++             Data.Foldable.mapM_++               (\ view_aUSv++                  -> do { (Yesod.Core.Widget.asWidgetT . toWidget)++                            ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "<tr");++                          Text.Hamlet.condH++                            [(or [fvRequired view_aUSv, not (fvRequired view_aUSv)], ++                              do { (Yesod.Core.Widget.asWidgetT . toWidget)++                                     ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)++                                        " class=\"");++                                   Text.Hamlet.condH++                                     [(fvRequired view_aUSv, ++                                       (Yesod.Core.Widget.asWidgetT . toWidget)++                                         ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)++                                            "required "))]++                                     Nothing;++                                   Text.Hamlet.condH++                                     [(not (fvRequired view_aUSv), ++                                       (Yesod.Core.Widget.asWidgetT . toWidget)++                                         ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)++                                            "optional"))]++                                     Nothing;++                                   (Yesod.Core.Widget.asWidgetT . toWidget)++                                     ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)++                                        "\"") })]++                            Nothing;++                          (Yesod.Core.Widget.asWidgetT . toWidget)++                            ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)++                               "><td><label for=\"");++                          (Yesod.Core.Widget.asWidgetT . toWidget) (toHtml (fvId view_aUSv));++                          (Yesod.Core.Widget.asWidgetT . toWidget)++                            ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "\">");++                          (Yesod.Core.Widget.asWidgetT . toWidget)++                            (toHtml (fvLabel view_aUSv));++                          (Yesod.Core.Widget.asWidgetT . toWidget)++                            ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</label>");++                          Text.Hamlet.maybeH++                            (fvTooltip view_aUSv)++                            (\ tt_aUSw++                               -> do { (Yesod.Core.Widget.asWidgetT . toWidget)++                                         ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)++                                            "<div class=\"tooltip\">");++                                       (Yesod.Core.Widget.asWidgetT . toWidget)++                                         (toHtml tt_aUSw);++                                       (Yesod.Core.Widget.asWidgetT . toWidget)++                                         ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)++                                            "</div>") })++                            Nothing;++                          (Yesod.Core.Widget.asWidgetT . toWidget)++                            ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)++                               "</td><td>");++                          (Yesod.Core.Widget.asWidgetT . toWidget) (fvInput view_aUSv);++                          (Yesod.Core.Widget.asWidgetT . toWidget)++                            ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</td>");++                          Text.Hamlet.maybeH++                            (fvErrors view_aUSv)++                            (\ err_aUSx++                               -> do { (Yesod.Core.Widget.asWidgetT . toWidget)++                                         ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)++                                            "<td class=\"errors\">");++                                       (Yesod.Core.Widget.asWidgetT . toWidget)++                                         (toHtml err_aUSx);++                                       (Yesod.Core.Widget.asWidgetT . toWidget)++                                         ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)++                                            "</td>") })++                            Nothing;++                          (Yesod.Core.Widget.asWidgetT . toWidget)++                            ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</tr>") })++               views_aUSu;++             (Yesod.Core.Widget.asWidgetT . toWidget)++               ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)++                  "</table></fieldset>") })++  viewss+ +-massTable viewss = [whamlet|+-$newline never+-$forall views <- viewss+-    <fieldset>+-        <table>+-            $forall view <- views+-                <tr :fvRequired view:.required :not $ fvRequired view:.optional>+-                    <td>+-                        <label for=#{fvId view}>#{fvLabel view}+-                        $maybe tt <- fvTooltip view+-                            <div .tooltip>#{tt}+-                    <td>^{fvInput view}+-                    $maybe err <- fvErrors view+-                        <td .errors>#{err}+-|]+diff --git a/Yesod/Form/Nic.hs b/Yesod/Form/Nic.hs+index 2862678..04ddaba 100644+--- a/Yesod/Form/Nic.hs++++ b/Yesod/Form/Nic.hs+@@ -9,11 +9,24 @@ module Yesod.Form.Nic+     , nicHtmlField+     ) where+ ++import qualified Text.Blaze as Text.Blaze.Internal++import qualified Text.Blaze.Internal++import qualified Text.Hamlet++import qualified Yesod.Core.Widget++import qualified Text.Css++import qualified Data.Monoid++import qualified Data.Foldable++import qualified Control.Monad++import qualified Text.Julius++import qualified Data.Text.Lazy.Builder++import qualified Text.Shakespeare+++++ import Yesod.Core+ import Yesod.Form+ import Text.HTML.SanitizeXSS (sanitizeBalance)+-import Text.Hamlet (shamlet)+-import Text.Julius (julius, rawJS)++--import Text.Hamlet (shamlet)++import Text.Julius ( rawJS)+ import Text.Blaze.Html.Renderer.String (renderHtml)+ import Data.Text (Text, pack)+ import Data.Maybe (listToMaybe)+@@ -27,20 +40,48 @@ nicHtmlField :: YesodNic site => Field (HandlerT site IO) Html+ nicHtmlField = Field+     { fieldParse = \e _ -> return . Right . fmap (preEscapedToMarkup . sanitizeBalance) . listToMaybe $ e+     , fieldView = \theId name attrs val _isReq -> do+-        toWidget [shamlet|+-$newline never+-    <textarea id="#{theId}" *{attrs} name="#{name}" .html>#{showVal val}+-|]++        toWidget  $         do { id++               ((Text.Blaze.Internal.preEscapedText . pack)++                  "<textarea class=\"html\" id=\"");++             id (toHtml theId);++             id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");++             id (toHtml name);++             id ((Text.Blaze.Internal.preEscapedText . pack) "\"");++             id ((Text.Hamlet.attrsToHtml . Text.Hamlet.toAttributes) attrs);++             id ((Text.Blaze.Internal.preEscapedText . pack) ">");++             id (toHtml (showVal val));++             id ((Text.Blaze.Internal.preEscapedText . pack) "</textarea>") }+++         addScript' urlNicEdit+         master <- getYesod+         toWidget $+           case jsLoader master of+-            BottomOfHeadBlocking -> [julius|+-bkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance("#{rawJS theId}")});+-|]+-            _ -> [julius|+-(function(){new nicEditor({fullPanel:true}).panelInstance("#{rawJS theId}")})();+-|]++            BottomOfHeadBlocking ->             Text.Julius.asJavascriptUrl++              (\ _render_a1qhO++                 -> Data.Monoid.mconcat++                      [Text.Julius.Javascript++                         ((Data.Text.Lazy.Builder.fromText++                           . Text.Shakespeare.pack')++                            "\nbkLib.onDomLoaded(function(){new nicEditor({true}).panelInstance(\""),++                       Text.Julius.toJavascript (rawJS theId),++                       Text.Julius.Javascript++                         ((Data.Text.Lazy.Builder.fromText++                           . Text.Shakespeare.pack')++                            "\")});")])++++            _ ->             Text.Julius.asJavascriptUrl++              (\ _render_a1qhS++                 -> Data.Monoid.mconcat++                      [Text.Julius.Javascript++                         ((Data.Text.Lazy.Builder.fromText++                           . Text.Shakespeare.pack')++                            "\n(function(){new nicEditor({true}).panelInstance(\""),++                       Text.Julius.toJavascript (rawJS theId),++                       Text.Julius.Javascript++                         ((Data.Text.Lazy.Builder.fromText++                           . Text.Shakespeare.pack')++                            "\")})();")])+++     , fieldEnctype = UrlEncoded+     }+   where+diff --git a/yesod-form.cabal b/yesod-form.cabal+index 9e0c710..a39f71f 100644+--- a/yesod-form.cabal++++ b/yesod-form.cabal+@@ -19,6 +19,7 @@ library+                    , time                  >= 1.1.4+                    , hamlet                >= 1.1      && < 1.2+                    , shakespeare-css       >= 1.0      && < 1.1++                   , shakespeare+                    , shakespeare-js        >= 1.0.2    && < 1.3+                    , persistent            >= 1.2      && < 1.3+                    , template-haskell+-- +1.8.5.1+
+ standalone/no-th/haskell-patches/yesod-persistent_do-not-really-build.patch view
@@ -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+
+ standalone/no-th/haskell-patches/yesod-routes_remove-TH.patch view
@@ -0,0 +1,169 @@+From acebcf203b270d00aac0a29be48832ae2c64ce7e Mon Sep 17 00:00:00 2001+From: Joey Hess <joey@kitenet.net>+Date: Tue, 17 Dec 2013 06:57:07 +0000+Subject: [PATCH] remove TH++---+ Yesod/Routes/Parse.hs    | 39 +++++----------------------------------+ Yesod/Routes/TH.hs       | 16 ++++++++--------+ Yesod/Routes/TH/Types.hs | 16 ----------------+ yesod-routes.cabal       |  4 ----+ 4 files changed, 13 insertions(+), 62 deletions(-)++diff --git a/Yesod/Routes/Parse.hs b/Yesod/Routes/Parse.hs+index 3d27980..c2e3e6d 100644+--- a/Yesod/Routes/Parse.hs++++ b/Yesod/Routes/Parse.hs+@@ -2,11 +2,11 @@+ {-# LANGUAGE DeriveDataTypeable #-}+ {-# OPTIONS_GHC -fno-warn-missing-fields #-} -- QuasiQuoter+ module Yesod.Routes.Parse+-    ( parseRoutes+-    , parseRoutesFile+-    , parseRoutesNoCheck+-    , parseRoutesFileNoCheck+-    , parseType++    --( parseRoutes++    --, parseRoutesFile++    --, parseRoutesNoCheck++    --, parseRoutesFileNoCheck++    ( parseType+     , parseTypeTree+     , TypeTree (..)+     ) where+@@ -19,41 +19,12 @@ import Yesod.Routes.TH+ import Yesod.Routes.Overlap (findOverlapNames)+ import Data.List (foldl')+ +--- | 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+-    qAddDependentFile fp+-    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+diff --git a/Yesod/Routes/TH.hs b/Yesod/Routes/TH.hs+index 7b2e50b..b05fc57 100644+--- a/Yesod/Routes/TH.hs++++ b/Yesod/Routes/TH.hs+@@ -2,15 +2,15 @@+ module Yesod.Routes.TH+     ( module Yesod.Routes.TH.Types+       -- * Functions+-    , module Yesod.Routes.TH.RenderRoute+-    , module Yesod.Routes.TH.ParseRoute+-    , module Yesod.Routes.TH.RouteAttrs++    -- , module Yesod.Routes.TH.RenderRoute++    -- , module Yesod.Routes.TH.ParseRoute++    -- , module Yesod.Routes.TH.RouteAttrs+       -- ** Dispatch+-    , module Yesod.Routes.TH.Dispatch++    -- , module Yesod.Routes.TH.Dispatch+     ) where+ + import Yesod.Routes.TH.Types+-import Yesod.Routes.TH.RenderRoute+-import Yesod.Routes.TH.ParseRoute+-import Yesod.Routes.TH.RouteAttrs+-import Yesod.Routes.TH.Dispatch++--import Yesod.Routes.TH.RenderRoute++--import Yesod.Routes.TH.ParseRoute++--import Yesod.Routes.TH.RouteAttrs++--import Yesod.Routes.TH.Dispatch+diff --git a/Yesod/Routes/TH/Types.hs b/Yesod/Routes/TH/Types.hs+index d0a0405..3232e99 100644+--- a/Yesod/Routes/TH/Types.hs++++ b/Yesod/Routes/TH/Types.hs+@@ -31,10 +31,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)]+@@ -48,9 +44,6 @@ type CheckOverlap = Bool+ instance Functor Resource where+     fmap f (Resource a b c d) = Resource a (map (second $ fmap f) b) (fmap f c) d+ +-instance Lift t => Lift (Resource t) where+-    lift (Resource a b c d) = [|Resource a b c d|]+-+ data Piece typ = Static String | Dynamic typ+     deriving Show+ +@@ -58,10 +51,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+@@ -77,11 +66,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 0e44409..e01ea06 100644+--- a/yesod-routes.cabal++++ b/yesod-routes.cabal+@@ -28,10 +28,6 @@ library+                      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+     ghc-options:     -Wall+ + test-suite runtests+-- +1.8.5.1+
+ standalone/no-th/haskell-patches/yesod-static_remove-TH.patch view
@@ -0,0 +1,597 @@+From ad0166a6e537021c9f5a1e01cde4b7c520edcf3a Mon Sep 17 00:00:00 2001+From: Joey Hess <joey@kitenet.net>+Date: Wed, 18 Dec 2013 05:10:59 +0000+Subject: [PATCH] remove TH++---+ Yesod/EmbeddedStatic.hs            |  64 -----------+ Yesod/EmbeddedStatic/Generators.hs | 102 +----------------+ Yesod/EmbeddedStatic/Internal.hs   |  41 -------+ Yesod/EmbeddedStatic/Types.hs      |  14 ---+ Yesod/Static.hs                    | 224 +------------------------------------+ 5 files changed, 12 insertions(+), 433 deletions(-)++diff --git a/Yesod/EmbeddedStatic.hs b/Yesod/EmbeddedStatic.hs+index e819630..a564d4b 100644+--- a/Yesod/EmbeddedStatic.hs++++ b/Yesod/EmbeddedStatic.hs+@@ -41,7 +41,6 @@ module Yesod.EmbeddedStatic (+   -- * Subsite+     EmbeddedStatic+   , embeddedResourceR+-  , mkEmbeddedStatic+   , embedStaticContent+ +   -- * Generators+@@ -91,69 +90,6 @@ instance Yesod master => YesodSubDispatch EmbeddedStatic (HandlerT master IO) wh+                             ("widget":_) -> staticApp (widgetSettings site) req+                             _ -> return $ responseLBS status404 [] "Not Found"+ +--- | Create the haskell variable for the link to the entry+-mkRoute :: ComputedEntry -> Q [Dec]+-mkRoute (ComputedEntry { cHaskellName = Nothing }) = return []+-mkRoute (c@ComputedEntry { cHaskellName = Just name }) = do+-    routeType <- [t| Route EmbeddedStatic |]+-    link <- [| $(cLink c) |]+-    return [ SigD name routeType+-           , ValD (VarP name) (NormalB link) []+-           ]+-+--- | Creates an 'EmbeddedStatic' by running, at compile time, a list of generators. +--- Each generator produces a list of entries to embed into the executable.+---+--- This template haskell splice creates a variable binding holding the resulting+--- 'EmbeddedStatic' and in addition creates variable bindings for all the routes+--- produced by the generators.  For example, if a directory called static has+--- the following contents:+---+--- * js/jquery.js+---+--- * css/bootstrap.css+---+--- * img/logo.png+---+--- then a call to+---+--- > #ifdef DEVELOPMENT+--- > #define DEV_BOOL True+--- > #else+--- > #define DEV_BOOL False+--- > #endif+--- > mkEmbeddedStatic DEV_BOOL "myStatic" [embedDir "static"]+---+--- will produce variables+---+--- > myStatic :: EmbeddedStatic+--- > js_jquery_js :: Route EmbeddedStatic+--- > css_bootstrap_css :: Route EmbeddedStatic+--- > img_logo_png :: Route EmbeddedStatic+-mkEmbeddedStatic :: Bool -- ^ development?+-                 -> String -- ^ variable name for the created 'EmbeddedStatic'+-                 -> [Generator] -- ^ the generators (see "Yesod.EmbeddedStatic.Generators")+-                 -> Q [Dec]+-mkEmbeddedStatic dev esName gen = do+-    entries <- concat <$> sequence gen+-    computed <- runIO $ mapM (if dev then devEmbed else prodEmbed) entries+-+-    let settings = Static.mkSettings $ return $ map cStEntry computed+-        devExtra = listE $ catMaybes $ map ebDevelExtraFiles entries+-        ioRef  = [| unsafePerformIO $ newIORef M.empty |]+-+-    -- build the embedded static+-    esType <- [t| EmbeddedStatic |]+-    esCreate <- if dev+-                  then [| EmbeddedStatic (develApp $settings $devExtra) $ioRef |]+-                  else [| EmbeddedStatic (staticApp $! $settings) $ioRef |]+-    let es = [ SigD (mkName esName) esType+-             , ValD (VarP $ mkName esName) (NormalB esCreate) []+-             ]+-+-    routes <- mapM mkRoute computed+-+-    return $ es ++ concat routes+ + -- | Use this for 'addStaticContent' to have the widget static content be served by+ --   the embedded static subsite.  For example,+diff --git a/Yesod/EmbeddedStatic/Generators.hs b/Yesod/EmbeddedStatic/Generators.hs+index e83785d..bc35359 100644+--- a/Yesod/EmbeddedStatic/Generators.hs++++ b/Yesod/EmbeddedStatic/Generators.hs+@@ -6,12 +6,12 @@+ module Yesod.EmbeddedStatic.Generators (+   -- * Generators+     Location+-  , embedFile+-  , embedFileAt+-  , embedDir+-  , embedDirAt+-  , concatFiles+-  , concatFilesWith++  --, embedFile++  --, embedFileAt++  --, embedDir++  --, embedDirAt++  --, concatFiles++  --, concatFilesWith+ +   -- * Compression options for 'concatFilesWith'+   , jasmine+@@ -50,28 +50,6 @@ import qualified Data.Text as T+ + import Yesod.EmbeddedStatic.Types+ +--- | Embed a single file.  Equivalent to passing the same string twice to 'embedFileAt'.+-embedFile :: FilePath -> Generator+-embedFile f = embedFileAt f f+-+--- | Embed a single file at a given location within the static subsite and generate a+---   route variable based on the location via 'pathToName'.  The @FilePath@ must be a relative+---   path to the directory in which you run @cabal build@.  During development, the file located+---   at this filepath will be reloaded on every request.  When compiling for production, the contents+---   of the file will be embedded into the executable and so the file does not need to be+---   distributed along with the executable.+-embedFileAt :: Location -> FilePath -> Generator+-embedFileAt loc f = do+-    let mime = defaultMimeLookup $ T.pack f+-    let entry = def {+-                    ebHaskellName = Just $ pathToName loc+-                  , ebLocation = loc+-                  , ebMimeType = mime+-                  , ebProductionContent = BL.readFile f+-                  , ebDevelReload = [| BL.readFile $(litE $ stringL f) |]+-                  }+-    return [entry]+-+ -- | List all files recursively in a directory+ getRecursiveContents :: Location -- ^ The directory to search+                      -> FilePath   -- ^ The prefix to add to the filenames+@@ -88,74 +66,6 @@ getRecursiveContents prefix topdir = do+       else return [(loc, path)]+   return (concat paths)+ +--- | Embed all files in a directory into the static subsite.+--- +--- Equivalent to passing the empty string as the location to 'embedDirAt',+--- so the directory path itself is not part of the resource locations (and so+--- also not part of the generated route variable names).+-embedDir :: FilePath -> Generator+-embedDir = embedDirAt ""+-+--- | Embed all files in a directory to a given location within the static subsite.+---+--- The directory tree rooted at the 'FilePath' (which must be relative to the directory in+--- which you run @cabal build@) is embedded into the static subsite at the given+--- location.  Also, route variables will be created based on the final location+--- of each file.  For example, if a directory \"static\" contains the files+---+--- * css/bootstrap.css+---+--- * js/jquery.js+---+--- * js/bootstrap.js+--- +--- then @embedDirAt \"somefolder\" \"static\"@ will+---+--- * Make the file @static\/css\/bootstrap.css@ available at the location+---   @somefolder\/css\/bootstrap.css@ within the static subsite and similarly+---   for the other two files.+---+--- * Create variables @somefolder_css_bootstrap_css@, @somefolder_js_jquery_js@,+---   @somefolder_js_bootstrap_js@ all of type @Route EmbeddedStatic@.+---+--- * During development, the files will be reloaded on every request.  During+---   production, the contents of all files will be embedded into the executable.+---+--- * During development, files that are added to the directory while the server+---   is running will not be detected.  You need to recompile the module which+---   contains the call to @mkEmbeddedStatic@.  This will also generate new route+---   variables for the new files.+-embedDirAt :: Location -> FilePath -> Generator+-embedDirAt loc dir = do+-    files <- runIO $ getRecursiveContents loc dir+-    concat <$> mapM (uncurry embedFileAt) files+-+--- | Concatinate a list of files and embed it at the location.  Equivalent to passing @return@ to+---   'concatFilesWith'.+-concatFiles :: Location -> [FilePath] -> Generator+-concatFiles loc files = concatFilesWith loc return files+-+--- | Concatinate a list of files into a single 'BL.ByteString', run the resulting content through the given+---   function, embed it at the given location, and create a haskell variable name for the route based on+---   the location.+---+---   The processing function is only run when compiling for production, and the processing function is+---   executed at compile time.  During development, on every request the files listed are reloaded,+---   concatenated, and served as a single resource at the given location without being processed.+-concatFilesWith :: Location -> (BL.ByteString -> IO BL.ByteString) -> [FilePath] -> Generator+-concatFilesWith loc process files = do+-    let load = do putStrLn $ "Creating " ++ loc+-                  BL.concat <$> mapM BL.readFile files >>= process+-        expFiles = listE $ map (litE . stringL) files+-        expCt = [| BL.concat <$> mapM BL.readFile $expFiles |]+-        mime = defaultMimeLookup $ T.pack loc+-    return [def { ebHaskellName = Just $ pathToName loc+-                , ebLocation = loc+-                , ebMimeType = mime+-                , ebProductionContent = load+-                , ebDevelReload = expCt+-                }]+-+ -- | Convienient rexport of 'minifym' with a type signature to work with 'concatFilesWith'.+ jasmine :: BL.ByteString -> IO BL.ByteString+ jasmine ct = return $ either (const ct) id $ minifym ct+diff --git a/Yesod/EmbeddedStatic/Internal.hs b/Yesod/EmbeddedStatic/Internal.hs+index 0882c16..6f61a0f 100644+--- a/Yesod/EmbeddedStatic/Internal.hs++++ b/Yesod/EmbeddedStatic/Internal.hs+@@ -7,9 +7,6 @@+ module Yesod.EmbeddedStatic.Internal (+       EmbeddedStatic(..)+     , Route(..)+-    , ComputedEntry(..)+-    , devEmbed+-    , prodEmbed+     , develApp+     , AddStaticContent+     , staticContentHelper+@@ -68,44 +65,6 @@ instance ParseRoute EmbeddedStatic where+     parseRoute (["widget",h], _) = Just $ EmbeddedWidgetR h+     parseRoute _ = Nothing+ +--- | At compile time, one of these is created for every 'Entry' created by+--- the generators.  The cLink is a template haskell expression of type @Route EmbeddedStatic@.+-data ComputedEntry = ComputedEntry {+-      cHaskellName :: Maybe Name               -- ^ Optional haskell name to create a variable for the route+-    , cStEntry     :: Static.EmbeddableEntry   -- ^ The entry to be embedded into the executable+-    , cLink        :: ExpQ                     -- ^ The route for this entry+-}+-+-mkStr :: String -> ExpQ+-mkStr = litE . stringL+-+--- | Create a 'ComputedEntry' for development mode, reloading the content on every request.+-devEmbed :: Entry -> IO ComputedEntry+-devEmbed e = return computed+-    where+-        st = Static.EmbeddableEntry {+-                   Static.eLocation = "res/" `T.append` T.pack (ebLocation e)+-                 , Static.eMimeType = ebMimeType e+-                 , Static.eContent  = Right [| $(ebDevelReload e) >>= \c ->+-                                               return (T.pack (base64md5 c), c) |]+-                 }+-        link = [| EmbeddedResourceR (T.splitOn (T.pack "/") $ T.pack $(mkStr $ ebLocation e)) [] |]+-        computed = ComputedEntry (ebHaskellName e) st link+-+--- | Create a 'ComputedEntry' for production mode, hashing and embedding the content into the executable.+-prodEmbed :: Entry -> IO ComputedEntry+-prodEmbed e = do+-    ct <- ebProductionContent e+-    let hash = base64md5 ct+-        link = [| EmbeddedResourceR (T.splitOn (T.pack "/") $ T.pack $(mkStr $ ebLocation e))+-                                    [(T.pack "etag", T.pack $(mkStr hash))] |]+-        st = Static.EmbeddableEntry {+-                   Static.eLocation = "res/" `T.append` T.pack (ebLocation e)+-                 , Static.eMimeType = ebMimeType e+-                 , Static.eContent  = Left (T.pack hash, ct)+-                 }+-    return $ ComputedEntry (ebHaskellName e) st link+-+ tryExtraDevelFiles :: [[T.Text] -> IO (Maybe (MimeType, BL.ByteString))] -> Application+ tryExtraDevelFiles [] _ = return $ responseLBS status404 [] ""+ tryExtraDevelFiles (f:fs) r = do+diff --git a/Yesod/EmbeddedStatic/Types.hs b/Yesod/EmbeddedStatic/Types.hs+index 5cbd662..d3e514f 100644+--- a/Yesod/EmbeddedStatic/Types.hs++++ b/Yesod/EmbeddedStatic/Types.hs+@@ -1,7 +1,6 @@+ {-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-}+ module Yesod.EmbeddedStatic.Types(+     Location+-  , Generator+   -- ** Entry+   , Entry+   , ebHaskellName+@@ -52,16 +51,3 @@ data Entry = Entry {+         --   taking as input the list of path pieces and optionally returning a mime type+         --   and content.+ }+-+--- | When using 'def', you must fill in at least 'ebLocation'.+-instance Default Entry where+-    def = Entry { ebHaskellName = Nothing+-                , ebLocation = "xxxx"+-                , ebMimeType = "application/octet-stream"+-                , ebProductionContent = return BL.empty+-                , ebDevelReload = [| return BL.empty |]+-                , ebDevelExtraFiles = Nothing+-                }+-+--- | An embedded generator is executed at compile time to produce the entries to embed.+-type Generator = Q [Entry]+diff --git a/Yesod/Static.hs b/Yesod/Static.hs+index ef27f1b..5795f45 100644+--- a/Yesod/Static.hs++++ b/Yesod/Static.hs+@@ -37,8 +37,8 @@ module Yesod.Static+     , staticDevel+       -- * Combining CSS/JS+       -- $combining+-    , combineStylesheets'+-    , combineScripts'++    --, combineStylesheets'++    --, combineScripts'+       -- ** Settings+     , CombineSettings+     , csStaticDir+@@ -48,13 +48,13 @@ module Yesod.Static+     , csJsPreProcess+     , csCombinedFolder+       -- * Template Haskell helpers+-    , staticFiles+-    , staticFilesList+-    , publicFiles++    --, staticFiles++    --, staticFilesList++    --, publicFiles+       -- * Hashing+     , base64md5+       -- * Embed+-    , embed++    --, embed+ #ifdef TEST_EXPORT+     , getFileListPieces+ #endif+@@ -64,7 +64,6 @@ import Prelude hiding (FilePath)+ import qualified Prelude+ import System.Directory+ import Control.Monad+-import Data.FileEmbed (embedDir)+ + import Yesod.Core+ import Yesod.Core.Types+@@ -135,21 +134,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.+---+--- You should use "Yesod.EmbeddedStatic" instead, it is much more powerful.+---+--- 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').+     --+@@ -214,59 +198,6 @@ getFileListPieces = flip evalStateT M.empty . flip go id+                 put $ M.insert s s m+                 return s+ +--- | 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+@@ -309,53 +240,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 $(TH.lift f)|]+-        let route = mkName routeConName+-        pack' <- [|pack|]+-        qs <- if makeHash+-                    then do hash <- qRunIO $ base64md5File $ pathFromRawPieces fp f+-                            [|[(pack "etag", pack $(TH.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+@@ -379,55 +263,6 @@ base64 = map tr+     tr '/' = '_'+     tr c   = c+ +--- $combining+---+--- A common scenario on a site is the desire to include many external CSS and+--- Javascript files on every page. Doing so via the Widget functionality in+--- Yesod will work, but would also mean that the same content will be+--- downloaded many times. A better approach would be to combine all of these+--- files together into a single static file and serve that as a static resource+--- for every page. That resource can be cached on the client, and bandwidth+--- usage reduced.+---+--- This could be done as a manual process, but that becomes tedious. Instead,+--- you can use some Template Haskell code which will combine these files into a+--- single static file at compile time.+-+-data CombineType = JS | CSS+-+-combineStatics' :: CombineType+-                -> CombineSettings+-                -> [Route Static] -- ^ files to combine+-                -> Q Exp+-combineStatics' combineType CombineSettings {..} routes = do+-    texts <- qRunIO $ runResourceT $ mapM_ yield fps $$ awaitForever readUTFFile =$ consume+-    ltext <- qRunIO $ preProcess $ TL.fromChunks texts+-    bs    <- qRunIO $ postProcess fps $ TLE.encodeUtf8 ltext+-    let hash' = base64md5 bs+-        suffix = csCombinedFolder </> F.decodeString hash' <.> extension+-        fp = csStaticDir </> suffix+-    qRunIO $ do+-        createTree $ F.directory fp+-        L.writeFile (F.encodeString fp) bs+-    let pieces = map T.unpack $ T.splitOn "/" $ either id id $ F.toText suffix+-    [|StaticRoute (map pack pieces) []|]+-  where+-    fps :: [F.FilePath]+-    fps = map toFP routes+-    toFP (StaticRoute pieces _) = csStaticDir </> F.concat (map F.fromText pieces)+-    readUTFFile fp = sourceFile (F.encodeString fp) =$= CT.decode CT.utf8+-    postProcess =+-        case combineType of+-            JS -> csJsPostProcess+-            CSS -> csCssPostProcess+-    preProcess =+-        case combineType of+-            JS -> csJsPreProcess+-            CSS -> csCssPreProcess+-    extension =+-        case combineType of+-            JS -> "js"+-            CSS -> "css"+ + -- | Data type for holding all settings for combining files.+ --+@@ -504,50 +339,3 @@ instance Default CombineSettings where+ errorIntro :: [FilePath] -> [Char] -> [Char]+ errorIntro fps s = "Error minifying " ++ show fps ++ ": " ++ s+ +-liftRoutes :: [Route Static] -> Q Exp+-liftRoutes =+-    fmap ListE . mapM go+-  where+-    go :: Route Static -> Q Exp+-    go (StaticRoute x y) = [|StaticRoute $(liftTexts x) $(liftPairs y)|]+-+-    liftTexts = fmap ListE . mapM liftT+-    liftT t = [|pack $(TH.lift $ T.unpack t)|]+-+-    liftPairs = fmap ListE . mapM liftPair+-    liftPair (x, y) = [|($(liftT x), $(liftT y))|]+-+--- | Combine multiple CSS files together. Common usage would be:+---+--- >>> combineStylesheets' development def 'StaticR [style1_css, style2_css]+---+--- Where @development@ is a variable in your site indicated whether you are in+--- development or production mode.+---+--- Since 1.2.0+-combineStylesheets' :: Bool -- ^ development? if so, perform no combining+-                    -> CombineSettings+-                    -> Name -- ^ Static route constructor name, e.g. \'StaticR+-                    -> [Route Static] -- ^ files to combine+-                    -> Q Exp+-combineStylesheets' development cs con routes+-    | development = [| mapM_ (addStylesheet . $(return $ ConE con)) $(liftRoutes routes) |]+-    | otherwise = [| addStylesheet $ $(return $ ConE con) $(combineStatics' CSS cs routes) |]+-+-+--- | Combine multiple JS files together. Common usage would be:+---+--- >>> combineScripts' development def 'StaticR [script1_js, script2_js]+---+--- Where @development@ is a variable in your site indicated whether you are in+--- development or production mode.+---+--- Since 1.2.0+-combineScripts' :: Bool -- ^ development? if so, perform no combining+-                -> CombineSettings+-                -> Name -- ^ Static route constructor name, e.g. \'StaticR+-                -> [Route Static] -- ^ files to combine+-                -> Q Exp+-combineScripts' development cs con routes+-    | development = [| mapM_ (addScript . $(return $ ConE con)) $(liftRoutes routes) |]+-    | otherwise = [| addScript $ $(return $ ConE con) $(combineStatics' JS cs routes) |]+-- +1.8.5.1+
+ standalone/no-th/haskell-patches/yesod_hack-TH.patch view
@@ -0,0 +1,140 @@+From e3d1ead4f02c2c45e64a1ccad5b461cc6fdabbd2 Mon Sep 17 00:00:00 2001+From: dummy <dummy@example.com>+Date: Tue, 17 Dec 2013 18:48:56 +0000+Subject: [PATCH] hack for TH++---+ Yesod.hs              | 19 ++++++++++++--+ Yesod/Default/Util.hs | 69 ++-------------------------------------------------+ 2 files changed, 19 insertions(+), 69 deletions(-)++diff --git a/Yesod.hs b/Yesod.hs+index b367144..fbe309c 100644+--- a/Yesod.hs++++ b/Yesod.hs+@@ -5,9 +5,24 @@ module Yesod+     ( -- * Re-exports from yesod-core+       module Yesod.Core+     , module Yesod.Form+-    , module Yesod.Persist++    , insertBy++    , replace++    , deleteBy++    , delete++    , insert ++    , Key+     ) where+ + import Yesod.Core+ import Yesod.Form+-import Yesod.Persist++++-- 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+++diff --git a/Yesod/Default/Util.hs b/Yesod/Default/Util.hs+index a10358e..0547424 100644+--- a/Yesod/Default/Util.hs++++ b/Yesod/Default/Util.hs+@@ -5,10 +5,9 @@+ module Yesod.Default.Util+     ( addStaticContentExternal+     , globFile+-    , widgetFileNoReload+-    , widgetFileReload++    --, 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,68 +65,7 @@ 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+-+-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.8.5.1+
standalone/osx/git-annex.app/Contents/MacOS/git-annex view
@@ -1,5 +1,11 @@ #!/bin/sh-base="$(dirname "$0")"+link="$(readlink "$0")" || true+if [ -n "$link" ]; then+	base="$(dirname "$link")"+else+	base="$(dirname "$0")"+fi+ if [ ! -d "$base" ]; then 	echo "** cannot find base directory (I seem to be $0)" >&2 	exit 1
standalone/osx/git-annex.app/Contents/MacOS/git-annex-shell view
@@ -1,5 +1,11 @@ #!/bin/sh-base="$(dirname "$0")"+link="$(readlink "$0")" || true+if [ -n "$link" ]; then+	base="$(dirname "$link")"+else+	base="$(dirname "$0")"+fi+ if [ ! -d "$base" ]; then 	echo "** cannot find base directory (I seem to be $0)" >&2 	exit 1
standalone/osx/git-annex.app/Contents/MacOS/git-annex-webapp view
@@ -1,5 +1,11 @@ #!/bin/sh-base="$(dirname "$0")"+link="$(readlink "$0")" || true+if [ -n "$link" ]; then+	base="$(dirname "$link")"+else+	base="$(dirname "$0")"+fi+ if [ ! -d "$base" ]; then 	echo "** cannot find base directory (I seem to be $0)" >&2 	exit 1