git-annex 5.20141013 → 5.20141024
raw patch · 191 files changed
+3295/−2084 lines, 191 filesdep +setenv
Dependencies added: setenv
Files
- Annex/Branch/Transitions.hs +2/−1
- Annex/Environment.hs +5/−13
- Assistant/Upgrade.hs +1/−1
- Assistant/WebApp/Configurators/AWS.hs +2/−5
- Assistant/WebApp/Configurators/Edit.hs +1/−1
- Assistant/WebApp/Configurators/IA.hs +1/−1
- Assistant/WebApp/Configurators/XMPP.hs +1/−1
- Assistant/WebApp/DashBoard.hs +1/−1
- Assistant/WebApp/Form.hs +5/−2
- Assistant/WebApp/Page.hs +1/−1
- Assistant/WebApp/RepoList.hs +1/−1
- Assistant/WebApp/SideBar.hs +1/−1
- Assistant/WebApp/Types.hs +1/−1
- CHANGELOG +24/−0
- CmdLine/GitAnnex.hs +76/−76
- CmdLine/GitAnnexShell.hs +9/−9
- CmdLine/Usage.hs +2/−0
- Command/Add.hs +2/−2
- Command/AddUnused.hs +2/−2
- Command/AddUrl.hs +2/−2
- Command/Assistant.hs +2/−2
- Command/Commit.hs +2/−2
- Command/ConfigList.hs +2/−2
- Command/Copy.hs +2/−2
- Command/Dead.hs +2/−2
- Command/Describe.hs +2/−2
- Command/Direct.hs +2/−2
- Command/Drop.hs +2/−2
- Command/DropKey.hs +2/−2
- Command/DropUnused.hs +2/−2
- Command/EnableRemote.hs +2/−2
- Command/ExamineKey.hs +2/−2
- Command/Find.hs +2/−2
- Command/FindRef.hs +2/−2
- Command/Fix.hs +2/−2
- Command/Forget.hs +2/−2
- Command/FromKey.hs +2/−2
- Command/Fsck.hs +2/−2
- Command/FuzzTest.hs +2/−2
- Command/GCryptSetup.hs +2/−2
- Command/Get.hs +2/−2
- Command/Group.hs +2/−2
- Command/Help.hs +11/−11
- Command/Import.hs +2/−2
- Command/ImportFeed.hs +2/−2
- Command/InAnnex.hs +2/−2
- Command/Indirect.hs +2/−2
- Command/Info.hs +105/−30
- Command/Init.hs +2/−2
- Command/InitRemote.hs +10/−6
- Command/List.hs +2/−2
- Command/Lock.hs +2/−2
- Command/Log.hs +2/−2
- Command/LookupKey.hs +2/−2
- Command/Map.hs +5/−5
- Command/Merge.hs +2/−2
- Command/MetaData.hs +2/−2
- Command/Migrate.hs +2/−2
- Command/Mirror.hs +2/−2
- Command/Move.hs +2/−2
- Command/NotifyChanges.hs +2/−2
- Command/NumCopies.hs +2/−2
- Command/PreCommit.hs +2/−2
- Command/ReKey.hs +2/−2
- Command/RecvKey.hs +2/−2
- Command/Reinit.hs +2/−2
- Command/Reinject.hs +2/−2
- Command/RemoteDaemon.hs +2/−2
- Command/Repair.hs +2/−2
- Command/ResolveMerge.hs +2/−2
- Command/RmUrl.hs +2/−2
- Command/Schedule.hs +2/−2
- Command/Semitrust.hs +2/−2
- Command/SendKey.hs +2/−2
- Command/Status.hs +2/−2
- Command/Sync.hs +2/−2
- Command/Test.hs +2/−2
- Command/TestRemote.hs +2/−2
- Command/TransferInfo.hs +2/−2
- Command/TransferKey.hs +2/−2
- Command/TransferKeys.hs +2/−2
- Command/Trust.hs +4/−4
- Command/Unannex.hs +2/−2
- Command/Ungroup.hs +2/−2
- Command/Uninit.hs +2/−2
- Command/Unlock.hs +2/−2
- Command/Untrust.hs +2/−2
- Command/Unused.hs +2/−2
- Command/Upgrade.hs +2/−2
- Command/VAdd.hs +2/−2
- Command/VCycle.hs +2/−2
- Command/VFilter.hs +2/−2
- Command/VPop.hs +2/−2
- Command/Version.hs +2/−2
- Command/Vicfg.hs +23/−5
- Command/View.hs +3/−3
- Command/Wanted.hs +2/−2
- Command/Watch.hs +2/−2
- Command/WebApp.hs +3/−3
- Command/Whereis.hs +2/−2
- Command/XMPPGit.hs +5/−5
- Creds.hs +34/−7
- Git/CurrentRepo.hs +1/−9
- Git/Index.hs +2/−2
- Logs/Trust.hs +2/−1
- Remote/Bup.hs +1/−0
- Remote/Ddar.hs +1/−0
- Remote/Directory.hs +2/−1
- Remote/External.hs +1/−0
- Remote/GCrypt.hs +1/−0
- Remote/Git.hs +1/−0
- Remote/Glacier.hs +7/−2
- Remote/Helper/AWS.hs +3/−0
- Remote/Helper/Chunked.hs +9/−0
- Remote/Helper/Encryptable.hs +13/−0
- Remote/Helper/Git.hs +5/−0
- Remote/Helper/Special.hs +6/−0
- Remote/Hook.hs +2/−1
- Remote/Rsync.hs +1/−0
- Remote/S3.hs +13/−7
- Remote/Tahoe.hs +2/−1
- Remote/Web.hs +2/−1
- Remote/WebDAV.hs +3/−1
- Test.hs +1/−7
- Types/Remote.hs +3/−1
- Types/TrustLevel.hs +4/−0
- Utility/Env.hs +15/−14
- Utility/Gpg.hs +1/−1
- Utility/Lsof.hs +1/−1
- Utility/Yesod.hs +21/−6
- debian/changelog +24/−0
- doc/bugs/Build_error_with_Yesod_1.4.mdwn +287/−0
- doc/bugs/Issue_fewer_S3_GET_requests.mdwn +9/−0
- doc/bugs/annex_get_fails_from_read-only_filesystem.mdwn +3/−0
- doc/bugs/cannot_add_local_readonly_repo_through_the_webapp.mdwn +98/−0
- doc/bugs/get_from_glacier_fails_too_early.mdwn +72/−0
- doc/bugs/new_AWS_region___40__eu-central-1__41__.mdwn +8/−0
- doc/bugs/present_files__47__directories_are_dropped_after_a_sync.mdwn +4/−1
- doc/bugs/rsync_remote_is_not_working.mdwn +26/−0
- doc/bugs/sync_does_not_preserve_timestamps.mdwn +0/−16
- doc/bugs/vicfg_and_description_often_not_propagated.mdwn +2/−0
- doc/devblog/day_224-226__long_rainy_slog.mdwn +14/−0
- doc/devblog/day_227__info.mdwn +33/−0
- doc/devblog/day__228_new_AWS.mdwn +13/−0
- doc/forum/ARM_build_on_Zyxel_NAS.mdwn +15/−0
- doc/forum/Changing_files_during_git_annex_runs.mdwn +12/−0
- doc/forum/Copying_to_S3_does_not_work_-_chunking_does_not_work.mdwn +47/−0
- doc/forum/Default_annex.largefiles.mdwn +1/−0
- doc/forum/Git-Annex_Android_sync_files_are_missing_on_Linuxx.mdwn +4/−0
- doc/forum/How_to_work_with_transfer_repos_manually__63__.mdwn +18/−0
- doc/forum/lsof_resource_use_problems.mdwn +42/−0
- doc/git-annex.mdwn +8/−8
- doc/news/version_5.20140831.mdwn +0/−13
- doc/news/version_5.20140915.mdwn +0/−27
- doc/news/version_5.20141013.mdwn +7/−0
- doc/news/version_5.20141024.mdwn +21/−0
- doc/tips/deleting_unwanted_files.mdwn +40/−0
- doc/tips/file_manager_integration.mdwn +1/−1
- doc/todo/does_not_preserve_timestamps.mdwn +16/−0
- doc/todo/read-only_removable_drives.mdwn +8/−0
- doc/todo/show_readonly_removable_drives_in_the_webapp.mdwn +15/−0
- doc/todo/vicfg_comment_gotcha.mdwn +4/−0
- git-annex.1 +8/−8
- git-annex.cabal +2/−2
- git-annex.hs +9/−30
- standalone/android/Makefile +3/−3
- standalone/android/buildchroot +1/−1
- standalone/android/buildchroot-inchroot +3/−8
- standalone/android/buildchroot-inchroot-asuser +1/−5
- standalone/android/cabal.config +208/−0
- standalone/android/haskell-patches/entropy_cross-build.patch +0/−25
- standalone/android/haskell-patches/gnuidn_fix-build-with-new-base.patch +50/−0
- standalone/android/haskell-patches/shakespeare-text_remove-TH.patch +153/−0
- standalone/android/haskell-patches/unix-time_hack-for-Bionic.patch +12/−25
- standalone/android/install-haskell-packages +30/−40
- standalone/android/term.patch +2/−2
- standalone/no-th/haskell-patches/DAV_build-without-TH.patch +18/−12
- standalone/no-th/haskell-patches/hamlet_hack_TH.patch +205/−0
- standalone/no-th/haskell-patches/lens_no-TH.patch +26/−26
- standalone/no-th/haskell-patches/optparse-applicative_remove-ANN.patch +33/−0
- standalone/no-th/haskell-patches/persistent-template_stub-out.patch +7/−7
- standalone/no-th/haskell-patches/persistent_1.1.5.1_0001-disable-TH.patch +7/−7
- standalone/no-th/haskell-patches/process-conduit_avoid-TH.patch +8/−8
- standalone/no-th/haskell-patches/shakespeare-css_remove_TH.patch +366/−0
- standalone/no-th/haskell-patches/shakespeare-js_hack_TH.patch +316/−0
- standalone/no-th/haskell-patches/shakespeare_remove-TH.patch +180/−1313
- standalone/no-th/haskell-patches/vector_hack-to-build-with-new-ghc.patch +30/−5
- standalone/no-th/haskell-patches/yesod-core_expand_TH.patch +29/−32
- standalone/no-th/haskell-patches/yesod-form_spliced-TH.patch +109/−42
- standalone/no-th/haskell-patches/yesod-persistent_do-not-really-build.patch +7/−7
- standalone/no-th/haskell-patches/yesod_hack-TH.patch +9/−10
Annex/Branch/Transitions.hs view
@@ -19,6 +19,7 @@ import Types.UUID import qualified Data.Map as M+import Data.Default data FileTransition = ChangeFile String@@ -60,4 +61,4 @@ dropDeadFromPresenceLog trustmap = filter $ notDead trustmap (toUUID . Presence.info) notDead :: TrustMap -> (v -> UUID) -> v -> Bool-notDead trustmap a v = M.findWithDefault SemiTrusted (a v) trustmap /= DeadTrusted+notDead trustmap a v = M.findWithDefault def (a v) trustmap /= DeadTrusted
Annex/Environment.hs view
@@ -13,10 +13,7 @@ import Utility.UserInfo import qualified Git.Config import Config--#ifndef mingw32_HOST_OS import Utility.Env-#endif {- Checks that the system's environment allows git to function. - Git requires a GECOS username, or suitable git configuration, or@@ -35,23 +32,18 @@ liftIO checkEnvironmentIO checkEnvironmentIO :: IO ()-checkEnvironmentIO =-#ifdef mingw32_HOST_OS- noop-#else- whenM (null <$> myUserGecos) $ do- username <- myUserName- ensureEnv "GIT_AUTHOR_NAME" username- ensureEnv "GIT_COMMITTER_NAME" username+checkEnvironmentIO = whenM (null <$> myUserGecos) $ do+ username <- myUserName+ ensureEnv "GIT_AUTHOR_NAME" username+ ensureEnv "GIT_COMMITTER_NAME" username where #ifndef __ANDROID__ -- existing environment is not overwritten- ensureEnv var val = void $ setEnv var val False+ ensureEnv var val = setEnv var val False #else -- Environment setting is broken on Android, so this is dealt with -- in runshell instead. ensureEnv _ _ = noop-#endif #endif {- Runs an action that commits to the repository, and if it fails,
Assistant/Upgrade.hs view
@@ -52,7 +52,7 @@ prepUpgrade :: Assistant () prepUpgrade = do void $ addAlert upgradingAlert- void $ liftIO $ setEnv upgradedEnv "1" True+ liftIO $ setEnv upgradedEnv "1" True prepRestart postUpgrade :: URLString -> Assistant ()
Assistant/WebApp/Configurators/AWS.hs view
@@ -162,7 +162,7 @@ #ifdef WITH_S3 getEnableS3R uuid = do m <- liftAnnex readRemoteLog- if isIARemoteConfig $ fromJust $ M.lookup uuid m+ if maybe False S3.configIA (M.lookup uuid m) then redirect $ EnableIAR uuid else postEnableS3R uuid #else@@ -220,12 +220,9 @@ bucket = fromMaybe "" $ M.lookup "bucket" c #ifdef WITH_S3-isIARemoteConfig :: RemoteConfig -> Bool-isIARemoteConfig = S3.isIAHost . fromMaybe "" . M.lookup "host"- previouslyUsedAWSCreds :: Annex (Maybe CredPair) previouslyUsedAWSCreds = getM gettype [S3.remote, Glacier.remote] where gettype t = previouslyUsedCredPair AWS.creds t $- not . isIARemoteConfig . Remote.config+ not . S3.configIA . Remote.config #endif
Assistant/WebApp/Configurators/Edit.hs view
@@ -239,7 +239,7 @@ getRepoInfo (Just r) (Just c) = case M.lookup "type" c of Just "S3" #ifdef WITH_S3- | S3.isIA c -> IA.getRepoInfo c+ | S3.configIA c -> IA.getRepoInfo c #endif | otherwise -> AWS.getRepoInfo c Just t
Assistant/WebApp/Configurators/IA.hs view
@@ -107,7 +107,7 @@ #ifdef WITH_S3 previouslyUsedIACreds :: Annex (Maybe CredPair) previouslyUsedIACreds = previouslyUsedCredPair AWS.creds S3.remote $- AWS.isIARemoteConfig . Remote.config+ S3.configIA . Remote.config #endif accessKeyIDFieldWithHelp :: Maybe Text -> MkAForm Text
Assistant/WebApp/Configurators/XMPP.hs view
@@ -125,7 +125,7 @@ waitNotifier getBuddyListBroadcaster nid p <- widgetToPageContent buddyListDisplay- giveUrlRenderer $ [hamlet|^{pageBody p}|]+ withUrlRenderer $ [hamlet|^{pageBody p}|] buddyListDisplay :: Widget buddyListDisplay = do
Assistant/WebApp/DashBoard.hs view
@@ -66,7 +66,7 @@ waitNotifier getTransferBroadcaster nid p <- widgetToPageContent transfersDisplay- giveUrlRenderer $ [hamlet|^{pageBody p}|]+ withUrlRenderer $ [hamlet|^{pageBody p}|] {- The main dashboard. -} dashboard :: Bool -> Widget
Assistant/WebApp/Form.hs view
@@ -18,14 +18,17 @@ #if MIN_VERSION_yesod(1,2,0) import Yesod hiding (textField, passwordField) import Yesod.Form.Fields as F-import Yesod.Form.Bootstrap3 hiding (bfs) #else import Yesod hiding (textField, passwordField, selectField, selectFieldList) import Yesod.Form.Fields as F hiding (selectField, selectFieldList) import Data.String (IsString (..)) import Control.Monad (unless) import Data.Maybe (listToMaybe)-import Assistant.WebApp.Bootstrap3 hiding (bfs)+#endif+#if MIN_VERSION_yesod_form(1,3,8)+import Yesod.Form.Bootstrap3 as Y hiding (bfs)+#else+import Assistant.WebApp.Bootstrap3 as Y hiding (bfs) #endif import Data.Text (Text)
Assistant/WebApp/Page.hs view
@@ -66,7 +66,7 @@ when with_longpolling $ addScript $ StaticR js_longpolling_js $(widgetFile "page")- giveUrlRenderer $(Hamlet.hamletFile $ hamletTemplate "bootstrap")+ withUrlRenderer $(Hamlet.hamletFile $ hamletTemplate "bootstrap") Just msg -> error msg where navdetails i = (navBarName i, navBarRoute i, Just i == navbaritem)
Assistant/WebApp/RepoList.hs view
@@ -91,7 +91,7 @@ getRepoListR nid reposelector = do waitNotifier getRepoListBroadcaster nid p <- widgetToPageContent $ repoListDisplay reposelector- giveUrlRenderer $ [hamlet|^{pageBody p}|]+ withUrlRenderer $ [hamlet|^{pageBody p}|] mainRepoSelector :: RepoSelector mainRepoSelector = RepoSelector
Assistant/WebApp/SideBar.hs view
@@ -73,7 +73,7 @@ liftIO $ threadDelay 100000 page <- widgetToPageContent sideBarDisplay- giveUrlRenderer $ [hamlet|^{pageBody page}|]+ withUrlRenderer $ [hamlet|^{pageBody page}|] {- Called by the client to close an alert. -} getCloseAlert :: AlertId -> Handler ()
Assistant/WebApp/Types.hs view
@@ -78,7 +78,7 @@ addScript $ StaticR js_jquery_full_js addScript $ StaticR js_bootstrap_js $(widgetFile "error")- giveUrlRenderer $(hamletFile $ hamletTemplate "bootstrap")+ withUrlRenderer $(hamletFile $ hamletTemplate "bootstrap") instance RenderMessage WebApp FormMessage where renderMessage _ _ = defaultFormMessage
CHANGELOG view
@@ -1,3 +1,27 @@+git-annex (5.20141024) unstable; urgency=medium++ * vicfg: Deleting configurations now resets to the default, where+ before it has no effect.+ * Remove hurd stuff from cabal file, since hackage currently rejects+ it, and the test suite fails on hurd.+ * initremote: Don't allow creating a special remote that has the same+ name as an existing git remote.+ * Windows: Use haskell setenv library to clean up several ugly workarounds+ for inability to manipulate the environment on windows. This includes+ making git-annex not re-exec itself on start on windows, and making the+ test suite on Windows run tests without forking.+ * glacier: Fix pipe setup when calling glacier-cli to retrieve an object.+ * info: When run on a single annexed file, displays some info about the + file, including its key and size.+ * info: When passed the name or uuid of a remote, displays info about that+ remote. Remotes that support encryption, chunking, or embedded+ creds will include that in their info.+ * enableremote: When the remote has creds, update the local creds cache+ file. Before, the old version of the creds could be left there, and+ would continue to be used.++ -- Joey Hess <joeyh@debian.org> Fri, 24 Oct 2014 13:03:29 -0400+ git-annex (5.20141013) unstable; urgency=medium * Adjust cabal file to support building w/o assistant on the hurd.
CmdLine/GitAnnex.hs view
@@ -107,91 +107,91 @@ cmds :: [Command] cmds = concat- [ Command.Add.def- , Command.Get.def- , Command.Drop.def- , Command.Move.def- , Command.Copy.def- , Command.Unlock.def- , Command.Lock.def- , Command.Sync.def- , Command.Mirror.def- , Command.AddUrl.def+ [ Command.Add.cmd+ , Command.Get.cmd+ , Command.Drop.cmd+ , Command.Move.cmd+ , Command.Copy.cmd+ , Command.Unlock.cmd+ , Command.Lock.cmd+ , Command.Sync.cmd+ , Command.Mirror.cmd+ , Command.AddUrl.cmd #ifdef WITH_FEED- , Command.ImportFeed.def+ , Command.ImportFeed.cmd #endif- , Command.RmUrl.def- , Command.Import.def- , Command.Init.def- , Command.Describe.def- , Command.InitRemote.def- , Command.EnableRemote.def- , Command.Reinject.def- , Command.Unannex.def- , Command.Uninit.def- , Command.Reinit.def- , Command.PreCommit.def- , Command.NumCopies.def- , Command.Trust.def- , Command.Untrust.def- , Command.Semitrust.def- , Command.Dead.def- , Command.Group.def- , Command.Wanted.def- , Command.Schedule.def- , Command.Ungroup.def- , Command.Vicfg.def- , Command.LookupKey.def- , Command.ExamineKey.def- , Command.FromKey.def- , Command.DropKey.def- , Command.TransferKey.def- , Command.TransferKeys.def- , Command.ReKey.def- , Command.MetaData.def- , Command.View.def- , Command.VAdd.def- , Command.VFilter.def- , Command.VPop.def- , Command.VCycle.def- , Command.Fix.def- , Command.Fsck.def- , Command.Repair.def- , Command.Unused.def- , Command.DropUnused.def- , Command.AddUnused.def- , Command.Find.def- , Command.FindRef.def- , Command.Whereis.def- , Command.List.def- , Command.Log.def- , Command.Merge.def- , Command.ResolveMerge.def- , Command.Info.def- , Command.Status.def- , Command.Migrate.def- , Command.Map.def- , Command.Direct.def- , Command.Indirect.def- , Command.Upgrade.def- , Command.Forget.def- , Command.Version.def- , Command.Help.def+ , Command.RmUrl.cmd+ , Command.Import.cmd+ , Command.Init.cmd+ , Command.Describe.cmd+ , Command.InitRemote.cmd+ , Command.EnableRemote.cmd+ , Command.Reinject.cmd+ , Command.Unannex.cmd+ , Command.Uninit.cmd+ , Command.Reinit.cmd+ , Command.PreCommit.cmd+ , Command.NumCopies.cmd+ , Command.Trust.cmd+ , Command.Untrust.cmd+ , Command.Semitrust.cmd+ , Command.Dead.cmd+ , Command.Group.cmd+ , Command.Wanted.cmd+ , Command.Schedule.cmd+ , Command.Ungroup.cmd+ , Command.Vicfg.cmd+ , Command.LookupKey.cmd+ , Command.ExamineKey.cmd+ , Command.FromKey.cmd+ , Command.DropKey.cmd+ , Command.TransferKey.cmd+ , Command.TransferKeys.cmd+ , Command.ReKey.cmd+ , Command.MetaData.cmd+ , Command.View.cmd+ , Command.VAdd.cmd+ , Command.VFilter.cmd+ , Command.VPop.cmd+ , Command.VCycle.cmd+ , Command.Fix.cmd+ , Command.Fsck.cmd+ , Command.Repair.cmd+ , Command.Unused.cmd+ , Command.DropUnused.cmd+ , Command.AddUnused.cmd+ , Command.Find.cmd+ , Command.FindRef.cmd+ , Command.Whereis.cmd+ , Command.List.cmd+ , Command.Log.cmd+ , Command.Merge.cmd+ , Command.ResolveMerge.cmd+ , Command.Info.cmd+ , Command.Status.cmd+ , Command.Migrate.cmd+ , Command.Map.cmd+ , Command.Direct.cmd+ , Command.Indirect.cmd+ , Command.Upgrade.cmd+ , Command.Forget.cmd+ , Command.Version.cmd+ , Command.Help.cmd #ifdef WITH_ASSISTANT- , Command.Watch.def- , Command.Assistant.def+ , Command.Watch.cmd+ , Command.Assistant.cmd #ifdef WITH_WEBAPP- , Command.WebApp.def+ , Command.WebApp.cmd #endif #ifdef WITH_XMPP- , Command.XMPPGit.def+ , Command.XMPPGit.cmd #endif- , Command.RemoteDaemon.def+ , Command.RemoteDaemon.cmd #endif- , Command.Test.def+ , Command.Test.cmd #ifdef WITH_TESTSUITE- , Command.FuzzTest.def- , Command.TestRemote.def+ , Command.FuzzTest.cmd+ , Command.TestRemote.cmd #endif ]
CmdLine/GitAnnexShell.hs view
@@ -34,19 +34,19 @@ cmds_readonly :: [Command] cmds_readonly = concat- [ gitAnnexShellCheck Command.ConfigList.def- , gitAnnexShellCheck Command.InAnnex.def- , gitAnnexShellCheck Command.SendKey.def- , gitAnnexShellCheck Command.TransferInfo.def- , gitAnnexShellCheck Command.NotifyChanges.def+ [ gitAnnexShellCheck Command.ConfigList.cmd+ , gitAnnexShellCheck Command.InAnnex.cmd+ , gitAnnexShellCheck Command.SendKey.cmd+ , gitAnnexShellCheck Command.TransferInfo.cmd+ , gitAnnexShellCheck Command.NotifyChanges.cmd ] cmds_notreadonly :: [Command] cmds_notreadonly = concat- [ gitAnnexShellCheck Command.RecvKey.def- , gitAnnexShellCheck Command.DropKey.def- , gitAnnexShellCheck Command.Commit.def- , Command.GCryptSetup.def+ [ gitAnnexShellCheck Command.RecvKey.cmd+ , gitAnnexShellCheck Command.DropKey.cmd+ , gitAnnexShellCheck Command.Commit.cmd+ , Command.GCryptSetup.cmd ] cmds :: [Command]
CmdLine/Usage.hs view
@@ -103,6 +103,8 @@ paramSize = "SIZE" paramAddress :: String paramAddress = "ADDRESS"+paramItem :: String+paramItem = "ITEM" paramKeyValue :: String paramKeyValue = "K=V" paramNothing :: String
Command/Add.hs view
@@ -34,8 +34,8 @@ import Control.Exception (IOException) -def :: [Command]-def = [notBareRepo $ withOptions [includeDotFilesOption] $+cmd :: [Command]+cmd = [notBareRepo $ withOptions [includeDotFilesOption] $ command "add" paramPaths seek SectionCommon "add files to annex"]
Command/AddUnused.hs view
@@ -14,8 +14,8 @@ import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused) import Types.Key -def :: [Command]-def = [notDirect $ command "addunused" (paramRepeating paramNumRange)+cmd :: [Command]+cmd = [notDirect $ command "addunused" (paramRepeating paramNumRange) seek SectionMaintenance "add back unused files"] seek :: CommandSeek
Command/AddUrl.hs view
@@ -32,8 +32,8 @@ import qualified Utility.Quvi as Quvi #endif -def :: [Command]-def = [notBareRepo $ withOptions [fileOption, pathdepthOption, relaxedOption] $+cmd :: [Command]+cmd = [notBareRepo $ withOptions [fileOption, pathdepthOption, relaxedOption] $ command "addurl" (paramRepeating paramUrl) seek SectionCommon "add urls to annex"]
Command/Assistant.hs view
@@ -18,8 +18,8 @@ import System.Environment -def :: [Command]-def = [noRepo checkAutoStart $ dontCheck repoExists $ withOptions options $+cmd :: [Command]+cmd = [noRepo checkAutoStart $ dontCheck repoExists $ withOptions options $ notBareRepo $ command "assistant" paramNothing seek SectionCommon "automatically handle changes"]
Command/Commit.hs view
@@ -12,8 +12,8 @@ import qualified Annex.Branch import qualified Git -def :: [Command]-def = [command "commit" paramNothing seek+cmd :: [Command]+cmd = [command "commit" paramNothing seek SectionPlumbing "commits any staged changes to the git-annex branch"] seek :: CommandSeek
Command/ConfigList.hs view
@@ -15,8 +15,8 @@ import qualified Git.Config import Remote.GCrypt (coreGCryptId) -def :: [Command]-def = [noCommit $ command "configlist" paramNothing seek+cmd :: [Command]+cmd = [noCommit $ command "configlist" paramNothing seek SectionPlumbing "outputs relevant git configuration"] seek :: CommandSeek
Command/Copy.hs view
@@ -14,8 +14,8 @@ import Annex.Wanted import Config.NumCopies -def :: [Command]-def = [withOptions Command.Move.moveOptions $ command "copy" paramPaths seek+cmd :: [Command]+cmd = [withOptions Command.Move.moveOptions $ command "copy" paramPaths seek SectionCommon "copy content of files to/from another repository"] seek :: CommandSeek
Command/Dead.hs view
@@ -11,8 +11,8 @@ import Types.TrustLevel import Command.Trust (trustCommand) -def :: [Command]-def = [command "dead" (paramRepeating paramRemote) seek+cmd :: [Command]+cmd = [command "dead" (paramRepeating paramRemote) seek SectionSetup "hide a lost repository"] seek :: CommandSeek
Command/Describe.hs view
@@ -12,8 +12,8 @@ import qualified Remote import Logs.UUID -def :: [Command]-def = [command "describe" (paramPair paramRemote paramDesc) seek+cmd :: [Command]+cmd = [command "describe" (paramPair paramRemote paramDesc) seek SectionSetup "change description of a repository"] seek :: CommandSeek
Command/Direct.hs view
@@ -15,8 +15,8 @@ import Config import Annex.Direct -def :: [Command]-def = [notBareRepo $ noDaemonRunning $+cmd :: [Command]+cmd = [notBareRepo $ noDaemonRunning $ command "direct" paramNothing seek SectionSetup "switch repository to direct mode"]
Command/Drop.hs view
@@ -22,8 +22,8 @@ import qualified Data.Set as S -def :: [Command]-def = [withOptions [dropFromOption] $ command "drop" paramPaths seek+cmd :: [Command]+cmd = [withOptions [dropFromOption] $ command "drop" paramPaths seek SectionCommon "indicate content of files not currently wanted"] dropFromOption :: Option
Command/DropKey.hs view
@@ -13,8 +13,8 @@ import Logs.Location import Annex.Content -def :: [Command]-def = [noCommit $ command "dropkey" (paramRepeating paramKey) seek+cmd :: [Command]+cmd = [noCommit $ command "dropkey" (paramRepeating paramKey) seek SectionPlumbing "drops annexed content for specified keys"] seek :: CommandSeek
Command/DropUnused.hs view
@@ -16,8 +16,8 @@ import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused) import Config.NumCopies -def :: [Command]-def = [withOptions [Command.Drop.dropFromOption] $+cmd :: [Command]+cmd = [withOptions [Command.Drop.dropFromOption] $ command "dropunused" (paramRepeating paramNumRange) seek SectionMaintenance "drop unused file content"]
Command/EnableRemote.hs view
@@ -15,8 +15,8 @@ import qualified Data.Map as M -def :: [Command]-def = [command "enableremote"+cmd :: [Command]+cmd = [command "enableremote" (paramPair paramName $ paramOptional $ paramRepeating paramKeyValue) seek SectionSetup "enables use of an existing special remote"]
Command/ExamineKey.hs view
@@ -13,8 +13,8 @@ import Command.Find (formatOption, getFormat, showFormatted, keyVars) import Types.Key -def :: [Command]-def = [noCommit $ noMessages $ withOptions [formatOption, jsonOption] $+cmd :: [Command]+cmd = [noCommit $ noMessages $ withOptions [formatOption, jsonOption] $ command "examinekey" (paramRepeating paramKey) seek SectionPlumbing "prints information from a key"]
Command/Find.hs view
@@ -18,8 +18,8 @@ import Utility.DataUnits import Types.Key -def :: [Command]-def = [mkCommand $ command "find" paramPaths seek SectionQuery "lists available files"]+cmd :: [Command]+cmd = [mkCommand $ command "find" paramPaths seek SectionQuery "lists available files"] mkCommand :: Command -> Command mkCommand = noCommit . noMessages . withOptions [formatOption, print0Option, jsonOption]
Command/FindRef.hs view
@@ -10,8 +10,8 @@ import Command import qualified Command.Find as Find -def :: [Command]-def = [Find.mkCommand $ command "findref" paramRef seek SectionPlumbing+cmd :: [Command]+cmd = [Find.mkCommand $ command "findref" paramRef seek SectionPlumbing "lists files in a git ref"] seek :: CommandSeek
Command/Fix.hs view
@@ -18,8 +18,8 @@ #endif #endif -def :: [Command]-def = [notDirect $ noCommit $ command "fix" paramPaths seek+cmd :: [Command]+cmd = [notDirect $ noCommit $ command "fix" paramPaths seek SectionMaintenance "fix up symlinks to point to annexed content"] seek :: CommandSeek
Command/Forget.hs view
@@ -15,8 +15,8 @@ import Data.Time.Clock.POSIX -def :: [Command]-def = [withOptions forgetOptions $ command "forget" paramNothing seek+cmd :: [Command]+cmd = [withOptions forgetOptions $ command "forget" paramNothing seek SectionMaintenance "prune git-annex branch history"] forgetOptions :: [Option]
Command/FromKey.hs view
@@ -13,8 +13,8 @@ import Annex.Content import Types.Key -def :: [Command]-def = [notDirect $ notBareRepo $+cmd :: [Command]+cmd = [notDirect $ notBareRepo $ command "fromkey" (paramPair paramKey paramPath) seek SectionPlumbing "adds a file using a specific key"]
Command/Fsck.hs view
@@ -39,8 +39,8 @@ import System.Posix.Types (EpochTime) import System.Locale -def :: [Command]-def = [withOptions fsckOptions $ command "fsck" paramPaths seek+cmd :: [Command]+cmd = [withOptions fsckOptions $ command "fsck" paramPaths seek SectionMaintenance "check for problems"] fsckFromOption :: Option
Command/FuzzTest.hs view
@@ -20,8 +20,8 @@ import Test.QuickCheck import Control.Concurrent -def :: [Command]-def = [ notBareRepo $ command "fuzztest" paramNothing seek SectionTesting+cmd :: [Command]+cmd = [ notBareRepo $ command "fuzztest" paramNothing seek SectionTesting "generates fuzz test files"] seek :: CommandSeek
Command/GCryptSetup.hs view
@@ -13,8 +13,8 @@ import qualified Remote.GCrypt import qualified Git -def :: [Command]-def = [dontCheck repoExists $ noCommit $+cmd :: [Command]+cmd = [dontCheck repoExists $ noCommit $ command "gcryptsetup" paramValue seek SectionPlumbing "sets up gcrypt repository"]
Command/Get.hs view
@@ -16,8 +16,8 @@ import Annex.Wanted import qualified Command.Move -def :: [Command]-def = [withOptions getOptions $ command "get" paramPaths seek+cmd :: [Command]+cmd = [withOptions getOptions $ command "get" paramPaths seek SectionCommon "make content of annexed files available"] getOptions :: [Option]
Command/Group.hs view
@@ -15,8 +15,8 @@ import qualified Data.Set as S -def :: [Command]-def = [command "group" (paramPair paramRemote paramDesc) seek+cmd :: [Command]+cmd = [command "group" (paramPair paramRemote paramDesc) seek SectionSetup "add a repository to a group"] seek :: CommandSeek
Command/Help.hs view
@@ -21,8 +21,8 @@ import System.Console.GetOpt -def :: [Command]-def = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $+cmd :: [Command]+cmd = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $ command "help" paramNothing seek SectionQuery "display help"] seek :: CommandSeek@@ -47,15 +47,15 @@ showGeneralHelp = putStrLn $ unlines [ "The most frequently used git-annex commands are:" , unlines $ map cmdline $ concat- [ Command.Init.def- , Command.Add.def- , Command.Drop.def- , Command.Get.def- , Command.Move.def- , Command.Copy.def- , Command.Sync.def- , Command.Whereis.def- , Command.Fsck.def+ [ Command.Init.cmd+ , Command.Add.cmd+ , Command.Drop.cmd+ , Command.Get.cmd+ , Command.Move.cmd+ , Command.Copy.cmd+ , Command.Sync.cmd+ , Command.Whereis.cmd+ , Command.Fsck.cmd ] , "Run 'git-annex' for a complete command list." , "Run 'git-annex command --help' for help on a specific command."
Command/Import.hs view
@@ -16,8 +16,8 @@ import Remote import Types.KeySource -def :: [Command]-def = [withOptions opts $ notBareRepo $ command "import" paramPaths seek+cmd :: [Command]+cmd = [withOptions opts $ notBareRepo $ command "import" paramPaths seek SectionCommon "move and add files from outside git working copy"] opts :: [Option]
Command/ImportFeed.hs view
@@ -37,8 +37,8 @@ import Logs.MetaData import Annex.MetaData -def :: [Command]-def = [notBareRepo $ withOptions [templateOption, relaxedOption] $+cmd :: [Command]+cmd = [notBareRepo $ withOptions [templateOption, relaxedOption] $ command "importfeed" (paramRepeating paramUrl) seek SectionCommon "import files from podcast feeds"]
Command/InAnnex.hs view
@@ -11,8 +11,8 @@ import Command import Annex.Content -def :: [Command]-def = [noCommit $ command "inannex" (paramRepeating paramKey) seek+cmd :: [Command]+cmd = [noCommit $ command "inannex" (paramRepeating paramKey) seek SectionPlumbing "checks if keys are present in the annex"] seek :: CommandSeek
Command/Indirect.hs view
@@ -22,8 +22,8 @@ import Annex.Init import qualified Command.Add -def :: [Command]-def = [notBareRepo $ noDaemonRunning $+cmd :: [Command]+cmd = [notBareRepo $ noDaemonRunning $ command "indirect" paramNothing seek SectionSetup "switch repository to indirect mode"]
Command/Info.hs view
@@ -1,6 +1,6 @@ {- git-annex command -- - Copyright 2011 Joey Hess <joey@kitenet.net>+ - Copyright 2011-2014 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -}@@ -16,14 +16,16 @@ import Data.Ord import Common.Annex-import qualified Remote import qualified Command.Unused import qualified Git import qualified Annex+import qualified Remote+import qualified Types.Remote as Remote import Command import Utility.DataUnits import Utility.DiskFree import Annex.Content+import Annex.Link import Types.Key import Logs.UUID import Logs.Trust@@ -65,43 +67,68 @@ , referencedData :: Maybe KeyData , numCopiesStats :: Maybe NumCopiesStats }+ +emptyStatInfo :: StatInfo+emptyStatInfo = StatInfo Nothing Nothing Nothing -- a state monad for running Stats in type StatState = StateT StatInfo Annex -def :: [Command]-def = [noCommit $ dontCheck repoExists $ withOptions [jsonOption] $- command "info" paramPaths seek SectionQuery- "shows general information about the annex"]+cmd :: [Command]+cmd = [noCommit $ dontCheck repoExists $ withOptions [jsonOption] $+ command "info" (paramOptional $ paramRepeating paramItem) seek SectionQuery+ "shows information about the specified item or the repository as a whole"] seek :: CommandSeek seek = withWords start -start :: [FilePath] -> CommandStart+start :: [String] -> CommandStart start [] = do globalInfo stop start ps = do- mapM_ localInfo =<< filterM isdir ps+ mapM_ itemInfo ps stop- where- isdir = liftIO . catchBoolIO . (isDirectory <$$> getFileStatus) globalInfo :: Annex () globalInfo = do stats <- selStats global_fast_stats global_slow_stats showCustom "info" $ do- evalStateT (mapM_ showStat stats) (StatInfo Nothing Nothing Nothing)+ evalStateT (mapM_ showStat stats) emptyStatInfo return True -localInfo :: FilePath -> Annex ()-localInfo dir = showCustom (unwords ["info", dir]) $ do- stats <- selStats (tostats local_fast_stats) (tostats local_slow_stats)- evalStateT (mapM_ showStat stats) =<< getLocalStatInfo dir+itemInfo :: String -> Annex ()+itemInfo p = ifM (isdir p)+ ( dirInfo p+ , do+ v <- Remote.byName' p+ case v of+ Right r -> remoteInfo r+ Left _ -> maybe noinfo (fileInfo p) =<< isAnnexLink p+ )+ where+ isdir = liftIO . catchBoolIO . (isDirectory <$$> getFileStatus)+ noinfo = error $ p ++ " is not a directory or an annexed file or a remote"++dirInfo :: FilePath -> Annex ()+dirInfo dir = showCustom (unwords ["info", dir]) $ do+ stats <- selStats (tostats dir_fast_stats) (tostats dir_slow_stats)+ evalStateT (mapM_ showStat stats) =<< getDirStatInfo dir return True where tostats = map (\s -> s dir) +fileInfo :: FilePath -> Key -> Annex ()+fileInfo file k = showCustom (unwords ["info", file]) $ do+ evalStateT (mapM_ showStat (file_stats file k)) emptyStatInfo+ return True++remoteInfo :: Remote -> Annex ()+remoteInfo r = showCustom (unwords ["info", Remote.name r]) $ do+ info <- map (\(k, v) -> simpleStat k (pure v)) <$> Remote.getInfo r+ evalStateT (mapM_ showStat (remote_stats r ++ info)) emptyStatInfo+ return True+ selStats :: [Stat] -> [Stat] -> Annex [Stat] selStats fast_stats slow_stats = do fast <- Annex.getState Annex.fast@@ -132,22 +159,42 @@ , bloom_info , backend_usage ]-local_fast_stats :: [FilePath -> Stat]-local_fast_stats =- [ local_dir+dir_fast_stats :: [FilePath -> Stat]+dir_fast_stats =+ [ dir_name , const local_annex_keys , const local_annex_size , const known_annex_files , const known_annex_size ]-local_slow_stats :: [FilePath -> Stat]-local_slow_stats =+dir_slow_stats :: [FilePath -> Stat]+dir_slow_stats = [ const numcopies_stats ] +file_stats :: FilePath -> Key -> [Stat]+file_stats f k =+ [ file_name f+ , key_size k+ , key_name k+ ]++remote_stats :: Remote -> [Stat]+remote_stats r = map (\s -> s r)+ [ remote_name+ , remote_description+ , remote_uuid+ , remote_cost+ , remote_type+ ]+ stat :: String -> (String -> StatState String) -> Stat stat desc a = return $ Just (desc, a desc) +-- The json simply contains the same string that is displayed.+simpleStat :: String -> StatState String -> Stat+simpleStat desc getval = stat desc $ json id getval+ nostat :: Stat nostat = return Nothing @@ -168,7 +215,7 @@ lift . showRaw =<< a repository_mode :: Stat-repository_mode = stat "repository mode" $ json id $ lift $+repository_mode = simpleStat "repository mode" $ lift $ ifM isDirect ( return "direct", return "indirect" ) @@ -181,15 +228,37 @@ where n = showTrustLevel level ++ " repositories" -local_dir :: FilePath -> Stat-local_dir dir = stat "directory" $ json id $ return dir+dir_name :: FilePath -> Stat+dir_name dir = simpleStat "directory" $ pure dir +file_name :: FilePath -> Stat+file_name file = simpleStat "file" $ pure file++remote_name :: Remote -> Stat+remote_name r = simpleStat "remote" $ pure (Remote.name r)++remote_description :: Remote -> Stat+remote_description r = simpleStat "description" $ lift $+ Remote.prettyUUID (Remote.uuid r)++remote_uuid :: Remote -> Stat+remote_uuid r = simpleStat "uuid" $ pure $+ fromUUID $ Remote.uuid r++remote_cost :: Remote -> Stat+remote_cost r = simpleStat "cost" $ pure $+ show $ Remote.cost r++remote_type :: Remote -> Stat+remote_type r = simpleStat "type" $ pure $+ Remote.typename $ Remote.remotetype r+ local_annex_keys :: Stat local_annex_keys = stat "local annex keys" $ json show $ countKeys <$> cachedPresentData local_annex_size :: Stat-local_annex_size = stat "local annex size" $ json id $+local_annex_size = simpleStat "local annex size" $ showSizeKeys <$> cachedPresentData known_annex_files :: Stat@@ -197,7 +266,7 @@ countKeys <$> cachedReferencedData known_annex_size :: Stat-known_annex_size = stat "size of annexed files in working tree" $ json id $+known_annex_size = simpleStat "size of annexed files in working tree" $ showSizeKeys <$> cachedReferencedData tmp_size :: Stat@@ -206,8 +275,14 @@ bad_data_size :: Stat bad_data_size = staleSize "bad keys size" gitAnnexBadDir +key_size :: Key -> Stat+key_size k = simpleStat "size" $ pure $ showSizeKeys $ foldKeys [k]++key_name :: Key -> Stat+key_name k = simpleStat "key" $ pure $ key2file k+ bloom_info :: Stat-bloom_info = stat "bloom filter size" $ json id $ do+bloom_info = simpleStat "bloom filter size" $ do localkeys <- countKeys <$> cachedPresentData capacity <- fromIntegral <$> lift Command.Unused.bloomCapacity let note = aside $@@ -240,7 +315,7 @@ ] disk_size :: Stat-disk_size = stat "available local disk space" $ json id $ lift $+disk_size = simpleStat "available local disk space" $ lift $ calcfree <$> (annexDiskReserve <$> Annex.getGitConfig) <*> inRepo (getDiskFree . gitAnnexDir)@@ -296,12 +371,12 @@ put s { referencedData = Just v } return v --- currently only available for local info+-- currently only available for directory info cachedNumCopiesStats :: StatState (Maybe NumCopiesStats) cachedNumCopiesStats = numCopiesStats <$> get -getLocalStatInfo :: FilePath -> Annex StatInfo-getLocalStatInfo dir = do+getDirStatInfo :: FilePath -> Annex StatInfo+getDirStatInfo dir = do fast <- Annex.getState Annex.fast matcher <- Limit.getMatcher (presentdata, referenceddata, numcopiesstats) <-
Command/Init.hs view
@@ -11,8 +11,8 @@ import Command import Annex.Init -def :: [Command]-def = [dontCheck repoExists $+cmd :: [Command]+cmd = [dontCheck repoExists $ command "init" paramDesc seek SectionSetup "initialize git-annex"] seek :: CommandSeek
Command/InitRemote.hs view
@@ -19,8 +19,8 @@ import Data.Ord -def :: [Command]-def = [command "initremote"+cmd :: [Command]+cmd = [command "initremote" (paramPair paramName $ paramOptional $ paramRepeating paramKeyValue) seek SectionSetup "creates a special (non-git) remote"] @@ -33,11 +33,15 @@ ( error $ "There is already a special remote named \"" ++ name ++ "\". (Use enableremote to enable an existing special remote.)" , do- let c = newConfig name- t <- findType config+ ifM (isJust <$> Remote.byNameOnly name)+ ( error $ "There is already a remote named \"" ++ name ++ "\""+ , do+ let c = newConfig name+ t <- findType config - showStart "initremote" name- next $ perform t name $ M.union config c+ showStart "initremote" name+ next $ perform t name $ M.union config c+ ) ) where config = Logs.Remote.keyValToConfig ws
Command/List.hs view
@@ -23,8 +23,8 @@ import qualified Annex import Git.Types (RemoteName) -def :: [Command]-def = [noCommit $ withOptions [allrepos] $ command "list" paramPaths seek+cmd :: [Command]+cmd = [noCommit $ withOptions [allrepos] $ command "list" paramPaths seek SectionQuery "show which remotes contain files"] allrepos :: Option
Command/Lock.hs view
@@ -12,8 +12,8 @@ import qualified Annex.Queue import qualified Annex -def :: [Command]-def = [notDirect $ command "lock" paramPaths seek SectionCommon+cmd :: [Command]+cmd = [notDirect $ command "lock" paramPaths seek SectionCommon "undo unlock command"] seek :: CommandSeek
Command/Log.hs view
@@ -34,8 +34,8 @@ type Outputter = Bool -> POSIXTime -> [UUID] -> Annex () -def :: [Command]-def = [withOptions options $+cmd :: [Command]+cmd = [withOptions options $ command "log" paramPaths seek SectionQuery "shows location log"] options :: [Option]
Command/LookupKey.hs view
@@ -12,8 +12,8 @@ import Annex.CatFile import Types.Key -def :: [Command]-def = [notBareRepo $ noCommit $ noMessages $+cmd :: [Command]+cmd = [notBareRepo $ noCommit $ noMessages $ command "lookupkey" (paramRepeating paramFile) seek SectionPlumbing "looks up key used for file"]
Command/Map.hs view
@@ -25,8 +25,8 @@ -- a link from the first repository to the second (its remote) data Link = Link Git.Repo Git.Repo -def :: [Command]-def = [dontCheck repoExists $+cmd :: [Command]+cmd = [dontCheck repoExists $ command "map" paramNothing seek SectionQuery "generate map of repositories"] @@ -194,11 +194,11 @@ | Git.repoIsUrl r = return Nothing | otherwise = liftIO $ safely $ Git.Config.read r where- pipedconfig cmd params = liftIO $ safely $+ pipedconfig pcmd params = liftIO $ safely $ withHandle StdoutHandle createProcessSuccess p $ Git.Config.hRead r where- p = proc cmd $ toCommand params+ p = proc pcmd $ toCommand params configlist = Ssh.onRemote r (pipedconfig, return Nothing) "configlist" [] [] manualconfiglist = do@@ -214,7 +214,7 @@ let (userhome, reldir) = span (/= '/') (drop 1 dir) in "cd " ++ userhome ++ " && " ++ cdto (drop 1 reldir) | otherwise = cdto dir- cdto dir = "if ! cd " ++ shellEscape dir ++ " 2>/dev/null; then cd " ++ shellEscape dir ++ ".git; fi"+ cdto p = "if ! cd " ++ shellEscape p ++ " 2>/dev/null; then cd " ++ shellEscape p ++ ".git; fi" -- First, try sshing and running git config manually, -- only fall back to git-annex-shell configlist if that
Command/Merge.hs view
@@ -13,8 +13,8 @@ import qualified Git.Branch import Command.Sync (prepMerge, mergeLocal) -def :: [Command]-def = [command "merge" paramNothing seek SectionMaintenance+cmd :: [Command]+cmd = [command "merge" paramNothing seek SectionMaintenance "automatically merge changes from remotes"] seek :: CommandSeek
Command/MetaData.hs view
@@ -16,8 +16,8 @@ import qualified Data.Set as S import Data.Time.Clock.POSIX -def :: [Command]-def = [withOptions metaDataOptions $+cmd :: [Command]+cmd = [withOptions metaDataOptions $ command "metadata" paramPaths seek SectionMetaData "sets metadata of a file"]
Command/Migrate.hs view
@@ -17,8 +17,8 @@ import qualified Command.ReKey import qualified Command.Fsck -def :: [Command]-def = [notDirect $ +cmd :: [Command]+cmd = [notDirect $ command "migrate" paramPaths seek SectionUtility "switch data to different backend"]
Command/Mirror.hs view
@@ -17,8 +17,8 @@ import qualified Annex import Config.NumCopies -def :: [Command]-def = [withOptions (fromToOptions ++ keyOptions) $+cmd :: [Command]+cmd = [withOptions (fromToOptions ++ keyOptions) $ command "mirror" paramPaths seek SectionCommon "mirror content of files to/from another repository"]
Command/Move.hs view
@@ -17,8 +17,8 @@ import Annex.Transfer import Logs.Presence -def :: [Command]-def = [withOptions moveOptions $ command "move" paramPaths seek+cmd :: [Command]+cmd = [withOptions moveOptions $ command "move" paramPaths seek SectionCommon "move content of files to/from another repository"] moveOptions :: [Option]
Command/NotifyChanges.hs view
@@ -19,8 +19,8 @@ import Control.Concurrent.Async import Control.Concurrent.STM -def :: [Command]-def = [noCommit $ command "notifychanges" paramNothing seek SectionPlumbing+cmd :: [Command]+cmd = [noCommit $ command "notifychanges" paramNothing seek SectionPlumbing "sends notification when git refs are changed"] seek :: CommandSeek
Command/NumCopies.hs view
@@ -13,8 +13,8 @@ import Config.NumCopies import Types.Messages -def :: [Command]-def = [command "numcopies" paramNumber seek+cmd :: [Command]+cmd = [command "numcopies" paramNumber seek SectionSetup "configure desired number of copies"] seek :: CommandSeek
Command/PreCommit.hs view
@@ -26,8 +26,8 @@ import qualified Data.Set as S -def :: [Command]-def = [command "pre-commit" paramPaths seek SectionPlumbing+cmd :: [Command]+cmd = [command "pre-commit" paramPaths seek SectionPlumbing "run by git pre-commit hook"] seek :: CommandSeek
Command/ReKey.hs view
@@ -17,8 +17,8 @@ import Logs.Location import Utility.CopyFile -def :: [Command]-def = [notDirect $ command "rekey"+cmd :: [Command]+cmd = [notDirect $ command "rekey" (paramOptional $ paramRepeating $ paramPair paramPath paramKey) seek SectionPlumbing "change keys used for files"]
Command/RecvKey.hs view
@@ -20,8 +20,8 @@ import qualified Types.Backend import qualified Backend -def :: [Command]-def = [noCommit $ command "recvkey" paramKey seek+cmd :: [Command]+cmd = [noCommit $ command "recvkey" paramKey seek SectionPlumbing "runs rsync in server mode to receive content"] seek :: CommandSeek
Command/Reinit.hs view
@@ -14,8 +14,8 @@ import Types.UUID import qualified Remote -def :: [Command]-def = [dontCheck repoExists $+cmd :: [Command]+cmd = [dontCheck repoExists $ command "reinit" (paramUUID ++ " or " ++ paramDesc) seek SectionUtility ""] seek :: CommandSeek
Command/Reinject.hs view
@@ -14,8 +14,8 @@ import qualified Command.Fsck import qualified Backend -def :: [Command]-def = [command "reinject" (paramPair "SRC" "DEST") seek+cmd :: [Command]+cmd = [command "reinject" (paramPair "SRC" "DEST") seek SectionUtility "sets content of annexed file"] seek :: CommandSeek
Command/RemoteDaemon.hs view
@@ -11,8 +11,8 @@ import Command import RemoteDaemon.Core -def :: [Command]-def = [noCommit $ command "remotedaemon" paramNothing seek SectionPlumbing+cmd :: [Command]+cmd = [noCommit $ command "remotedaemon" paramNothing seek SectionPlumbing "detects when remotes have changed, and fetches from them"] seek :: CommandSeek
Command/Repair.hs view
@@ -16,8 +16,8 @@ import Git.Types import Annex.Version -def :: [Command]-def = [noCommit $ dontCheck repoExists $+cmd :: [Command]+cmd = [noCommit $ dontCheck repoExists $ command "repair" paramNothing seek SectionMaintenance "recover broken git repository"] seek :: CommandSeek
Command/ResolveMerge.hs view
@@ -14,8 +14,8 @@ import qualified Git.Branch import Annex.AutoMerge -def :: [Command]-def = [command "resolvemerge" paramNothing seek SectionPlumbing+cmd :: [Command]+cmd = [command "resolvemerge" paramNothing seek SectionPlumbing "resolve merge conflicts"] seek :: CommandSeek
Command/RmUrl.hs view
@@ -11,8 +11,8 @@ import Command import Logs.Web -def :: [Command]-def = [notBareRepo $+cmd :: [Command]+cmd = [notBareRepo $ command "rmurl" (paramPair paramFile paramUrl) seek SectionCommon "record file is not available at url"]
Command/Schedule.hs view
@@ -17,8 +17,8 @@ import qualified Data.Set as S -def :: [Command]-def = [command "schedule" (paramPair paramRemote (paramOptional paramExpression)) seek+cmd :: [Command]+cmd = [command "schedule" (paramPair paramRemote (paramOptional paramExpression)) seek SectionSetup "get or set scheduled jobs"] seek :: CommandSeek
Command/Semitrust.hs view
@@ -11,8 +11,8 @@ import Types.TrustLevel import Command.Trust (trustCommand) -def :: [Command]-def = [command "semitrust" (paramRepeating paramRemote) seek+cmd :: [Command]+cmd = [command "semitrust" (paramRepeating paramRemote) seek SectionSetup "return repository to default trust level"] seek :: CommandSeek
Command/SendKey.hs view
@@ -16,8 +16,8 @@ import qualified CmdLine.GitAnnexShell.Fields as Fields import Utility.Metered -def :: [Command]-def = [noCommit $ command "sendkey" paramKey seek+cmd :: [Command]+cmd = [noCommit $ command "sendkey" paramKey seek SectionPlumbing "runs rsync in server mode to send content"] seek :: CommandSeek
Command/Status.hs view
@@ -16,8 +16,8 @@ import qualified Git.Ref import qualified Git -def :: [Command]-def = [notBareRepo $ noCommit $ noMessages $ withOptions [jsonOption] $+cmd :: [Command]+cmd = [notBareRepo $ noCommit $ noMessages $ withOptions [jsonOption] $ command "status" paramPaths seek SectionCommon "show the working tree status"]
Command/Sync.hs view
@@ -35,8 +35,8 @@ import Control.Concurrent.MVar -def :: [Command]-def = [withOptions syncOptions $+cmd :: [Command]+cmd = [withOptions syncOptions $ command "sync" (paramOptional (paramRepeating paramRemote)) seek SectionCommon "synchronize local repository with remotes"]
Command/Test.hs view
@@ -11,8 +11,8 @@ import Command import Messages -def :: [Command]-def = [ noRepo startIO $ dontCheck repoExists $+cmd :: [Command]+cmd = [ noRepo startIO $ dontCheck repoExists $ command "test" paramNothing seek SectionTesting "run built-in test suite"]
Command/TestRemote.hs view
@@ -36,8 +36,8 @@ import qualified Data.ByteString.Lazy as L import qualified Data.Map as M -def :: [Command]-def = [ withOptions [sizeOption] $+cmd :: [Command]+cmd = [ withOptions [sizeOption] $ command "testremote" paramRemote seek SectionTesting "test transfers to/from a remote"]
Command/TransferInfo.hs view
@@ -15,8 +15,8 @@ import qualified CmdLine.GitAnnexShell.Fields as Fields import Utility.Metered -def :: [Command]-def = [noCommit $ command "transferinfo" paramKey seek SectionPlumbing+cmd :: [Command]+cmd = [noCommit $ command "transferinfo" paramKey seek SectionPlumbing "updates sender on number of bytes of content received"] seek :: CommandSeek
Command/TransferKey.hs view
@@ -15,8 +15,8 @@ import qualified Remote import Types.Remote -def :: [Command]-def = [withOptions transferKeyOptions $+cmd :: [Command]+cmd = [withOptions transferKeyOptions $ noCommit $ command "transferkey" paramKey seek SectionPlumbing "transfers a key from or to a remote"]
Command/TransferKeys.hs view
@@ -21,8 +21,8 @@ data TransferRequest = TransferRequest Direction Remote Key AssociatedFile -def :: [Command]-def = [command "transferkeys" paramNothing seek+cmd :: [Command]+cmd = [command "transferkeys" paramNothing seek SectionPlumbing "transfers keys"] seek :: CommandSeek
Command/Trust.hs view
@@ -16,19 +16,19 @@ import qualified Data.Set as S -def :: [Command]-def = [command "trust" (paramRepeating paramRemote) seek+cmd :: [Command]+cmd = [command "trust" (paramRepeating paramRemote) seek SectionSetup "trust a repository"] seek :: CommandSeek seek = trustCommand "trust" Trusted trustCommand :: String -> TrustLevel -> CommandSeek-trustCommand cmd level = withWords start+trustCommand c level = withWords start where start ws = do let name = unwords ws- showStart cmd name+ showStart c name u <- Remote.nameToUUID name next $ perform u perform uuid = do
Command/Unannex.hs view
@@ -22,8 +22,8 @@ import Utility.CopyFile import Command.PreCommit (lockPreCommitHook) -def :: [Command]-def = [command "unannex" paramPaths seek SectionUtility+cmd :: [Command]+cmd = [command "unannex" paramPaths seek SectionUtility "undo accidential add command"] seek :: CommandSeek
Command/Ungroup.hs view
@@ -15,8 +15,8 @@ import qualified Data.Set as S -def :: [Command]-def = [command "ungroup" (paramPair paramRemote paramDesc) seek+cmd :: [Command]+cmd = [command "ungroup" (paramPair paramRemote paramDesc) seek SectionSetup "remove a repository from a group"] seek :: CommandSeek
Command/Uninit.hs view
@@ -21,8 +21,8 @@ import System.IO.HVFS import System.IO.HVFS.Utils -def :: [Command]-def = [addCheck check $ command "uninit" paramPaths seek +cmd :: [Command]+cmd = [addCheck check $ command "uninit" paramPaths seek SectionUtility "de-initialize git-annex and clean out repository"] check :: Annex ()
Command/Unlock.hs view
@@ -12,8 +12,8 @@ import Annex.Content import Utility.CopyFile -def :: [Command]-def =+cmd :: [Command]+cmd = [ c "unlock" "unlock files for modification" , c "edit" "same as unlock" ]
Command/Untrust.hs view
@@ -11,8 +11,8 @@ import Types.TrustLevel import Command.Trust (trustCommand) -def :: [Command]-def = [command "untrust" (paramRepeating paramRemote) seek+cmd :: [Command]+cmd = [command "untrust" (paramRepeating paramRemote) seek SectionSetup "do not trust a repository"] seek :: CommandSeek
Command/Unused.hs view
@@ -35,8 +35,8 @@ import Logs.View (is_branchView) import Utility.Bloom -def :: [Command]-def = [withOptions [unusedFromOption] $ command "unused" paramNothing seek+cmd :: [Command]+cmd = [withOptions [unusedFromOption] $ command "unused" paramNothing seek SectionMaintenance "look for unused file content"] unusedFromOption :: Option
Command/Upgrade.hs view
@@ -11,8 +11,8 @@ import Command import Upgrade -def :: [Command]-def = [dontCheck repoExists $ -- because an old version may not seem to exist+cmd :: [Command]+cmd = [dontCheck repoExists $ -- because an old version may not seem to exist command "upgrade" paramNothing seek SectionMaintenance "upgrade repository layout"]
Command/VAdd.hs view
@@ -12,8 +12,8 @@ import Annex.View import Command.View (checkoutViewBranch) -def :: [Command]-def = [notBareRepo $ notDirect $ command "vadd" (paramRepeating "FIELD=GLOB")+cmd :: [Command]+cmd = [notBareRepo $ notDirect $ command "vadd" (paramRepeating "FIELD=GLOB") seek SectionMetaData "add subdirs to current view"] seek :: CommandSeek
Command/VCycle.hs view
@@ -14,8 +14,8 @@ import Logs.View import Command.View (checkoutViewBranch) -def :: [Command]-def = [notBareRepo $ notDirect $+cmd :: [Command]+cmd = [notBareRepo $ notDirect $ command "vcycle" paramNothing seek SectionUtility "switch view to next layout"]
Command/VFilter.hs view
@@ -12,8 +12,8 @@ import Annex.View import Command.View (paramView, checkoutViewBranch) -def :: [Command]-def = [notBareRepo $ notDirect $+cmd :: [Command]+cmd = [notBareRepo $ notDirect $ command "vfilter" paramView seek SectionMetaData "filter current view"] seek :: CommandSeek
Command/VPop.hs view
@@ -16,8 +16,8 @@ import Logs.View import Command.View (checkoutViewBranch) -def :: [Command]-def = [notBareRepo $ notDirect $+cmd :: [Command]+cmd = [notBareRepo $ notDirect $ command "vpop" (paramOptional paramNumber) seek SectionMetaData "switch back to previous view"]
Command/Version.hs view
@@ -17,8 +17,8 @@ import qualified Remote import qualified Backend -def :: [Command]-def = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $+cmd :: [Command]+cmd = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $ command "version" paramNothing seek SectionQuery "show version info"] seek :: CommandSeek
Command/Vicfg.hs view
@@ -5,6 +5,8 @@ - Licensed under the GNU GPL version 3 or higher. -} +{-# LANGUAGE RankNTypes #-}+ module Command.Vicfg where import qualified Data.Map as M@@ -12,6 +14,7 @@ import System.Environment (getEnv) import Data.Tuple (swap) import Data.Char (isSpace)+import Data.Default import Common.Annex import Command@@ -26,8 +29,8 @@ import Types.ScheduledActivity import Remote -def :: [Command]-def = [command "vicfg" paramNothing seek+cmd :: [Command]+cmd = [command "vicfg" paramNothing seek SectionSetup "edit git-annex's configuration"] seek :: CommandSeek@@ -49,7 +52,7 @@ -- Allow EDITOR to be processed by the shell, so it can contain options. unlessM (liftIO $ boolSystem "sh" [Param "-c", Param $ unwords [vi, shellEscape f]]) $ error $ vi ++ " exited nonzero; aborting"- r <- parseCfg curcfg <$> liftIO (readFileStrict f)+ r <- parseCfg (defCfg curcfg) <$> liftIO (readFileStrict f) liftIO $ nukeFile f case r of Left s -> do@@ -85,6 +88,21 @@ mapM_ (uncurry groupPreferredContentSet) $ M.toList $ cfgGroupPreferredContentMap diff mapM_ (uncurry scheduleSet) $ M.toList $ cfgScheduleMap diff +{- Default config has all the keys from the input config, but with their+ - default values. -}+defCfg :: Cfg -> Cfg+defCfg curcfg = Cfg+ { cfgTrustMap = mapdef $ cfgTrustMap curcfg+ , cfgGroupMap = mapdef $ cfgGroupMap curcfg+ , cfgPreferredContentMap = mapdef $ cfgPreferredContentMap curcfg+ , cfgRequiredContentMap = mapdef $ cfgRequiredContentMap curcfg+ , cfgGroupPreferredContentMap = mapdef $ cfgGroupPreferredContentMap curcfg+ , cfgScheduleMap = mapdef $ cfgScheduleMap curcfg+ }+ where+ mapdef :: forall k v. Default v => M.Map k v -> M.Map k v+ mapdef = M.map (const def)+ diffCfg :: Cfg -> Cfg -> Cfg diffCfg curcfg newcfg = Cfg { cfgTrustMap = diff cfgTrustMap@@ -124,7 +142,7 @@ , com "(Valid trust levels: " ++ trustlevels ++ ")" ] (\(t, u) -> line "trust" u $ showTrustLevel t)- (\u -> lcom $ line "trust" u $ showTrustLevel SemiTrusted)+ (\u -> lcom $ line "trust" u $ showTrustLevel def) where trustlevels = unwords $ map showTrustLevel [Trusted .. DeadTrusted] @@ -203,7 +221,7 @@ {- If there's a parse error, returns a new version of the file, - with the problem lines noted. -} parseCfg :: Cfg -> String -> Either String Cfg-parseCfg curcfg = go [] curcfg . lines+parseCfg defcfg = go [] defcfg . lines where go c cfg [] | null (mapMaybe fst c) = Right cfg
Command/View.hs view
@@ -17,8 +17,8 @@ import Annex.View import Logs.View -def :: [Command]-def = [notBareRepo $ notDirect $+cmd :: [Command]+cmd = [notBareRepo $ notDirect $ command "view" paramView seek SectionMetaData "enter a view branch"] seek :: CommandSeek@@ -42,7 +42,7 @@ next $ checkoutViewBranch view applyView paramView :: String-paramView = paramPair (paramRepeating "TAG") (paramRepeating "FIELD=VALUE")+paramView = paramRepeating "FIELD=VALUE" mkView :: [String] -> Annex View mkView params = go =<< inRepo Git.Branch.current
Command/Wanted.hs view
@@ -16,8 +16,8 @@ import qualified Data.Map as M -def :: [Command]-def = [command "wanted" (paramPair paramRemote (paramOptional paramExpression)) seek+cmd :: [Command]+cmd = [command "wanted" (paramPair paramRemote (paramOptional paramExpression)) seek SectionSetup "get or set preferred content expression"] seek :: CommandSeek
Command/Watch.hs view
@@ -12,8 +12,8 @@ import Command import Utility.HumanTime -def :: [Command]-def = [notBareRepo $ withOptions [foregroundOption, stopOption] $ +cmd :: [Command]+cmd = [notBareRepo $ withOptions [foregroundOption, stopOption] $ command "watch" paramNothing seek SectionCommon "watch for changes"] seek :: CommandSeek
Command/WebApp.hs view
@@ -37,8 +37,8 @@ import Network.Socket (HostName) import System.Environment (getArgs) -def :: [Command]-def = [ withOptions [listenOption] $+cmd :: [Command]+cmd = [ withOptions [listenOption] $ noCommit $ noRepo startNoRepo $ dontCheck repoExists $ notBareRepo $ command "webapp" paramNothing seek SectionCommon "launch webapp"] @@ -213,7 +213,7 @@ #endif where p = case mcmd of- Just cmd -> proc cmd [htmlshim]+ Just c -> proc c [htmlshim] Nothing -> #ifndef mingw32_HOST_OS browserProc url
Command/Whereis.hs view
@@ -14,8 +14,8 @@ import Remote import Logs.Trust -def :: [Command]-def = [noCommit $ withOptions (jsonOption : keyOptions) $+cmd :: [Command]+cmd = [noCommit $ withOptions (jsonOption : keyOptions) $ command "whereis" paramPaths seek SectionQuery "lists repositories that have file content"]
Command/XMPPGit.hs view
@@ -11,8 +11,8 @@ import Command import Assistant.XMPP.Git -def :: [Command]-def = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $+cmd :: [Command]+cmd = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $ command "xmppgit" paramNothing seek SectionPlumbing "git to XMPP relay"] @@ -37,9 +37,9 @@ respond [] where expect s = do- cmd <- getLine- unless (cmd == s) $- error $ "git-remote-helpers protocol error: expected: " ++ s ++ ", but got: " ++ cmd+ gitcmd <- getLine+ unless (gitcmd == s) $+ error $ "git-remote-helpers protocol error: expected: " ++ s ++ ", but got: " ++ gitcmd respond l = do mapM_ putStrLn l putStrLn ""
Creds.hs view
@@ -15,6 +15,7 @@ writeCacheCreds, readCacheCreds, removeCreds,+ includeCredsInfo, ) where import Common.Annex@@ -23,7 +24,7 @@ import Utility.FileMode import Crypto import Types.Remote (RemoteConfig, RemoteConfigKey)-import Remote.Helper.Encryptable (remoteCipher, remoteCipher', embedCreds, EncryptionIsSetup)+import Remote.Helper.Encryptable (remoteCipher, remoteCipher', embedCreds, EncryptionIsSetup, extractCipher) import Utility.Env (getEnv) import qualified Data.ByteString.Lazy.Char8 as L@@ -39,9 +40,11 @@ } {- Stores creds in a remote's configuration, if the remote allows- - that. Otherwise, caches them locally.- - The creds are found in storage if not provided.+ - that. Also caches them locally. -+ - The creds are found from the CredPairStorage storage if not provided,+ - so may be provided by an environment variable etc.+ - - The remote's configuration should have already had a cipher stored in it - if that's going to be done, so that the creds can be encrypted using the - cipher. The EncryptionIsSetup phantom type ensures that is the case.@@ -53,7 +56,7 @@ setRemoteCredPair _ c storage (Just creds) | embedCreds c = case credPairRemoteKey storage of Nothing -> localcache- Just key -> storeconfig key =<< remoteCipher c+ Just key -> storeconfig key =<< remoteCipher =<< localcache | otherwise = localcache where localcache = do@@ -144,11 +147,17 @@ <$> readCacheCreds (credPairFile storage) readCacheCreds :: FilePath -> Annex (Maybe Creds)-readCacheCreds file = do+readCacheCreds f = liftIO . catchMaybeIO . readFile =<< cacheCredsFile f++cacheCredsFile :: FilePath -> Annex FilePath+cacheCredsFile basefile = do d <- fromRepo gitAnnexCredsDir- let f = d </> file- liftIO $ catchMaybeIO $ readFile f+ return $ d </> basefile +existsCacheCredPair :: CredPairStorage -> Annex Bool+existsCacheCredPair storage = + liftIO . doesFileExist =<< cacheCredsFile (credPairFile storage)+ encodeCredPair :: CredPair -> Creds encodeCredPair (l, p) = unlines [l, p] @@ -162,3 +171,21 @@ d <- fromRepo gitAnnexCredsDir let f = d </> file liftIO $ nukeFile f++includeCredsInfo :: RemoteConfig -> CredPairStorage -> [(String, String)] -> Annex [(String, String)]+includeCredsInfo c storage info = do+ v <- liftIO $ getEnvCredPair storage+ case v of+ Just _ -> do+ let (uenv, penv) = credPairEnvironment storage+ ret $ "from environment variables (" ++ unwords [uenv, penv] ++ ")"+ Nothing -> case (\ck -> M.lookup ck c) =<< credPairRemoteKey storage of+ Nothing -> ifM (existsCacheCredPair storage)+ ( ret "stored locally"+ , ret "not available"+ )+ Just _ -> case extractCipher c of+ Just (EncryptedCipher _ _ _) -> ret "embedded in git repository (gpg encrypted)"+ _ -> ret "embedded in git repository (not encrypted)"+ where+ ret s = return $ ("creds", s) : info
Git/CurrentRepo.hs view
@@ -5,17 +5,13 @@ - Licensed under the GNU GPL version 3 or higher. -} -{-# LANGUAGE CPP #-}- module Git.CurrentRepo where import Common import Git.Types import Git.Construct import qualified Git.Config-#ifndef mingw32_HOST_OS import Utility.Env-#endif {- Gets the current git repository. -@@ -42,17 +38,13 @@ setCurrentDirectory d return $ addworktree wt r where-#ifndef mingw32_HOST_OS pathenv s = do v <- getEnv s case v of Just d -> do- void $ unsetEnv s+ unsetEnv s Just <$> absPath d Nothing -> return Nothing-#else- pathenv _ = return Nothing-#endif configure Nothing (Just r) = Git.Config.read r configure (Just d) _ = do
Git/Index.hs view
@@ -21,8 +21,8 @@ override :: FilePath -> IO (IO ()) override index = do res <- getEnv var- void $ setEnv var index True- return $ void $ reset res+ setEnv var index True+ return $ reset res where var = "GIT_INDEX_FILE" reset (Just v) = setEnv var v True
Logs/Trust.hs view
@@ -19,6 +19,7 @@ ) where import qualified Data.Map as M+import Data.Default import Common.Annex import Types.TrustLevel@@ -38,7 +39,7 @@ {- Returns the TrustLevel of a given repo UUID. -} lookupTrust :: UUID -> Annex TrustLevel-lookupTrust u = (fromMaybe SemiTrusted . M.lookup u) <$> trustMap+lookupTrust u = (fromMaybe def . M.lookup u) <$> trustMap {- Partitions a list of UUIDs to those matching a TrustLevel and not. -} trustPartition :: TrustLevel -> [UUID] -> Annex ([UUID], [UUID])
Remote/Bup.hs view
@@ -73,6 +73,7 @@ , availability = if bupLocal buprepo then LocallyAvailable else GloballyAvailable , readonly = False , mkUnavailable = return Nothing+ , getInfo = return [("repo", buprepo)] } return $ Just $ specialRemote' specialcfg c (simplyPrepare $ store this buprepo)
Remote/Ddar.hs view
@@ -70,6 +70,7 @@ , availability = if ddarLocal ddarrepo then LocallyAvailable else GloballyAvailable , readonly = False , mkUnavailable = return Nothing+ , getInfo = return [("repo", ddarrepo)] } ddarrepo = fromMaybe (error "missing ddarrepo") $ remoteAnnexDdarRepo gc specialcfg = (specialRemoteCfg c)
Remote/Directory.hs view
@@ -67,7 +67,8 @@ availability = LocallyAvailable, remotetype = remote, mkUnavailable = gen r u c $- gc { remoteAnnexDirectory = Just "/dev/null" }+ gc { remoteAnnexDirectory = Just "/dev/null" },+ getInfo = return [("directory", dir)] } where dir = fromMaybe (error "missing directory") $ remoteAnnexDirectory gc
Remote/External.hs view
@@ -68,6 +68,7 @@ remotetype = remote, mkUnavailable = gen r u c $ gc { remoteAnnexExternalType = Just "!dne!" }+ , getInfo = return [("externaltype", externaltype)] } where externaltype = fromMaybe (error "missing externaltype") (remoteAnnexExternalType gc)
Remote/GCrypt.hs view
@@ -121,6 +121,7 @@ , availability = availabilityCalc r , remotetype = remote , mkUnavailable = return Nothing+ , getInfo = return $ gitRepoInfo r } return $ Just $ specialRemote' specialcfg c (simplyPrepare $ store this rsyncopts)
Remote/Git.hs view
@@ -159,6 +159,7 @@ , availability = availabilityCalc r , remotetype = remote , mkUnavailable = unavailable r u c gc+ , getInfo = return $ gitRepoInfo r } unavailable :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
Remote/Glacier.hs view
@@ -66,7 +66,9 @@ readonly = False, availability = GloballyAvailable, remotetype = remote,- mkUnavailable = return Nothing+ mkUnavailable = return Nothing,+ getInfo = includeCredsInfo c (AWS.creds u) $+ [ ("glacier vault", getVault c) ] } specialcfg = (specialRemoteCfg c) -- Disabled until jobList gets support for chunks.@@ -141,7 +143,10 @@ ] go Nothing = error "cannot retrieve from glacier" go (Just e) = do- let cmd = (proc "glacier" (toCommand params)) { env = Just e }+ let cmd = (proc "glacier" (toCommand params))+ { env = Just e+ , std_out = CreatePipe+ } (_, Just h, _, pid) <- liftIO $ createProcess cmd -- Glacier cannot store empty files, so if the output is -- empty, the content is not available yet.
Remote/Helper/AWS.hs view
@@ -45,6 +45,9 @@ [ ("US East (N. Virginia)", [S3Region "US", GlacierRegion "us-east-1"]) , ("US West (Oregon)", [BothRegion "us-west-2"]) , ("US West (N. California)", [BothRegion "us-west-1"])+ -- Requires AWS4-HMAC-SHA256 which S3 library does not+ -- currently support.+ -- , ("EU (Frankfurt)", [BothRegion "eu-central-1"]) , ("EU (Ireland)", [S3Region "EU", GlacierRegion "eu-west-1"]) , ("Asia Pacific (Singapore)", [S3Region "ap-southeast-1"]) , ("Asia Pacific (Tokyo)", [BothRegion "ap-northeast-1"])
Remote/Helper/Chunked.hs view
@@ -8,6 +8,7 @@ module Remote.Helper.Chunked ( ChunkSize, ChunkConfig(..),+ describeChunkConfig, getChunkConfig, storeChunks, removeChunks,@@ -33,6 +34,14 @@ | UnpaddedChunks ChunkSize | LegacyChunks ChunkSize deriving (Show)++describeChunkConfig :: ChunkConfig -> String+describeChunkConfig NoChunks = "none"+describeChunkConfig (UnpaddedChunks sz) = describeChunkSize sz ++ "chunks"+describeChunkConfig (LegacyChunks sz) = describeChunkSize sz ++ " chunks (old style)"++describeChunkSize :: ChunkSize -> String+describeChunkSize sz = roughSize storageUnits False (fromIntegral sz) noChunks :: ChunkConfig -> Bool noChunks NoChunks = True
Remote/Helper/Encryptable.hs view
@@ -16,6 +16,7 @@ cipherKey, storeCipher, extractCipher,+ describeEncryption, ) where import qualified Data.Map as M@@ -157,3 +158,15 @@ _ -> Nothing where readkeys = KeyIds . split ","++describeEncryption :: RemoteConfig -> String+describeEncryption c = case extractCipher c of+ Nothing -> "not encrypted"+ (Just (SharedCipher _)) -> "encrypted (encryption key stored in git repository)"+ (Just (EncryptedCipher _ v (KeyIds { keyIds = ks }))) -> unwords $ catMaybes+ [ Just "encrypted (to gpg keys:"+ , Just (unwords ks ++ ")")+ , case v of+ PubKey -> Nothing+ Hybrid -> Just "(hybrid mode)"+ ]
Remote/Helper/Git.hs view
@@ -30,3 +30,8 @@ guardUsable r fallback a | Git.repoIsLocalUnknown r = fallback | otherwise = a++gitRepoInfo :: Git.Repo -> [(String, String)]+gitRepoInfo r =+ [ ("repository location", Git.repoLocation r)+ ]
Remote/Helper/Special.hs view
@@ -168,6 +168,12 @@ (cost baser) (const $ cost baser + encryptedRemoteCostAdj) (extractCipher c)+ , getInfo = do+ l <- getInfo baser+ return $ l +++ [ ("encryption", describeEncryption c)+ , ("chunking", describeChunkConfig (chunkConfig cfg))+ ] } cip = cipherKey c gpgopts = getGpgEncParams encr
Remote/Hook.hs view
@@ -60,7 +60,8 @@ availability = GloballyAvailable, remotetype = remote, mkUnavailable = gen r u c $- gc { remoteAnnexHookType = Just "!dne!" }+ gc { remoteAnnexHookType = Just "!dne!" },+ getInfo = return [("hooktype", hooktype)] } where hooktype = fromMaybe (error "missing hooktype") $ remoteAnnexHookType gc
Remote/Rsync.hs view
@@ -83,6 +83,7 @@ , availability = if islocal then LocallyAvailable else GloballyAvailable , remotetype = remote , mkUnavailable = return Nothing+ , getInfo = return [("url", url)] } where specialcfg = (specialRemoteCfg c)
Remote/S3.hs view
@@ -5,7 +5,7 @@ - Licensed under the GNU GPL version 3 or higher. -} -module Remote.S3 (remote, iaHost, isIA, isIAHost, iaItemUrl) where+module Remote.S3 (remote, iaHost, configIA, iaItemUrl) where import Network.AWS.AWSConnection import Network.AWS.S3Object hiding (getStorageClass)@@ -71,7 +71,13 @@ readonly = False, availability = GloballyAvailable, remotetype = remote,- mkUnavailable = gen r u (M.insert "host" "!dne!" c) gc+ mkUnavailable = gen r u (M.insert "host" "!dne!" c) gc,+ getInfo = includeCredsInfo c (AWS.creds u) $ catMaybes+ [ Just ("bucket", fromMaybe "unknown" (getBucket c))+ , if configIA c+ then Just ("internet archive item", iaItemUrl $ fromMaybe "unknown" $ getBucket c)+ else Nothing+ ] } s3Setup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)@@ -79,7 +85,7 @@ u <- maybe (liftIO genUUID) return mu s3Setup' u mcreds c s3Setup' :: UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)-s3Setup' u mcreds c = if isIA c then archiveorg else defaulthost+s3Setup' u mcreds c = if configIA c then archiveorg else defaulthost where remotename = fromJust (M.lookup "name" c) defbucket = remotename ++ "-" ++ fromUUID u@@ -130,7 +136,7 @@ ok <- s3Bool =<< liftIO (store (conn, bucket) r k p src) -- Store public URL to item in Internet Archive.- when (ok && isIA (config r) && not (isChunkKey k)) $+ when (ok && configIA (config r) && not (isChunkKey k)) $ setUrlPresent k (iaKeyUrl r k) return ok@@ -162,7 +168,7 @@ - derived from it that it does not remove. -} remove :: Remote -> RemoteConfig -> Remover remove r c k- | isIA c = do+ | configIA c = do warning "Cannot remove content from the Internet Archive" return False | otherwise = remove' r k@@ -330,8 +336,8 @@ iaHost :: HostName iaHost = "s3.us.archive.org" -isIA :: RemoteConfig -> Bool-isIA c = maybe False isIAHost (M.lookup "host" c)+configIA :: RemoteConfig -> Bool+configIA c = maybe False isIAHost (M.lookup "host" c) isIAHost :: HostName -> Bool isIAHost h = ".archive.org" `isSuffixOf` map toLower h
Remote/Tahoe.hs view
@@ -84,7 +84,8 @@ readonly = False, availability = GloballyAvailable, remotetype = remote,- mkUnavailable = return Nothing+ mkUnavailable = return Nothing,+ getInfo = return [] } tahoeSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
Remote/Web.hs view
@@ -62,7 +62,8 @@ readonly = True, availability = GloballyAvailable, remotetype = remote,- mkUnavailable = return Nothing+ mkUnavailable = return Nothing,+ getInfo = return [] } downloadKey :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
Remote/WebDAV.hs view
@@ -71,7 +71,9 @@ readonly = False, availability = GloballyAvailable, remotetype = remote,- mkUnavailable = gen r u (M.insert "url" "http://!dne!/" c) gc+ mkUnavailable = gen r u (M.insert "url" "http://!dne!/" c) gc,+ getInfo = includeCredsInfo c (davCreds u) $+ [("url", fromMaybe "unknown" (M.lookup "url" c))] } chunkconfig = getChunkConfig c
Test.hs view
@@ -73,8 +73,8 @@ import qualified Utility.HumanTime import qualified Utility.ThreadScheduler import qualified Command.Uninit-#ifndef mingw32_HOST_OS import qualified CmdLine.GitAnnex as GitAnnex+#ifndef mingw32_HOST_OS import qualified Remote.Helper.Encryptable import qualified Types.Crypto import qualified Utility.Gpg@@ -1346,7 +1346,6 @@ -- (when the OS allows) so test coverage collection works. git_annex :: TestEnv -> String -> [String] -> IO Bool git_annex testenv command params = do-#ifndef mingw32_HOST_OS forM_ (M.toList testenv) $ \(var, val) -> Utility.Env.setEnv var val True @@ -1357,11 +1356,6 @@ Left _ -> return False where run = GitAnnex.run (command:"-q":params)-#else- Utility.SafeCommand.boolSystemEnv "git-annex"- (map Param $ command : params)- (Just $ M.toList testenv)-#endif {- Runs git-annex and returns its output. -} git_annex_output :: TestEnv -> String -> [String] -> IO String
Types/Remote.hs view
@@ -98,7 +98,9 @@ remotetype :: RemoteTypeA a, -- For testing, makes a version of this remote that is not -- available for use. All its actions should fail.- mkUnavailable :: a (Maybe (RemoteA a))+ mkUnavailable :: a (Maybe (RemoteA a)),+ -- Information about the remote, for git annex info to display.+ getInfo :: a [(String, String)] } instance Show (RemoteA a) where
Types/TrustLevel.hs view
@@ -14,6 +14,7 @@ ) where import qualified Data.Map as M+import Data.Default import Types.UUID @@ -21,6 +22,9 @@ -- remotes last and trusted ones first. data TrustLevel = Trusted | SemiTrusted | UnTrusted | DeadTrusted deriving (Eq, Enum, Ord, Bounded)++instance Default TrustLevel where+ def = SemiTrusted type TrustMap = M.Map UUID TrustLevel
Utility/Env.hs view
@@ -14,6 +14,7 @@ import Control.Applicative import Data.Maybe import qualified System.Environment as E+import qualified System.SetEnv #else import qualified System.Posix.Env as PE #endif@@ -39,27 +40,27 @@ getEnvironment = E.getEnvironment #endif -{- Returns True if it could successfully set the environment variable.+{- Sets an environment variable. To overwrite an existing variable,+ - overwrite must be True. -- - There is, apparently, no way to do this in Windows. Instead,- - environment varuables must be provided when running a new process. -}-setEnv :: String -> String -> Bool -> IO Bool+ - On Windows, setting a variable to "" unsets it. -}+setEnv :: String -> String -> Bool -> IO () #ifndef mingw32_HOST_OS-setEnv var val overwrite = do- PE.setEnv var val overwrite- return True+setEnv var val overwrite = PE.setEnv var val overwrite #else-setEnv _ _ _ = return False+setEnv var val True = System.SetEnv.setEnv var val+setEnv var val False = do+ r <- getEnv var+ case r of+ Nothing -> setEnv var val True+ Just _ -> return () #endif -{- Returns True if it could successfully unset the environment variable. -}-unsetEnv :: String -> IO Bool+unsetEnv :: String -> IO () #ifndef mingw32_HOST_OS-unsetEnv var = do- PE.unsetEnv var- return True+unsetEnv = PE.unsetEnv #else-unsetEnv _ = return False+unsetEnv = System.SetEnv.unsetEnv #endif {- Adds the environment variable to the input environment. If already
Utility/Gpg.hs view
@@ -334,7 +334,7 @@ setup = do base <- getTemporaryDirectory dir <- mktmpdir $ base </> "gpgtmpXXXXXX"- void $ setEnv var dir True+ setEnv var dir True -- For some reason, recent gpg needs a trustdb to be set up. _ <- pipeStrict [Params "--trust-model auto --update-trustdb"] [] _ <- pipeStrict [Params "--import -q"] $ unlines
Utility/Lsof.hs view
@@ -32,7 +32,7 @@ when (isAbsolute cmd) $ do path <- getSearchPath let path' = takeDirectory cmd : path- void $ setEnv "PATH" (intercalate [searchPathSeparator] path') True+ setEnv "PATH" (intercalate [searchPathSeparator] path') True {- Checks each of the files in a directory to find open files. - Note that this will find hard links to files elsewhere that are open. -}
Utility/Yesod.hs view
@@ -1,9 +1,9 @@ {- Yesod stuff, that's typically found in the scaffolded site. - - Also a bit of a compatability layer to make it easier to support yesod- - 1.1 and 1.2 in the same code base.+ - 1.1-1.4 in the same code base. -- - Copyright 2012, 2013 Joey Hess <joey@kitenet.net>+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -}@@ -17,17 +17,22 @@ , widgetFile , hamletTemplate #endif+#if ! MIN_VERSION_yesod(1,4,0)+ , withUrlRenderer+#endif #if ! MIN_VERSION_yesod(1,2,0)- , giveUrlRenderer , Html #endif ) where #if MIN_VERSION_yesod(1,2,0) import Yesod as Y-import Yesod.Form.Bootstrap3 as Y hiding (bfs) #else import Yesod as Y hiding (Html)+#endif+#if MIN_VERSION_yesod_form(1,3,8)+import Yesod.Form.Bootstrap3 as Y hiding (bfs)+#else import Assistant.WebApp.Bootstrap3 as Y hiding (bfs) #endif #ifndef __NO_TH__@@ -38,6 +43,11 @@ import Text.Hamlet hiding (Html) #endif #endif+#if ! MIN_VERSION_yesod(1,4,0)+#if MIN_VERSION_yesod(1,2,0)+import Data.Text (Text)+#endif+#endif #ifndef __NO_TH__ widgetFile :: String -> Q Exp@@ -66,8 +76,13 @@ {- Misc new names for stuff. -} #if ! MIN_VERSION_yesod(1,2,0)-giveUrlRenderer :: forall master sub. HtmlUrl (Route master) -> GHandler sub master RepHtml-giveUrlRenderer = hamletToRepHtml+withUrlRenderer :: forall master sub. HtmlUrl (Route master) -> GHandler sub master RepHtml+withUrlRenderer = hamletToRepHtml type Html = RepHtml+#else+#if ! MIN_VERSION_yesod_core(1,2,20)+withUrlRenderer :: MonadHandler m => ((Route (HandlerSite m) -> [(Text, Text)] -> Text) -> output) -> m output+withUrlRenderer = giveUrlRenderer+#endif #endif
debian/changelog view
@@ -1,3 +1,27 @@+git-annex (5.20141024) unstable; urgency=medium++ * vicfg: Deleting configurations now resets to the default, where+ before it has no effect.+ * Remove hurd stuff from cabal file, since hackage currently rejects+ it, and the test suite fails on hurd.+ * initremote: Don't allow creating a special remote that has the same+ name as an existing git remote.+ * Windows: Use haskell setenv library to clean up several ugly workarounds+ for inability to manipulate the environment on windows. This includes+ making git-annex not re-exec itself on start on windows, and making the+ test suite on Windows run tests without forking.+ * glacier: Fix pipe setup when calling glacier-cli to retrieve an object.+ * info: When run on a single annexed file, displays some info about the + file, including its key and size.+ * info: When passed the name or uuid of a remote, displays info about that+ remote. Remotes that support encryption, chunking, or embedded+ creds will include that in their info.+ * enableremote: When the remote has creds, update the local creds cache+ file. Before, the old version of the creds could be left there, and+ would continue to be used.++ -- Joey Hess <joeyh@debian.org> Fri, 24 Oct 2014 13:03:29 -0400+ git-annex (5.20141013) unstable; urgency=medium * Adjust cabal file to support building w/o assistant on the hurd.
+ doc/bugs/Build_error_with_Yesod_1.4.mdwn view
@@ -0,0 +1,287 @@+### Please describe the problem.+I have problems building with yesod 1.4++### What steps will reproduce the problem?+Building git annex in a clean sandbox. ++### What version of git-annex are you using? On what operating system?+5.20140927 on OS X i.e. Trying to upgrade the homebrew recipe to the most recent version of git-annex++### Please provide any additional information below.+Error messages below are discussed in the following SO-thread:+https://stackoverflow.com/questions/26225991/illegal-view-pattern-frompathpiece-just-dyn-abdd-when-using-parameters-on+++[[!format sh """+# If you can, paste a complete transcript of the problem occurring here.+# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log+[310 of 470] Compiling Assistant.WebApp.Types ( Assistant/WebApp/Types.hs, dist/dist-sandbox-52ca649e/build/git-annex/git-annex-tmp/Assistant/WebApp/Types.o )++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_aceZO+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_aceZW+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf02+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf0c+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf0e+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf0f+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf0h+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf0j+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf0l+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf0n+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf0p+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf0r+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf0u+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf0w+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf0y+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf0z+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf0C+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf0D+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf0F+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf0H+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf0J+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf0L+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf0M+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf0O+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf0R+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf0T+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf0U+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf11+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf13+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf18+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf1a+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf1c+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf1e+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf1g+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf1i+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf1k+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf1m+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf1o+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf1q+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf1s+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf1v+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf1x+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf1z+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf1B+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf1D+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf1G+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf1I+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf1J+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf1L+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf1M+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf1O+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf1R+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf1U+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf1X+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf1Y+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf20+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf22+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf25+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf27+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf28+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf2b+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf2d+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf2f+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf2h+ Use ViewPatterns to enable view patterns++Assistant/WebApp/Types.hs:40:1:+ Illegal view pattern: fromPathPiece -> Just dyn_acf2j+ Use ViewPatterns to enable view patterns+cabal: Error: some packages failed to install:+git-annex-5.20140927+++# End of transcript or log.+"""]]++> You're not building the most recent version of git-annex; this was+> already fixed in version 5.20141013. [[done]] --[[Joey]]
+ doc/bugs/Issue_fewer_S3_GET_requests.mdwn view
@@ -0,0 +1,9 @@+It appears that git-annex issues one GET request to S3 / Google cloud for every file it tries to copy, if you don't pass --fast. (I could be wrong; I'm basing this on the fact that each "checking <remote name>" takes about the same amount of time, and that it's slow enough to be hitting the network.)++Amazon lets you GET 1000 objects in one GET request, and afaict a request that returns 1000 objects costs just as much as a request that returns 1 object. The cost of GET'ing every file in my annex is nontrivial -- Google charges 0.01 per 1000 GETs, and my repo has 130k objects, so that's $1.3, compared to a monthly cost for storage of under $10. This means that if I want to back up my files more than, say, once a week, I need to write a script that parses the JSON output of git annex whereis and uploads with --fast only the files that aren't present in the cloud. It also means that I have to trust the output of whereis.++All those GETs also slow down the non-fast copy, and this also applies to other kinds of remotes.++There are a number of ways one could implement this. One way would be to have a command that updates the whereis data from the remote and then to add a parameter (maybe you already have it) to copy that's like --fast but skips files that are already present (maybe this is what --fast already does, but I did a quick check and it doesn't seem to). Because of the way git annex names files, I think it would be hard to coalesce GETs during a copy command, but it could be done.++Anyway, please don't consider this a high-priority request; I can get by as-is, and I <3 git annex.
doc/bugs/annex_get_fails_from_read-only_filesystem.mdwn view
@@ -22,3 +22,6 @@ local repository version: 5 supported repository version: 5 upgrade supported from repository versions: 0 1 2 4++[[!tag confirmed]]+[[!meta title="read-only filesystem on remote prevents auto-upgrade from v3 to v5, and prevents using a remote"]]
+ doc/bugs/cannot_add_local_readonly_repo_through_the_webapp.mdwn view
@@ -0,0 +1,98 @@+### Please describe the problem.++A readonly repository that I can add fine on the commandline (and sync content from) cannot be added through the webapp.++### What steps will reproduce the problem?++Say I have a readonly (owned by root) repository in `~/test/a` and I create a `~/test/b` (owned by my user). In the webapp, when to add `/home/anarcat/test/a` as a "local repository" (`Add another local repository`) to the `~/test/b` repo, it fails when i enter that path, with "Cannot write a repository there." I obviously can't sync content from there then.++This works on the commandline, although with warnings.++### What version of git-annex are you using? On what operating system?++Version: 5.20140927 +Build flags: Assistant Webapp Webapp-secure Pairing Testsuite S3 WebDAV Inotify DBus DesktopNotify XMPP DNS Feeds Quvi TDFA CryptoHash++Debian Jessie.++### Please provide any additional information below.++Here's the transcript of the commandline equivalent:++~~~+anarcat@marcos:test$ git init a+Dépôt Git vide initialisé dans /home/anarcat/test/a/.git/+anarcat@marcos:test$ git init b+Dépôt Git vide initialisé dans /home/anarcat/test/b/.git/+anarcat@marcos:test$ cd a+anarcat@marcos:a$ git annex init+init ok+(Recording state in git...)+anarcat@marcos:a$ echo hellow world > README+anarcat@marcos:a$ git annex add README+add README ok+(Recording state in git...)+anarcat@marcos:a$ git commit -m"test repo a"+[master (commit racine) 3ece2a1] test repo a+ 1 file changed, 1 insertion(+)+ create mode 120000 README+anarcat@marcos:a$ cd ../ ^C+anarcat@marcos:a$ sudo chown -R root .+[sudo] password for anarcat:+Sorry, try again.+[sudo] password for anarcat:+anarcat@marcos:a$ cd ../b+anarcat@marcos:b$ git annex init+init ok+(Recording state in git...)+anarcat@marcos:b$ git remote add a ../a+anarcat@marcos:b$ git annex sync a+commit ok+pull a+warning: no common commits+remote: Décompte des objets: 13, fait.+remote: Compression des objets: 100% (9/9), fait.+remote: Total 13 (delta 1), reused 0 (delta 0)+Dépaquetage des objets: 100% (13/13), fait.+Depuis ../a+ * [nouvelle branche] git-annex -> a/git-annex+ * [nouvelle branche] master -> a/master+++merge: refs/remotes/a/synced/master - not something we can merge+failed+(merging a/git-annex into git-annex...)+(Recording state in git...)+push a+Décompte des objets: 8, fait.+Delta compression using up to 2 threads.+Compression des objets: 100% (6/6), fait.+Écriture des objets: 100% (8/8), 819 bytes | 0 bytes/s, fait.+Total 8 (delta 1), reused 0 (delta 0)+remote: error: insufficient permission for adding an object to repository database objects+remote: fatal: failed to write object+error: unpack failed: unpack-objects abnormal exit+To ../a+ ! [remote rejected] git-annex -> synced/git-annex (unpacker error)+ ! [remote rejected] master -> synced/master (unpacker error)+error: impossible de pousser des références vers '../a'++ Pushing to a failed.++ (non-fast-forward problems can be solved by setting receive.denyNonFastforwards to false in the remote's git config)+failed+git-annex: sync: 2 failed+anarcat@marcos:b$ ls+README+anarcat@marcos:b$ git annex copy --from a+copy README (from a...) ok+(Recording state in git...)+anarcat@marcos:b$ ls -al+total 16K+drwxr-xr-x 3 anarcat anarcat 4096 oct. 20 15:36 .+drwxr-xr-x 4 anarcat anarcat 4096 oct. 20 15:35 ..+drwxr-xr-x 9 anarcat anarcat 4096 oct. 20 15:36 .git+lrwxrwxrwx 1 anarcat anarcat 180 oct. 20 15:36 README -> .git/annex/objects/wz/Zq/SHA256E-s13--8c083c6897455257dfbace7a9012d92ca8ebfb6e6ebe8acddc6dfa8fc81226ed/SHA256E-s13--8c083c6897455257dfbace7a9012d92ca8ebfb6e6ebe8acddc6dfa8fc81226ed+~~~++This is part of the [[todo/read-only_removable_drives/]] series. --[[anarcat]]
+ doc/bugs/get_from_glacier_fails_too_early.mdwn view
@@ -0,0 +1,72 @@+### Please describe the problem.++In order to test the integrity of my file backup on glacier,+I initiated get of a single file from glacier via:++ $ git annex get --from=glacier localdir/myfile.jpg++A check with++ $ glacier job list++confirmed, that a job was in progress.++Then after a couple hours wait the job is complete+[[!format sh """+[ben@voyagerS9 annex]$ glacier job list+i/d 2014-10-16T20:25:23.068Z glacier-bbbbbbbb-bbbb-bbbb-bbbb-MYVAULTbbbbb+a/d 2014-10-16T20:30:13.086Z glacier-bbbbbbbb-bbbb-bbbb-bbbb-MYVAULTbbbbb GPGHMACSHA1--cccccccccccc+"""]]++So, again I enter the get command:+[[!format sh """+[ben@voyagerS9 annex]$ git annex get --from=glacier localdir/myfile.jpg+get localdir/myfile.jpg (from glacier...) (gpg) +failed +git-annex: get: 1 failed+[ben@voyagerS9 annex]$+"""]]++The command immediately fails after entering the gpg passphrase, releasing the shell.+But in the background the glacier-cli is still running, downloads the file from Amazon+and then dumps the gpg encrypted file content into the terminal.+(4 MB of binary character garbage on the screen)++git annex should not fail so early and wait until the data is coming in order to pipe it into gpg.++### What version of git-annex are you using? On what operating system?+Arch Linux git-annex-bin package.+[[!format sh """+[ben@voyagerS9 annex]$ git annex version+git-annex version: 5.20140920-gb0c4300+build flags: Assistant Webapp Webapp-secure Pairing Testsuite S3 WebDAV Inotify DBus DesktopNotify XMPP 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 tahoe glacier ddar hook external+local repository version: 5+supported repository version: 5+upgrade supported from repository versions: 0 1 2 4+[ben@voyagerS9 annex]$ gpg --version+gpg (GnuPG) 2.0.26+libgcrypt 1.6.2+"""]]++### Possibly related information about the annexed repo and its history+The file was uploaded sometime earlier this year with a different version of git annex: Older source package for Arch Linux with Haskell packages from the Arch haskell repos.++The special glacier remote was initially set up with an old gpg key (hybrid encryption), which is still in my keychain but has expired. I exchanged the key with a new one by++ $ git annex enableremote glacier keyid+=NEWKEY keyid-=OLDKEY++I don't know why, but my AWS credentials seem no longer be embedded into the git repo. glacier upload (copy --to=) only succeeds with explicitly set AWS credential environment variables++I tried++ $ git annex enableremote embedcreds=yes++with no noticeable change.+I had changed the AWS credentials a while ago.++Tomorrow I will try to download a just recently uploaded file with the current credentials and keys.++> [[done]]; I am not confident that I understand this failure on retrival,+> and that I've fixed it. --[[Joey]]
+ doc/bugs/new_AWS_region___40__eu-central-1__41__.mdwn view
@@ -0,0 +1,8 @@+### Please describe the problem.++Amazon has opened up a new region in AWS with a datacenter in Frankfurt/Germany.++* Region Name: EU (Frankfurt) region+* Region: eu-central-1++This should be added to the "Adding an Amazon S3 repository" page in the Datacenter dropdown of the webapp.
doc/bugs/present_files__47__directories_are_dropped_after_a_sync.mdwn view
@@ -1,6 +1,6 @@ ### Please describe the problem. -This is a followup from the discussion on https://git-annex.branchable.com/forum/Standard_groups__47__preferred_contents/ where I unfortunately did not get a complete answer.+This is a followup from the discussion on <https://git-annex.branchable.com/forum/Standard_groups__47__preferred_contents/> where I unfortunately did not get a complete answer. I don't know if it is really a bug but at least it does not work as I would expect and the documentation provides no clear discussion on that. Now to the problem:@@ -36,3 +36,6 @@ 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 tahoe glacier ddar hook external ++[[!meta title="manual mode preferred content expression does not want newer versions of present files"]]+[[!tag confirmed]]
+ doc/bugs/rsync_remote_is_not_working.mdwn view
@@ -0,0 +1,26 @@+Host: Mac OS with git-annex 5.20140919-g0f7caf5++Remote: Linux ++* with git-annex 5.20140920-gb0c4300+* using user&password login++On Host:++1. create a repo with git init && git annex init && git annex direct+1. add a rsync repo in git-annex webapp, type "small archive", with shared encryption (same result using command line)+1. copy some new files to the repo, expect the files to appear in the remote repo (check with du)+1. Web app says "synced with remote-name", but remote repo is completely empty+1. run git annex copy --to $remotename, now remote repo is filled with files+1. but the sizes are really small, seems that the actual files are not being transferred+1. convert the repo to indirect repo: git annex indirect+1. re-run git annex copy, now the repo size on the remote seems about right+1. now start git annex assistant, copy some new files, expect new files to be synced+1. actual: the remote becomes completely empty, the existing files are removed!++The other small issue++* The add remote interface stops at "check remote" prompt for a long time without completing+* Kill the webapp process, re-run webapp, add remote again, it worked very quickly+* But future interaction with the remote still requires password, both commandline & webapp+
− doc/bugs/sync_does_not_preserve_timestamps.mdwn
@@ -1,16 +0,0 @@-### Please describe the problem.-I see that files are synced between my computers with git-annex but the timestamps do not match. The one that receives files always puts the current time of file creation on the file.--### What steps will reproduce the problem?-Install git-annex on two computers. Connect with XMPP. Then add cloud storage with shared encryption for transferring files. Since you want also backup, choose "full backup" as the type of cloud storage.---### What version of git-annex are you using? On what operating system?-Downloaded binary package dated 13/09/2014 amd64 Ubuntu 14.04.---### Please provide any additional information below.--Files are in sync. For example, I move a file from a directory to my synced annex directory. It contains timestamp of 01/01/2010 for example. Once the file gets transferred to the remote computer, it gets current time, for example 20/09/2014 rather than keeping 01/01/2010. --All computers are linux based, ext4 filesystems. File transfers are done through shared encryption rsync remote.
doc/bugs/vicfg_and_description_often_not_propagated.mdwn view
@@ -150,3 +150,5 @@ #schedule a6febfa0-9fe5-4a65-95bb-dc255d87c2e2 = # End of transcript or log. """]]++[[!tag moreinfo]]
+ doc/devblog/day_224-226__long_rainy_slog.mdwn view
@@ -0,0 +1,14 @@+3 days spent redoing the Android autobuilder! The new version of+yesod-routes generates TH splices that break the EvilSplicer. So after+updating everything to new versions for the Nth time, I instead went back+to older versions. The autobuilder now uses Debian jessie, instead of+wheezy. And all haskell packages are pinned to use the same version+as in jessie, rather than the newest versions. Since jessie is quite near+to being frozen, this should make the autobuilder much less prone to+getting broken by new versions of haskell packages that need patches for+Android.++I happened to stumble over <http://hackage.haskell.org/package/setenv>+while doing that. This supports setting and unsetting environment variables+on Windows, which I had not known a way to do from Haskell. Cleaned up+several ugly corners of the Windows port using it.
+ doc/devblog/day_227__info.mdwn view
@@ -0,0 +1,33 @@+Today, I've expanded `git annex info` to also be able to be used on annexed files+and on remotes. Looking at the info for an individual remote is quite+useful, especially for answering questions like: Does the remote have+embedded creds? Are they encrypted? Does it use chunking? Is that old style+chunking?++<pre>+remote: rsync.net+description: rsync.net demo remote+uuid: 15b42f18-ebf2-11e1-bea1-f71f1515f9f1+cost: 250.0+type: rsync+url: xxx@usw-s002.rsync.net:foo+encryption: encrypted (to gpg keys: 7321FC22AC211D23 C910D9222512E3C7)+chunking: 1 MB chunks+</pre>++<pre>+remote: ia3+description: test [ia3]+uuid: 12817311-a189-4de3-b806-5f339d304230+cost: 200.0+type: S3+creds: embedded in git repository (not encrypted)+bucket: joeyh-test-17oct-3+internet archive item: http://archive.org/details/joeyh-test-17oct-3+encryption: not encrypted+chunking: none+</pre>++Should be quite useful info for debugging too..++Yesterday, I fixed a bug that prevented retrieving files from Glacier.
+ doc/devblog/day__228_new_AWS.mdwn view
@@ -0,0 +1,13 @@+New AWS region in Germany announced today. git-annex doesn't support it+yet, unless you're using the `s3-aws` branch.++I cleaned up that branch, got it building again, and re-tested it with+`testremote`, and then fixed a problem the test suite found that was+caused by some changes in the haskell aws library.++Unfortunately, s3-aws is [not ready to be merged](http://git-annex.branchable.com/bugs/new_AWS_region___40__eu-central-1__41__)+because of some cabal dependency problems involving `dbus` and `random`. I did+go ahead and update Debian's haskell-aws package to cherry-pick+from a newer version the change needed for Inernet Archive+support, which allows building the s3-aws branch on Debian.+Getting closer..
+ doc/forum/ARM_build_on_Zyxel_NAS.mdwn view
@@ -0,0 +1,15 @@+I am trying to run the linux standalone ARM build on my Zyxel NAS, but I get the following error++`FATAL: kernel too old`++The system runs the following:++`+uname -a+`++`+Linux nas 2.6.31.8 #2 Thu Dec 19 14:31:05 CST 2013 armv5tel GNU/Linux+`++Help would be much appreciated.
+ doc/forum/Changing_files_during_git_annex_runs.mdwn view
@@ -0,0 +1,12 @@+Hello,++I have my music git annexed, direct mode. It's about 30k files of 429GB size. Some actions take considerable time (sync, add and of course transfer to/from other repos). During this time I don't hear music because of my player changes files. :-(++When is it a problem when a files changes during git annex operations?++git annex get gives a wrong checksum I guess and you need to re-transfer later.++What about git annex add?++Thx!+Florian
+ doc/forum/Copying_to_S3_does_not_work_-_chunking_does_not_work.mdwn view
@@ -0,0 +1,47 @@+Posting this here because I am not sure if it is a bug or if I am missing something.++I have a ~10 GB file in git-annex. I can't get it to go to S3 whatever I do.++I added a S3 special remote:++ git annex initremote s3-mybucket type=S3 chunk=1MiB keyid=ABCD1234 bucket=mybucket++Then, I tried copying files to the remote. Small files worked, but big files don't:++ $ git annex copy bigfile.tgz --to s3-mybucket+ copy bigfile.tgz (gpg)+ You need a passphrase to unlock the secret key for+ user: "user"+ 2048-bit RSA key, ID ABCD1234, created 2014-10-13 (main key ID ABCD1234)++ (checking s3-mybucket...) (to s3-mybucket...)++ Your proposed upload exceeds the maximum allowed size+ failed+ git-annex: copy: 1 failed++I tried some stuff like this too:++ git annex enableremote s3-mybucket chunk=100MiB+ git annex enableremote s3-mybucket chunksize=100MiB++It didn't work. Same result.++ $ git annex version+ git-annex version: 5.20140717+ build flags: Assistant Webapp Webapp-secure Pairing Testsuite S3 WebDAV FsEvents XMPP 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 tahoe glacier ddar hook external+ local repository version: 5+ supported repository version: 5+ upgrade supported from repository versions: 0 1 2 4++The chunk size did seem to be set properly:++ $ git checkout git-annex+ $ cat remote.log+ xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxx bucket=mybucket chunk=100MiB chunksize=100MiB cipher=....++I'm on OSX 10.9.4 and I installed git-annex via homebrew.++Any ideas?
+ doc/forum/Default_annex.largefiles.mdwn view
@@ -0,0 +1,1 @@+I'm new to git annex, so if this has been discussed before, please forgive me. The documentation of annex.largefiles seems to say that all files are added to the annex by default. However, when I tried it, several of my smaller files were not added to the annex. I admit that I haven't tried changing this value yet. Has the default changed? I'm using the package from Arch AUR git-annex-bin. Possibly this version has a different default?
+ doc/forum/Git-Annex_Android_sync_files_are_missing_on_Linuxx.mdwn view
@@ -0,0 +1,4 @@+Hi+I created shares between Linux and Android(using nightly 4.4). I used Assistant on both. It seems like the files from Android to Linux are all missing, at least the symlinks are broken maybe. However files from Linux to Android are fine.++thanks
+ doc/forum/How_to_work_with_transfer_repos_manually__63__.mdwn view
@@ -0,0 +1,18 @@+Hello,++I have 3 repos, desktop, external and server. desktop and server are sometimes connected, sometimes they should sync using the server. I want to do it manually without the assistent, since I love to learn it that way before I let the assistent do the work.++client and desktop are "wanted standard" and "group client". server is "group transfer".++desktop and server have each other and server in their remotes. server has no remotes.++Is this setup fine that way?++How to use it with the transfer repo?++"git annex sync && git annex copy --to server --auto" after changing files?+"git annex sync && git annex copy --from server --auto" to update?++Will the on the server automatically be dropped? Or do the server needs to have a active role, i.e. called via ssh?++Thanks!
+ doc/forum/lsof_resource_use_problems.mdwn view
@@ -0,0 +1,42 @@+When the assistant runs lsof on my file system, the lsof process consumes a horrendous amount of memory (>11GB). This forces a large amount of swapping, and brings the system to its knees until the process exits. The same thing occurs when I run lsof manually, but this is currently making the assistant unusable for me. Is this normal when running lsof on a large number of files, or is something wrong with my particular setup?++An example of resource usage from top, and some system details:++---+ PID USERNAME THR PRI NICE SIZE RES STATE C TIME WCPU COMMAND+ 33735 username 1 23 0 28208M 11507M pfault 0 0:07 58.50% lsof+---+ [username@hostname /mnt/media]$ uname -a+ FreeBSD hostname 9.2-RELEASE-p10 FreeBSD 9.2-RELEASE-p10 #0 r262572+4fb5adc: Wed Aug 6 17:07:16 PDT 2014 root@build3.ixsystems.com:/fusion/jkh/921/freenas/os-base/amd64/fusion/jkh/921/freenas/FreeBSD/src/sys/FREENAS.amd64 amd64+---+ [username@hostname /mnt/media]$ lsof -h+ lsof 4.88+---+ [username@hostname /mnt/media]$ git annex info+ repository mode: direct+ trusted repositories: 0+ semitrusted repositories: 1+ d03b21fc-666d-457d-b953-0ca0ac7393d8 -- [hostname_media_indirect]+ untrusted repositories: 2+ 00000000-0000-0000-0000-000000000001 -- web+ 31497a4d-290e-409a-9fd2-20c7340c245b -- hostname_mnt/media [here]+ transfers in progress: none+ available local disk space: 780.1 gigabytes (+10 gigabytes reserved)+ local annex keys: 41576+ local annex size: 943.95 gigabytes (+ 49 unknown size)+ annexed files in working tree: 41887+ size of annexed files in working tree: 945.14 gigabytes (+ 50 unknown size)+ bloom filter size: 16 mebibytes (8.3% full)+ backend usage:+ SHA512E: 81518+ WORM: 1846+ URL: 99+---+ [username@hostname /mnt/media]$ git annex version+ git-annex version: 5.20140817+ build flags: Assistant Webapp Webapp-secure Pairing S3 WebDAV Kqueue XMPP 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 tahoe glacier ddar hook external+ local repository version: 5+ supported repository version: 5+ upgrade supported from repository versions: 0 1 2 4
doc/git-annex.mdwn view
@@ -676,17 +676,17 @@ To generate output suitable for the gource visualization program, specify `--gource`. -* `info [directory ...]`+* `info [directory|file|remote ...]` - Displays some statistics and other information, including how much data- is in the annex and a list of all known repositories.+ Displays statistics and other information for the specified item,+ which can be a directory, or a file, or a remote.+ When no item is specified, displays statistics and information+ for the repository as a whole. - To only show the data that can be gathered quickly, use `--fast`.+ When a directory is specified, the file matching options can be used+ to select the files in the directory that are included in the statistics. - When a directory is specified, shows a differently formatted info- display for that directory. In this mode, all of the matching- options can be used to filter the files that will be included in- the information.+ To only show the data that can be gathered quickly, use `--fast`. For example, suppose you want to run "git annex get .", but would first like to see how much disk space that will use.
− doc/news/version_5.20140831.mdwn
@@ -1,13 +0,0 @@-git-annex 5.20140831 released with [[!toggle text="these changes"]]-[[!toggleable text="""- * Make --help work when not in a git repository. Closes: #[758592](http://bugs.debian.org/758592)- * Ensure that all lock fds are close-on-exec, fixing various problems with- them being inherited by child processes such as git commands.- * When accessing a local remote, shut down git-cat-file processes- afterwards, to ensure that remotes on removable media can be unmounted.- Closes: #[758630](http://bugs.debian.org/758630)- * Fix handing of autocorrection when running outside a git repository.- * Fix stub git-annex test support when built without tasty.- * Do not preserve permissions and acls when copying files from- one local git repository to another. Timestamps are still preserved- as long as cp --preserve=timestamps is supported. Closes: #[729757](http://bugs.debian.org/729757)"""]]
− doc/news/version_5.20140915.mdwn
@@ -1,27 +0,0 @@-git-annex 5.20140915 released with [[!toggle text="these changes"]]-[[!toggleable text="""- * New annex.hardlink setting. Closes: #[758593](http://bugs.debian.org/758593)- * init: Automatically detect when a repository was cloned with --shared,- and set annex.hardlink=true, as well as marking the repository as- untrusted.- * Fix parsing of ipv6 address in git remote address when it was not- formatted as an url.- * The annex-rsync-transport configuration is now also used when checking- if a key is present on a rsync remote, and when dropping a key from- the remote.- * Promote file not found warning message to an error.- * Fix transfer lock file FD leak that could occur when two separate- git-annex processes were both working to perform the same set of- transfers.- * sync: Ensure that pending changes to git-annex branch are committed- before push when in direct mode. (Fixing a very minor reversion.)- * WORM backend: Switched to include the relative path to the file inside- the repository, rather than just the file's base name. Note that if you're- relying on such things to keep files separate with WORM, you should really- be using a better backend.- * Rather than crashing when there's a problem with the requested bloomfilter- capacity/accuracy, fall back to a reasonable default bloom filter size.- * Fix build with optparse-applicative 0.10. Closes: #[761484](http://bugs.debian.org/761484)- * webapp: Fixed visual glitch in xmpp pairing that was reported live by a- user who tracked me down in front of a coffee cart in Portland.- (New bug reporting method of choice?)"""]]
+ doc/news/version_5.20141013.mdwn view
@@ -0,0 +1,7 @@+git-annex 5.20141013 released with [[!toggle text="these changes"]]+[[!toggleable text="""+ * Adjust cabal file to support building w/o assistant on the hurd.+ * Support building with yesod 1.4.+ * S3: Fix embedcreds=yes handling for the Internet Archive.+ * map: Handle .git prefixed remote repos. Closes: #[614759](http://bugs.debian.org/614759)+ * repair: Prevent auto gc from happening when fetching from a remote."""]]
+ doc/news/version_5.20141024.mdwn view
@@ -0,0 +1,21 @@+git-annex 5.20141024 released with [[!toggle text="these changes"]]+[[!toggleable text="""+ * vicfg: Deleting configurations now resets to the default, where+ before it has no effect.+ * Remove hurd stuff from cabal file, since hackage currently rejects+ it, and the test suite fails on hurd.+ * initremote: Don't allow creating a special remote that has the same+ name as an existing git remote.+ * Windows: Use haskell setenv library to clean up several ugly workarounds+ for inability to manipulate the environment on windows. This includes+ making git-annex not re-exec itself on start on windows, and making the+ test suite on Windows run tests without forking.+ * glacier: Fix pipe setup when calling glacier-cli to retrieve an object.+ * info: When run on a single annexed file, displays some info about the+ file, including its key and size.+ * info: When passed the name or uuid of a remote, displays info about that+ remote. Remotes that support encryption, chunking, or embedded+ creds will include that in their info.+ * enableremote: When the remote has creds, update the local creds cache+ file. Before, the old version of the creds could be left there, and+ would continue to be used."""]]
+ doc/tips/deleting_unwanted_files.mdwn view
@@ -0,0 +1,40 @@+It's quite hard to delete a file from a git repository once it's checked in and pushed to origin. This is normally ok, since git repositories contain mostly small files, and a good thing since losing hard work stinks. ++With git-annex this changes some: Very large files can be managed with git-annex, and it's not uncommon to be done with such a file and want to delete it. So, git-annex provides a number of ways to handle this, while still trying to avoid accidental foot shooting that would lose the last copy of an important file.++## the garbage collecting method++In this method, you just remove annexed files whenever you want, and commit the changes. This is probably the most natural way to go.++In an indirect mode repo, you can do this the same way you would in a regular git repository. For example, `git rm foo; git commit -m "removed foo"`. This leaves the contents of the files still in the annex, not really deleted yet.++If you have a direct mode repo, you can't run `git rm` in it. Instead, you can just delete files using `rm` or your file manager, and then run `git annex sync` to commit the deletion. That will delete the file's content from your disk. Even if it's the only copy of the file!++Either way, deleting files can leave some garbage lying around in either the local repository, or other repositories that contained a copy of the content of the file you deleted. Eventually you'll want to free up some disk space used by one of these repositories, and then it's time to take out the garbage.++To collect the garbage, you can run `git annex unused` inside the repository which you want to slim down. That will list files stored in the annex that are not used by any git branches or tags. Followed by `git annex dropunused 1-10` to delete a range of the unused files from the annex.++In recent versions of git-annex, `git annex dropunused` checks that enough other copies of a file's content exist in other repositories before deleting it, so this won't ever delete the last copy of some file. This is a good default, because these unused files are still referred to by some commits in the git history, and you might want to retain the full history of every version of a file.++But, let's say you don't care about that, you only want to keep files that are in use by branches and tags. Then you can use `git annex dropunused --force` with a range of files, which will delete them even if it's the last copy.++Finally, sometimes you want to remove unused files from a special remote. To accomplish this, pass `--from remotename` to the unused and dropunused commands, and they will act on+files stored in that remote, rather than on the local repository.++## let the assistant take care of it++If you're using the git-annex assistant, you don't normally need to worry about this. Just delete files however you normally would. The assistant will try to migrate unused file contents away from your local repository and store them in whatever backup repositories you've set up.++## delete all the copies method++You have a file. You want that file to immediately vanish from the face of the earth to the best of your abilities.++Note that, since git-annex deduplicates files by default, any files with+the same content will be removed by these commands.++1. `git annex drop --force file`+2. `git annex whereis file`+3. `git annex drop --force file --from $repo` repeat for each repository listed by the whereis command+4. `rm file; git annex sync`++Of course, if you have offline backup repositories that contain this file, you'll have to bring them online before you can drop it from them, etc.
doc/tips/file_manager_integration.mdwn view
@@ -31,7 +31,7 @@ for drop, and for get: - git-annex drop --notify-start --notify-finish -- %F+ git-annex get --notify-start --notify-finish -- %F This gives me the resulting config on disk, in `.config/Thunar/uca.xml`:
+ doc/todo/does_not_preserve_timestamps.mdwn view
@@ -0,0 +1,16 @@+### Please describe the problem.+I see that files are synced between my computers with git-annex but the timestamps do not match. The one that receives files always puts the current time of file creation on the file.++### What steps will reproduce the problem?+Install git-annex on two computers. Connect with XMPP. Then add cloud storage with shared encryption for transferring files. Since you want also backup, choose "full backup" as the type of cloud storage.+++### What version of git-annex are you using? On what operating system?+Downloaded binary package dated 13/09/2014 amd64 Ubuntu 14.04.+++### Please provide any additional information below.++Files are in sync. For example, I move a file from a directory to my synced annex directory. It contains timestamp of 01/01/2010 for example. Once the file gets transferred to the remote computer, it gets current time, for example 20/09/2014 rather than keeping 01/01/2010. ++All computers are linux based, ext4 filesystems. File transfers are done through shared encryption rsync remote.
doc/todo/read-only_removable_drives.mdwn view
@@ -7,3 +7,11 @@ > Workaround: `sudo setfacl -R -m u:anarcat:rwx /media/foo/annex` Note: this seems like there was at least one dupe opened about this in [[bugs/annex_get_fails_from_read-only_filesystem]].++I concede that this may refer to many different issues, so here's a short inventory of issues with readonly repositories:++* trying to add an external readonly drive through the webapp: not detected: see [[todo/show_readonly_removable_drives_in_the_webapp]]+* trying to add an external readonly drive through the commandline: fails to sync? - couldn't reproduce locally, i will need to go back to that machine for more tests :(+* trying to add a ssh readonly remote through the webapp: fails to sync and considers the remote "git-only" (which also fails) - couldn't reproduce locally either - maybe this is related to the upgrade option in [[bugs/annex_get_fails_from_read-only_filesystem/]] +* trying to add a local readonly remote through the webapp: fails to add, see [[bugs/cannot_add_local_readonly_repo_through_the_webapp]]+* failing to sync with a readonly remote of a different version: still an issue, see [[bugs/annex_get_fails_from_read-only_filesystem/]] - at least content should be syncable even if the upgrade fails (think of failure conditions such as broken hard drives that are put in readonly mode or ddrescue'd disk images)
+ doc/todo/show_readonly_removable_drives_in_the_webapp.mdwn view
@@ -0,0 +1,15 @@+Coming from [[todo/read-only_removable_drives/]], this is use case 1: use inserts an `ext` formatted filesystem that he built at home (so files are owned by uid `1000`) in the office computer (where he is uid `1001`). Now, this is a limitation of UNIX-style removable drives, admittedly, but I would expect to be able to sync "down" from the hard drives to copy the contents locally.++So in short, expected behavior:++1. insert the drive+2. drive is shown in the webapp menu+3. add the drive as a remote for the local repo+4. sync the content from the drive to the local repo++Actual behavior:++1. insert the drive+2. drive is not shown in the webapp menu++--[[anarcat]]
doc/todo/vicfg_comment_gotcha.mdwn view
@@ -9,8 +9,12 @@ should be in response to such an action. The default varies per type of configuration, and vicfg does't know about defaults. +> [[fixed|done]]; this was a job for Data.Default! --[[Joey]]+ Instead, I think it should detect when a setting provided in the input version of the file is not present in the output version, and plop the user back into the editor with an error, telling them that cannot be handled, and suggesting they instead change the value to the value they now want it to have.++> Nah, too complicated.
git-annex.1 view
@@ -625,16 +625,16 @@ To generate output suitable for the gource visualization program, specify \fB\-\-gource\fP. .IP-.IP "\fBinfo [directory ...]\fP"-Displays some statistics and other information, including how much data-is in the annex and a list of all known repositories.+.IP "\fBinfo [directory|file|remote ...]\fP"+Displays statistics and other information for the specified item,+which can be a directory, or a file, or a remote.+When no item is specified, displays statistics and information+for the repository as a whole. .IP-To only show the data that can be gathered quickly, use \fB\-\-fast\fP.+When a directory is specified, the file matching options can be used+to select the files in the directory that are included in the statistics. .IP-When a directory is specified, shows a differently formatted info-display for that directory. In this mode, all of the matching-options can be used to filter the files that will be included in-the information.+To only show the data that can be gathered quickly, use \fB\-\-fast\fP. .IP For example, suppose you want to run "git annex get .", but would first like to see how much disk space that will use.
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 5.20141013+Version: 5.20141024 Cabal-Version: >= 1.8 License: GPL-3 Maintainer: Joey Hess <joey@kitenet.net>@@ -125,7 +125,7 @@ GHC-Options: -O2 if (os(windows))- Build-Depends: Win32, Win32-extras, unix-compat (>= 0.4.1.3)+ Build-Depends: Win32, Win32-extras, unix-compat (>= 0.4.1.3), setenv C-Sources: Utility/winprocess.c else Build-Depends: unix
git-annex.hs view
@@ -19,9 +19,6 @@ #ifdef mingw32_HOST_OS import Utility.UserInfo import Utility.Env-import Config.Files-import System.Process-import System.Exit #endif main :: IO ()@@ -33,7 +30,9 @@ | isshell n = CmdLine.GitAnnexShell.run ps | otherwise = #ifdef mingw32_HOST_OS- winEnv gitannex ps+ do+ winEnv+ gitannex ps #else gitannex ps #endif@@ -49,37 +48,17 @@ #ifdef mingw32_HOST_OS {- On Windows, if HOME is not set, probe it and set it.- - This is a workaround for some Cygwin commands needing HOME to be set,- - and for there being no known way to set environment variables on- - Windows, except by passing an environment in each call to a program.- - While ugly, this workaround is easier than trying to ensure HOME is set- - in all calls to the affected programs.+ - This is a workaround for some Cygwin commands needing HOME to be set. - - If TZ is set, unset it. - TZ being set can interfere with workarounds for Windows timezone - horribleness, and prevents getCurrentTimeZone from seeing the system - time zone.- -- - Due to Windows limitations, have to re-exec git-annex with the new- - environment. -}-winEnv :: ([String] -> IO ()) -> [String] -> IO ()-winEnv a ps = do- e <- getEnvironment+winEnv :: IO ()+winEnv = do home <- myHomeDir- let e' = wantedenv e home- if (e' /= e)- then do- cmd <- readProgramFile- (_, _, _, pid) <- createProcess (proc cmd ps)- { env = Just e' }- exitWith =<< waitForProcess pid - else a ps- where- wantedenv e home = delEntry "TZ" $ case lookup "HOME" e of- Nothing -> e - Just _ -> addEntries- [ ("HOME", home)- , ("CYGWIN", "nodosfilewarning")- ] e+ setEnv "HOME" home False+ setEnv "CYGWIN" "nodosfilewarning" True+ unsetEnv "TZ" #endif
standalone/android/Makefile view
@@ -115,14 +115,15 @@ touch $@ $(GIT_ANNEX_ANDROID_SOURCETREE)/git/build-stamp: git.patch- cat git.patch | (cd $(GIT_ANNEX_ANDROID_SOURCETREE)/git && git am)+ # This is a known-good version that the patch works with.+ cat git.patch | (cd $(GIT_ANNEX_ANDROID_SOURCETREE)/git && git reset --hard f9dc5d65ca31cb79893e1296efe37727bf58f3f3 && git am) cd $(GIT_ANNEX_ANDROID_SOURCETREE)/git && $(MAKE) install NO_OPENSSL=1 NO_GETTEXT=1 NO_GECOS_IN_PWENT=1 NO_GETPASS=1 NO_NSEC=1 NO_MKDTEMP=1 NO_PTHREADS=1 NO_PERL=1 NO_CURL=1 NO_EXPAT=1 NO_TCLTK=1 NO_ICONV=1 HAVE_CLOCK_GETTIME= prefix= DESTDIR=installed-tree touch $@ $(GIT_ANNEX_ANDROID_SOURCETREE)/rsync/build-stamp: rsync.patch # This is a known-good version that the patch works with. cat rsync.patch | (cd $(GIT_ANNEX_ANDROID_SOURCETREE)/rsync && git reset --hard eec26089b1c7bdbb260674480ffe6ece257bca63 && git am)- cp $(GIT_ANNEX_ANDROID_SOURCETREE)/automake/lib/config.sub $(GIT_ANNEX_ANDROID_SOURCETREE)/automake/lib/config.guess $(GIT_ANNEX_ANDROID_SOURCETREE)/rsync/+ cp /usr/share/misc/config.sub /usr/share/misc/config.guess $(GIT_ANNEX_ANDROID_SOURCETREE)/rsync/ cd $(GIT_ANNEX_ANDROID_SOURCETREE)/rsync && ./configure --host=arm-linux-androideabi --disable-locale --disable-iconv-open --disable-iconv --disable-acl-support --disable-xattr-support cd $(GIT_ANNEX_ANDROID_SOURCETREE)/rsync && $(MAKE) touch $@@@ -153,7 +154,6 @@ $(GIT_ANNEX_ANDROID_SOURCETREE): mkdir -p $(GIT_ANNEX_ANDROID_SOURCETREE)- git clone git://git.savannah.gnu.org/automake.git $(GIT_ANNEX_ANDROID_SOURCETREE)/automake git clone git://git.debian.org/git/d-i/busybox $(GIT_ANNEX_ANDROID_SOURCETREE)/busybox git clone git://git.kernel.org/pub/scm/git/git.git $(GIT_ANNEX_ANDROID_SOURCETREE)/git git clone git://git.samba.org/rsync.git $(GIT_ANNEX_ANDROID_SOURCETREE)/rsync
standalone/android/buildchroot view
@@ -5,7 +5,7 @@ exit 1 fi -debootstrap --arch=i386 stable debian-stable-android+debootstrap --arch=i386 jessie debian-stable-android cp $0-inchroot debian-stable-android/tmp cp $0-inchroot-asuser debian-stable-android/tmp cp $(dirname $0)/abiversion debian-stable-android/tmp
standalone/android/buildchroot-inchroot view
@@ -10,23 +10,18 @@ # java needs this mounted to work mount -t proc proc /proc || true -echo "deb-src http://ftp.us.debian.org/debian stable main" >> /etc/apt/sources.list+echo "deb-src http://ftp.us.debian.org/debian jessie main" >> /etc/apt/sources.list apt-get update apt-get -y install build-essential ghc git libncurses5-dev cabal-install apt-get -y install happy alex-apt-get -y install llvm-3.0 # not 3.1; buggy on arm. 3.2 is ok too+apt-get -y install llvm-3.4 apt-get -y install ca-certificates curl file m4 autoconf zlib1g-dev apt-get -y install libgnutls-dev libxml2-dev libgsasl7-dev pkg-config c2hs apt-get -y install ant default-jdk rsync wget gnupg lsof apt-get -y install gettext unzip python-apt-get -y install locales-# works around a dependncy issue with the current hjsmin-apt-get -y install libghc-hjsmin-dev+apt-get -y install locales automake echo en_US.UTF-8 UTF-8 >> /etc/locale.gen locale-gen apt-get clean-wget http://snapshot.debian.org/archive/debian/20130903T155330Z/pool/main/a/automake-1.14/automake_1.14-1_all.deb-dpkg -i automake*.deb-rm *.deb useradd builder --create-home || true su builder -c $0-asuser
standalone/android/buildchroot-inchroot-asuser view
@@ -13,15 +13,11 @@ cd rm -rf .ghc .cabal .android-cabal update-cabal install happy alex --bindir=$HOME/bin-PATH=$HOME/bin:$PATH-export PATH mkdir -p .android cd .android git clone https://github.com/joeyh/ghc-android cd ghc-android-git checkout stable-ghc-snapshot+git checkout jessie-ghc-snapshot ./build # This saves 2 gb, and the same sources are in build-*/ghc
+ standalone/android/cabal.config view
@@ -0,0 +1,208 @@+constraints: Crypto ==4.2.5.1,+ DAV ==1.0.3,+ HTTP ==4000.2.17,+ HUnit ==1.2.5.2,+ IfElse ==0.85,+ MissingH ==1.2.1.0,+ MonadRandom ==0.1.13,+ QuickCheck ==2.7.6,+ SHA ==1.6.1,+ SafeSemaphore ==0.10.1,+ aeson ==0.7.0.6,+ ansi-terminal ==0.6.1.1,+ ansi-wl-pprint ==0.6.7.1,+ appar ==0.1.4,+ asn1-encoding ==0.8.1.3,+ asn1-parse ==0.8.1,+ asn1-types ==0.2.3,+ async ==2.0.1.5,+ attoparsec ==0.11.3.4,+ attoparsec-conduit ==1.1.0,+ authenticate ==1.3.2.10,+ base-unicode-symbols ==0.2.2.4,+ base16-bytestring ==0.1.1.6,+ base64-bytestring ==1.0.0.1,+ bifunctors ==4.1.1.1,+ bloomfilter ==2.0.0.0,+ byteable ==0.1.1,+ byteorder ==1.0.4,+ case-insensitive ==1.2.0.1,+ cereal ==0.4.0.1,+ cipher-aes ==0.2.8,+ cipher-des ==0.0.6,+ cipher-rc4 ==0.1.4,+ clientsession ==0.9.0.3,+ comonad ==4.2,+ conduit ==1.1.6,+ conduit-extra ==1.1.3,+ connection ==0.2.3,+ contravariant ==0.6.1.1,+ cookie ==0.4.1.2,+ cprng-aes ==0.5.2,+ crypto-api ==0.13.2,+ crypto-cipher-types ==0.0.9,+ crypto-numbers ==0.2.3,+ crypto-pubkey ==0.2.4,+ crypto-pubkey-types ==0.4.2.2,+ crypto-random ==0.0.7,+ cryptohash ==0.11.6,+ cryptohash-conduit ==0.1.1,+ css-text ==0.1.2.1,+ shakespeare-text ==1.0.2,+ data-default ==0.5.3,+ data-default-class ==0.0.1,+ data-default-instances-base ==0.0.1,+ data-default-instances-containers ==0.0.1,+ data-default-instances-dlist ==0.0.1,+ data-default-instances-old-locale ==0.0.1,+ dataenc ==0.14.0.7,+ dbus ==0.10.8,+ distributive ==0.4.4,+ dlist ==0.7.0.1,+ dns ==1.3.0,+ edit-distance ==0.2.1.2,+ either ==4.3,+ email-validate ==1.0.0,+ entropy ==0.2.1,+ errors ==1.4.7,+ exceptions ==0.6.1,+ failure ==0.2.0.3,+ fast-logger ==2.1.5,+ fdo-notify ==0.3.1,+ feed ==0.3.9.2,+ file-embed ==0.0.6,+ fingertree ==0.1.0.0,+ free ==4.9,+ gnuidn ==0.2,+ gnutls ==0.1.4,+ gsasl ==0.3.5,+ hS3 ==0.5.7,+ hamlet ==1.1.9.2,+ hashable ==1.2.1.0,+ hinotify ==0.3.5,+ hjsmin ==0.1.4.7,+ hslogger ==1.2.1,+ http-client ==0.3.8.2,+ http-client-tls ==0.2.2,+ http-conduit ==2.1.2.3,+ http-date ==0.0.2,+ http-types ==0.8.5,+ hxt ==9.3.1.4,+ hxt-charproperties ==9.1.1.1,+ hxt-regex-xmlschema ==9.0.4,+ hxt-unicode ==9.0.2.2,+ idna ==0.2,+ iproute ==1.2.11,+ json ==0.5,+ keys ==3.10.1,+ language-javascript ==0.5.13,+ lens ==4.4.0.2,+ libxml-sax ==0.7.5,+ mime-mail ==0.4.1.2,+ mime-types ==0.1.0.4,+ mmorph ==1.0.3,+ monad-control ==0.3.2.2,+ monad-logger ==0.3.6.1,+ monad-loops ==0.4.2.1,+ monads-tf ==0.1.0.2,+ mtl ==2.1.2,+ nats ==0.1.2,+ network ==2.4.1.2,+ network-conduit ==1.1.0,+ network-info ==0.2.0.5,+ network-multicast ==0.0.10,+ network-protocol-xmpp ==0.4.6,+ network-uri ==2.6.0.1,+ optparse-applicative ==0.10.0,+ parallel ==3.2.0.4,+ path-pieces ==0.1.4,+ pem ==0.2.2,+ persistent ==1.3.3,+ persistent-template ==1.3.2.2,+ pointed ==4.0,+ prelude-extras ==0.4,+ profunctors ==4.0.4,+ publicsuffixlist ==0.1,+ punycode ==2.0,+ random ==1.0.1.1,+ ranges ==0.2.4,+ reducers ==3.10.2.1,+ reflection ==1.2.0.1,+ regex-base ==0.93.2,+ regex-compat ==0.95.1,+ regex-posix ==0.95.2,+ regex-tdfa ==1.2.0,+ resource-pool ==0.2.1.1,+ resourcet ==1.1.2.3,+ safe ==0.3.8,+ securemem ==0.1.3,+ semigroupoids ==4.2,+ semigroups ==0.15.3,+ shakespeare ==1.2.1.1,+ shakespeare-css ==1.0.7.4,+ shakespeare-i18n ==1.0.0.5,+ shakespeare-js ==1.2.0.4,+ silently ==1.2.4.1,+ simple-sendfile ==0.2.14,+ skein ==1.0.9,+ socks ==0.5.4,+ split ==0.2.2,+ stm ==2.4.2,+ stm-chans ==3.0.0.2,+ streaming-commons ==0.1.4.1,+ stringprep ==0.1.5,+ stringsearch ==0.3.6.5,+ syb ==0.4.0,+ system-fileio ==0.3.14,+ system-filepath ==0.4.12,+ tagged ==0.7.2,+ tagsoup ==0.13.1,+ tagstream-conduit ==0.5.5.1,+ tasty ==0.10,+ tasty-hunit ==0.9,+ tasty-quickcheck ==0.8.1,+ tasty-rerun ==1.1.3,+ text ==1.1.1.0,+ text-icu ==0.6.3.7,+ tf-random ==0.5,+ tls ==1.2.9,+ transformers ==0.3.0.0,+ transformers-base ==0.4.1,+ transformers-compat ==0.3.3.3,+ unbounded-delays ==0.1.0.8,+ unix-compat ==0.4.1.3,+ unix-time ==0.2.2,+ unordered-containers ==0.2.5.0,+ utf8-string ==0.3.7,+ uuid ==1.3.3,+ vault ==0.3.0.3,+ vector ==0.10.0.1,+ void ==0.6.1,+ wai ==3.0.1.1,+ wai-app-static ==3.0.0.1,+ wai-extra ==3.0.1.2,+ wai-logger ==2.1.1,+ warp ==3.0.0.5,+ warp-tls ==3.0.0,+ word8 ==0.1.1,+ x509 ==1.4.11,+ x509-store ==1.4.4,+ x509-system ==1.4.5,+ x509-validation ==1.5.0,+ xml ==1.3.13,+ xml-conduit ==1.2.1,+ xml-hamlet ==0.4.0.9,+ xml-types ==0.3.4,+ xss-sanitize ==0.3.5.2,+ yaml ==0.8.9.3,+ yesod ==1.2.6.1,+ yesod-auth ==1.3.4.6,+ yesod-core ==1.2.20.1,+ yesod-default ==1.2.0,+ yesod-form ==1.3.16,+ yesod-persistent ==1.2.3.1,+ yesod-routes ==1.2.0.7,+ yesod-static ==1.2.4,+ zlib ==0.5.4.1,+ bytestring ==0.10.4.0,+ scientific ==0.3.3.1
− standalone/android/haskell-patches/entropy_cross-build.patch
@@ -1,25 +0,0 @@-From a3cc880bd06a8d7efda79339afa81e02decbd04b Mon Sep 17 00:00:00 2001-From: dummy <dummy@example.com>-Date: Mon, 14 Jul 2014 21:01:25 +0000-Subject: [PATCH] fix cross build------ entropy.cabal | 2 +-- 1 file changed, 1 insertion(+), 1 deletion(-)--diff --git a/entropy.cabal b/entropy.cabal-index 914d33a..9ab80f7 100644---- a/entropy.cabal-+++ b/entropy.cabal-@@ -16,7 +16,7 @@ bug-reports: https://github.com/TomMD/entropy/issues- stability: stable- -- build-type: Simple- -- ^^ Used for HaLVM--build-type: Custom-+build-type: Simple- -- ^^ Test for RDRAND support using 'ghc'- cabal-version: >=1.10- tested-with: GHC == 7.8.2--- -1.7.10.4-
+ standalone/android/haskell-patches/gnuidn_fix-build-with-new-base.patch view
@@ -0,0 +1,50 @@+From afdec6c9e66211a0ac8419fffe191b059d1fd00c Mon Sep 17 00:00:00 2001+From: foo <foo@bar>+Date: Sun, 22 Sep 2013 17:24:33 +0000+Subject: [PATCH] fix build with new base++---+ Data/Text/IDN/IDNA.chs | 1 ++ Data/Text/IDN/Punycode.chs | 1 ++ Data/Text/IDN/StringPrep.chs | 1 ++ 3 files changed, 3 insertions(+)++diff --git a/Data/Text/IDN/IDNA.chs b/Data/Text/IDN/IDNA.chs+index ed29ee4..dbb4ba5 100644+--- a/Data/Text/IDN/IDNA.chs++++ b/Data/Text/IDN/IDNA.chs+@@ -31,6 +31,7 @@ import Foreign+ import Foreign.C+ + import Data.Text.IDN.Internal++import System.IO.Unsafe+ + #include <idna.h>+ #include <idn-free.h>+diff --git a/Data/Text/IDN/Punycode.chs b/Data/Text/IDN/Punycode.chs+index 24b5fa6..4e62555 100644+--- a/Data/Text/IDN/Punycode.chs++++ b/Data/Text/IDN/Punycode.chs+@@ -32,6 +32,7 @@ import Data.List (unfoldr)+ import qualified Data.ByteString as B+ import qualified Data.Text as T+ ++import System.IO.Unsafe+ import Foreign+ import Foreign.C+ +diff --git a/Data/Text/IDN/StringPrep.chs b/Data/Text/IDN/StringPrep.chs+index 752dc9e..5e9fd84 100644+--- a/Data/Text/IDN/StringPrep.chs++++ b/Data/Text/IDN/StringPrep.chs+@@ -39,6 +39,7 @@ import qualified Data.ByteString as B+ import qualified Data.Text as T+ import qualified Data.Text.Encoding as TE+ ++import System.IO.Unsafe+ import Foreign+ import Foreign.C+ +-- +1.7.10.4+
+ standalone/android/haskell-patches/shakespeare-text_remove-TH.patch view
@@ -0,0 +1,153 @@+From dca2a30ca06865bf66cd25cc14b06f5d28190231 Mon Sep 17 00:00:00 2001+From: dummy <dummy@example.com>+Date: Thu, 16 Oct 2014 02:46:57 +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 6865a5a..e25a8be 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 (..))+@@ -45,106 +45,3 @@ instance ToText Int32 where toText = toText . show+ instance ToText Int64 where toText = toText . show+ instance ToText Int 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)+-- +2.1.1+
standalone/android/haskell-patches/unix-time_hack-for-Bionic.patch view
@@ -1,19 +1,18 @@-From add5feeb9ee9b4ffa1b43e4ba04b63e5ac2bfaf7 Mon Sep 17 00:00:00 2001+From db9eb179885874af342bb2c3adef7185496ba1f1 Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com>-Date: Mon, 14 Jul 2014 20:45:24 +0000+Date: Wed, 15 Oct 2014 16:37:32 +0000 Subject: [PATCH] hack for bionic ---- Data/UnixTime/Types.hsc | 12 ------------- cbits/conv.c | 2 +-- unix-time.cabal | 1 -- 3 files changed, 1 insertion(+), 14 deletions(-)+ Data/UnixTime/Types.hsc | 12 ------------+ cbits/conv.c | 2 +-+ 2 files changed, 1 insertion(+), 13 deletions(-) diff --git a/Data/UnixTime/Types.hsc b/Data/UnixTime/Types.hsc-index 2ad0623..04fd766 100644+index d30f39b..ec7ca4c 100644 --- a/Data/UnixTime/Types.hsc +++ b/Data/UnixTime/Types.hsc-@@ -12,8 +12,6 @@ import Data.Binary+@@ -9,8 +9,6 @@ import Foreign.Storable #include <sys/time.h> @@ -22,7 +21,7 @@ -- | -- Data structure for Unix time. data UnixTime = UnixTime {-@@ -23,16 +21,6 @@ data UnixTime = UnixTime {+@@ -20,16 +18,6 @@ data UnixTime = UnixTime { , utMicroSeconds :: {-# UNPACK #-} !Int32 } deriving (Eq,Ord,Show) @@ -36,9 +35,9 @@ - (#poke struct timeval, tv_sec) ptr (utSeconds ut) - (#poke struct timeval, tv_usec) ptr (utMicroSeconds ut) -- #if __GLASGOW_HASKELL__ >= 704- instance Binary UnixTime where- put (UnixTime (CTime sec) msec) = do+ -- |+ -- Format of the strptime()/strftime() style.+ type Format = ByteString diff --git a/cbits/conv.c b/cbits/conv.c index ec31fef..b7bc0f9 100644 --- a/cbits/conv.c@@ -52,18 +51,6 @@ } size_t c_format_unix_time(char *fmt, time_t src, char* dst, int siz) {-diff --git a/unix-time.cabal b/unix-time.cabal-index 5de3f7c..7a0c244 100644---- a/unix-time.cabal-+++ b/unix-time.cabal-@@ -15,7 +15,6 @@ Extra-Tmp-Files: config.log config.status autom4te.cache cbits/config.h- Library- Default-Language: Haskell2010- GHC-Options: -Wall-- CC-Options: -fPIC- Exposed-Modules: Data.UnixTime- Other-Modules: Data.UnixTime.Conv- Data.UnixTime.Diff -- -1.7.10.4+2.1.1
standalone/android/install-haskell-packages view
@@ -4,13 +4,10 @@ # # You should install ghc-android first. #-# Note that the newest version of packages are 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/+# The cabal.config is used to pin the haskell packages to the last+# versions that have been gotten working. To update, delete the+# cabal.config, run this script with an empty cabal and fix up the broken+# patches, and then use cabal freeze to generate a new cabal.config. set -e @@ -18,35 +15,19 @@ cd standalone/android fi -cabalopts="$@"- setupcabal () {- cabal update-- # Workaround for http://www.reddit.com/r/haskell/comments/26045a/if_youre_finding_cabal_cant_build_your_project/- # should be able to remove this eventually.- cabal install transformers-compat -fthree- cabal install mtl-2.1.3.1- # Some packages fail to install in a non unicode locale. LANG=en_US.UTF-8 export LANG-- # The android build chroot has recent versions of alex and happy- # installed here.- PATH=$HOME/bin:$PATH- export PATH } -cabalinstall () {- echo cabal install "$@" "$cabalopts"- eval cabal install "$@" "$cabalopts"-}- patched () { pkg=$1 ver=$2 if [ -z "$ver" ]; then+ ver="$(grep " $pkg " ../cabal.config | cut -d= -f 3 | sed 's/,$//')"+ fi+ if [ -z "$ver" ]; then cabal unpack $pkg else cabal unpack $pkg-$ver@@ -57,6 +38,7 @@ git config user.email dummy@example.com git add . git commit -m "pre-patched state of $pkg"+ ln -sf ../../cabal.config for patch in ../../haskell-patches/${pkg}_* ../../../no-th/haskell-patches/${pkg}_*; do if [ -e "$patch" ]; then echo trying $patch@@ -67,15 +49,24 @@ fi fi done- cabalinstall+ if [ -e config.sub ]; then+ cp /usr/share/misc/config.sub .+ fi+ if [ -e config.guess ]; then+ cp /usr/share/misc/config.guess .+ fi+ cabal install # --reinstall --force-reinstalls+ rm -f cabal.config+ rm -rf $pkg* cd .. } installgitannexdeps () { pushd ../..- echo cabal install --only-dependencies "$@"+ ln -sf standalone/android/cabal.config cabal install --only-dependencies "$@"+ rm -f cabal.config popd } @@ -83,7 +74,8 @@ rm -rf tmp mkdir tmp cd tmp-+cat <<EOF+EOF patched network patched unix-time patched lifted-base@@ -94,7 +86,7 @@ patched iproute patched primitive patched socks- patched entropy+ # patched entropy # needed for newer version, not current pinned version patched vector patched stm-chans patched persistent@@ -105,11 +97,13 @@ patched x509-system patched persistent-template patched system-filepath+ patched optparse-applicative patched wai-app-static patched shakespeare patched shakespeare-css patched shakespeare-js patched yesod-routes+ patched hamlet patched yesod-core patched yesod-persistent patched yesod-form@@ -124,23 +118,19 @@ patched dns patched gnutls patched unbounded-delays+ patched gnuidn+ patched network-protocol-xmpp cd .. installgitannexdeps -fAndroid -f-Pairing } -echo-echo-echo native build-echo-setupcabal-installgitannexdeps+# native cabal needs its own update+cabal update -echo -echo-echo cross build-echo PATH=$HOME/.ghc/$(cat abiversion)/bin:$HOME/.ghc/$(cat abiversion)/arm-linux-androideabi/bin:$PATH setupcabal+cabal update+ install_pkgs
standalone/android/term.patch view
@@ -585,7 +585,7 @@ # Make sure target-11 is installed -$ANDROID update sdk -u -t android-11-+$ANDROID update sdk -u -t android-18++$ANDROID update sdk -u -t android-19 DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )" ATE_ROOT="$( cd $DIR/.. && pwd )"@@ -594,5 +594,5 @@ PROJECT_DIR="$( dirname "$PROJECT_FILE" )" echo "Updating $PROJECT_FILE" - $ANDROID update project -p "$PROJECT_DIR" --target android-11-+ $ANDROID update project -p "$PROJECT_DIR" --target android-18++ $ANDROID update project -p "$PROJECT_DIR" --target android-19 done
standalone/no-th/haskell-patches/DAV_build-without-TH.patch view
@@ -1,19 +1,19 @@-From 8e115228601a97b19d3f713ccf2d13f58838d927 Mon Sep 17 00:00:00 2001+From e54cfacbb9fb24f75d3d93cd8ee6da67b161574f Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com>-Date: Mon, 26 May 2014 01:48:22 +0000-Subject: [PATCH] expand TH+Date: Thu, 16 Oct 2014 02:51:28 +0000+Subject: [PATCH] remove TH ---- DAV.cabal | 24 +---- Network/Protocol/HTTP/DAV.hs | 96 ++++++++++++----- Network/Protocol/HTTP/DAV/TH.hs | 232 ++++++++++++++++++++++++++++++++++++++-- 3 files changed, 307 insertions(+), 45 deletions(-)+ DAV.cabal | 28 +----+ Network/Protocol/HTTP/DAV.hs | 92 +++++++++++++---+ Network/Protocol/HTTP/DAV/TH.hs | 232 +++++++++++++++++++++++++++++++++++++++-+ 3 files changed, 306 insertions(+), 46 deletions(-) diff --git a/DAV.cabal b/DAV.cabal-index 5d50e39..f2abf89 100644+index 95fffd8..5669c51 100644 --- a/DAV.cabal +++ b/DAV.cabal-@@ -43,30 +43,7 @@ library+@@ -47,33 +47,7 @@ library , utf8-string , xml-conduit >= 1.0 && < 1.3 , xml-hamlet >= 0.4 && < 0.5@@ -26,7 +26,7 @@ - , case-insensitive >= 0.4 - , containers - , data-default-- , either >= 4.1+- , either >= 4.3 - , errors - , exceptions - , http-client >= 0.2@@ -34,13 +34,16 @@ - , http-types >= 0.7 - , lens >= 3.0 - , mtl >= 2.1-- , network >= 2.3-- , optparse-applicative >= 0.5.0+- , optparse-applicative >= 0.10.0 - , transformers >= 0.3 - , transformers-base - , utf8-string - , xml-conduit >= 1.0 && < 1.3 - , xml-hamlet >= 0.4 && < 0.5+- if flag(network-uri)+- build-depends: network-uri >= 2.6, network >= 2.6+- else+- build-depends: network >= 2.3 && <2.6 + , text source-repository head@@ -412,3 +415,6 @@ + __userAgent_a3kh) + Data.Functor.<$> (_f_a3k7 __userAgent'_a3kg)) +{-# INLINE userAgent #-}+-- +2.1.1+
+ standalone/no-th/haskell-patches/hamlet_hack_TH.patch view
@@ -0,0 +1,205 @@+From 0509d4383c328c20be61cf3e3bbc98a0a1161588 Mon Sep 17 00:00:00 2001+From: dummy <dummy@example.com>+Date: Thu, 16 Oct 2014 02:21:17 +0000+Subject: [PATCH] hack TH++---+ Text/Hamlet.hs | 86 +++++++++++++++++-----------------------------------+ Text/Hamlet/Parse.hs | 3 +-+ 2 files changed, 29 insertions(+), 60 deletions(-)++diff --git a/Text/Hamlet.hs b/Text/Hamlet.hs+index 9500ecb..ec8471a 100644+--- a/Text/Hamlet.hs++++ b/Text/Hamlet.hs+@@ -11,36 +11,36 @@+ module Text.Hamlet+ ( -- * Plain HTML+ Html+- , shamlet+- , shamletFile+- , xshamlet+- , xshamletFile++ --, shamlet++ --, shamletFile++ --, xshamlet++ --, xshamletFile+ -- * Hamlet+ , HtmlUrl+- , hamlet+- , hamletFile+- , hamletFileReload+- , ihamletFileReload+- , xhamlet+- , xhamletFile++ --, hamlet++ --, hamletFile++ --, hamletFileReload++ --, ihamletFileReload++ --, 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+@@ -110,47 +110,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+ +@@ -158,6 +120,7 @@ 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.+ --+@@ -296,10 +259,12 @@ hamlet = hamletWithSettings hamletRules defaultHamletSettings+ + xhamlet :: QuasiQuoter+ xhamlet = hamletWithSettings hamletRules xhtmlHamletSettings++-}+ + asHtmlUrl :: HtmlUrl url -> HtmlUrl url+ asHtmlUrl = id+ ++{-+ hamletRules :: Q HamletRules+ hamletRules = do+ i <- [|id|]+@@ -360,6 +325,7 @@ hamletFromString :: Q HamletRules -> HamletSettings -> String -> Q Exp+ hamletFromString qhr set s = do+ hr <- qhr+ hrWithEnv hr $ \env -> docsToExp env hr [] $ docFromString set s++-}+ + docFromString :: HamletSettings -> String -> [Doc]+ docFromString set s =+@@ -367,6 +333,7 @@ docFromString set s =+ Error s' -> error s'+ Ok (_, d) -> d+ ++{-+ hamletFileWithSettings :: Q HamletRules -> HamletSettings -> FilePath -> Q Exp+ hamletFileWithSettings qhr set fp = do+ #ifdef GHC_7_4+@@ -408,6 +375,7 @@ strToExp s@(c:_)+ | 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+@@ -452,7 +420,7 @@ hamletUsedIdentifiers settings =+ data HamletRuntimeRules = HamletRuntimeRules {+ hrrI18n :: Bool+ }+-++{-+ hamletFileReloadWithSettings :: HamletRuntimeRules+ -> HamletSettings -> FilePath -> Q Exp+ hamletFileReloadWithSettings hrr settings fp = do+@@ -479,7 +447,7 @@ hamletFileReloadWithSettings hrr settings fp = do+ c VTUrlParam = [|EUrlParam|]+ c VTMixin = [|\r -> EMixin $ \c -> r c|]+ c VTMsg = [|EMsg|]+-++-}+ -- move to Shakespeare.Base?+ readFileUtf8 :: FilePath -> IO String+ readFileUtf8 fp = fmap TL.unpack $ readUtf8File fp+diff --git a/Text/Hamlet/Parse.hs b/Text/Hamlet/Parse.hs+index b7e2954..1f14946 100644+--- a/Text/Hamlet/Parse.hs++++ b/Text/Hamlet/Parse.hs+@@ -616,6 +616,7 @@ data NewlineStyle = NoNewlines -- ^ never add newlines+ | DefaultNewlineStyle+ deriving Show+ ++{-+ instance Lift NewlineStyle where+ lift NoNewlines = [|NoNewlines|]+ lift NewlinesText = [|NewlinesText|]+@@ -627,7 +628,7 @@ instance Lift (String -> CloseStyle) where+ + instance Lift HamletSettings where+ lift (HamletSettings a b c d) = [|HamletSettings $(lift a) $(lift b) $(lift c) $(lift d)|]+-++-}+ + htmlEmptyTags :: Set String+ htmlEmptyTags = Set.fromAscList+-- +2.1.1+
standalone/no-th/haskell-patches/lens_no-TH.patch view
@@ -1,20 +1,20 @@-From bc312c7431877b3b788de5e7ce5ee743be73c0ba Mon Sep 17 00:00:00 2001+From 10c9ade98b3ac2054947f411d77db2eb28896b9f Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com>-Date: Tue, 10 Jun 2014 22:13:58 +0000-Subject: [PATCH] remove TH+Date: Thu, 16 Oct 2014 01:43:10 +0000+Subject: [PATCH] avoid TH ---- lens.cabal | 19 +------------------+ lens.cabal | 17 +---------------- src/Control/Lens.hs | 8 ++------ src/Control/Lens/Cons.hs | 2 -- src/Control/Lens/Internal/Fold.hs | 2 -- src/Control/Lens/Operators.hs | 2 +- src/Control/Lens/Prism.hs | 2 -- src/Control/Monad/Primitive/Lens.hs | 1 -- 7 files changed, 4 insertions(+), 32 deletions(-)+ 7 files changed, 4 insertions(+), 30 deletions(-) diff --git a/lens.cabal b/lens.cabal-index d70c2f4..28af768 100644+index 5388301..d7b02b9 100644 --- a/lens.cabal +++ b/lens.cabal @@ -10,7 +10,7 @@ stability: provisional@@ -26,7 +26,7 @@ -- build-tools: cpphs tested-with: GHC == 7.4.1, GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.1, GHC == 7.8.2 synopsis: Lenses, Folds and Traversals-@@ -220,7 +220,6 @@ library+@@ -217,7 +217,6 @@ library Control.Exception.Lens Control.Lens Control.Lens.Action@@ -34,7 +34,16 @@ Control.Lens.Combinators Control.Lens.Cons Control.Lens.Each-@@ -248,29 +247,24 @@ library+@@ -234,8 +233,6 @@ library+ Control.Lens.Internal.Context+ Control.Lens.Internal.Deque+ Control.Lens.Internal.Exception+- Control.Lens.Internal.FieldTH+- Control.Lens.Internal.PrismTH+ Control.Lens.Internal.Fold+ Control.Lens.Internal.Getter+ Control.Lens.Internal.Indexed+@@ -247,25 +244,21 @@ library Control.Lens.Internal.Reflection Control.Lens.Internal.Review Control.Lens.Internal.Setter@@ -60,11 +69,7 @@ Control.Monad.Primitive.Lens Control.Parallel.Strategies.Lens Control.Seq.Lens-- Data.Aeson.Lens- Data.Array.Lens- Data.Bits.Lens- Data.ByteString.Lens-@@ -293,17 +287,10 @@ library+@@ -291,12 +284,8 @@ library Data.Typeable.Lens Data.Vector.Lens Data.Vector.Generic.Lens@@ -76,13 +81,8 @@ - Language.Haskell.TH.Lens Numeric.Lens -- other-modules:-- Control.Lens.Internal.TupleIxedTH--- cpp-options: -traditional- - if flag(safe)-@@ -405,7 +392,6 @@ test-suite doctests+ other-modules:+@@ -403,7 +392,6 @@ test-suite doctests deepseq, doctest >= 0.9.1, filepath,@@ -90,7 +90,7 @@ mtl, nats, parallel,-@@ -443,7 +429,6 @@ benchmark plated+@@ -441,7 +429,6 @@ benchmark plated comonad, criterion, deepseq,@@ -98,7 +98,7 @@ lens, transformers -@@ -478,7 +463,6 @@ benchmark unsafe+@@ -476,7 +463,6 @@ benchmark unsafe comonads-fd, criterion, deepseq,@@ -106,7 +106,7 @@ lens, transformers -@@ -495,6 +479,5 @@ benchmark zipper+@@ -493,6 +479,5 @@ benchmark zipper comonads-fd, criterion, deepseq,@@ -201,10 +201,10 @@ , ( # ) -- * "Control.Lens.Setter" diff --git a/src/Control/Lens/Prism.hs b/src/Control/Lens/Prism.hs-index 9e0bec7..0cf6737 100644+index b75c870..c6c6596 100644 --- a/src/Control/Lens/Prism.hs +++ b/src/Control/Lens/Prism.hs-@@ -59,8 +59,6 @@ import Unsafe.Coerce+@@ -61,8 +61,6 @@ import Unsafe.Coerce import Data.Profunctor.Unsafe #endif @@ -226,5 +226,5 @@ prim :: (PrimMonad m) => Iso' (m a) (State# (PrimState m) -> (# State# (PrimState m), a #)) prim = iso internal primitive -- -2.0.0+2.1.1
+ standalone/no-th/haskell-patches/optparse-applicative_remove-ANN.patch view
@@ -0,0 +1,33 @@+From b128590966d4946219e45e2efd88acf7a354abc2 Mon Sep 17 00:00:00 2001+From: androidbuilder <androidbuilder@example.com>+Date: Tue, 14 Oct 2014 02:28:02 +0000+Subject: [PATCH] remove ANN++---+ Options/Applicative.hs | 2 --+ Options/Applicative/Help/Core.hs | 2 --+ 2 files changed, 4 deletions(-)++diff --git a/Options/Applicative.hs b/Options/Applicative.hs+index bd4129d..f412062 100644+--- a/Options/Applicative.hs++++ b/Options/Applicative.hs+@@ -34,5 +34,3 @@ import Options.Applicative.Common+ import Options.Applicative.Builder+ import Options.Applicative.Builder.Completer+ import Options.Applicative.Extra+-+-{-# ANN module "HLint: ignore Use import/export shortcut" #-}+diff --git a/Options/Applicative/Help/Core.hs b/Options/Applicative/Help/Core.hs+index 0a79169..3f1ce3f 100644+--- a/Options/Applicative/Help/Core.hs++++ b/Options/Applicative/Help/Core.hs+@@ -139,5 +139,3 @@ parserUsage pprefs p progn = hsep+ [ string "Usage:"+ , string progn+ , align (extractChunk (briefDesc pprefs p)) ]+-+-{-# ANN footerHelp "HLint: ignore Eta reduce" #-}+-- +1.7.10.4+
standalone/no-th/haskell-patches/persistent-template_stub-out.patch view
@@ -1,25 +1,25 @@-From 4b958f97bffdeedc0c946d5fdc9749d2cc566fcc Mon Sep 17 00:00:00 2001+From e6542197f1da6984bb6cd3310dba77363dfab2d9 Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com>-Date: Thu, 26 Dec 2013 15:54:37 -0400+Date: Thu, 16 Oct 2014 01:51:02 +0000 Subject: [PATCH] stub out ---- persistent-template.cabal | 2 +-+ persistent-template.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/persistent-template.cabal b/persistent-template.cabal-index c4aee68..7905278 100644+index 59b4149..e11b418 100644 --- a/persistent-template.cabal +++ b/persistent-template.cabal-@@ -24,7 +24,7 @@ library+@@ -26,7 +26,7 @@ library , aeson , monad-logger , unordered-containers - exposed-modules: Database.Persist.TH-+ exposed-modules:++ exposed-modules: ghc-options: -Wall if impl(ghc >= 7.4) cpp-options: -DGHC_7_4 -- -1.7.10.4+2.1.1
standalone/no-th/haskell-patches/persistent_1.1.5.1_0001-disable-TH.patch view
@@ -1,14 +1,14 @@-From efd18199fa245e51e6137036062ded8b0b26f78c Mon Sep 17 00:00:00 2001+From aae3ace106cf26c931cc94c96fb6fbfe83f950f2 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+Date: Wed, 15 Oct 2014 17:05:37 +0000+Subject: [PATCH] avoid 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+index 3ac2ca9..bcc2011 100644 --- a/Database/Persist/Sql/Raw.hs +++ b/Database/Persist/Sql/Raw.hs @@ -11,7 +11,7 @@ import Data.IORef (writeIORef, readIORef, newIORef)@@ -20,7 +20,7 @@ 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)+@@ -23,7 +23,6 @@ rawQuery :: (MonadSqlPersist m, MonadResource m) -> [PersistValue] -> Source m [PersistValue] rawQuery sql vals = do@@ -28,7 +28,7 @@ conn <- lift askSqlConn bracketP (getStmtConn conn sql)-@@ -34,7 +33,6 @@ rawExecute x y = liftM (const ()) $ rawExecuteCount x y+@@ -35,7 +34,6 @@ rawExecute x y = liftM (const ()) $ rawExecuteCount x y rawExecuteCount :: MonadSqlPersist m => Text -> [PersistValue] -> m Int64 rawExecuteCount sql vals = do@@ -37,5 +37,5 @@ res <- liftIO $ stmtExecute stmt vals liftIO $ stmtReset stmt -- -1.8.5.1+2.1.1
standalone/no-th/haskell-patches/process-conduit_avoid-TH.patch view
@@ -1,24 +1,24 @@-From 7e85a025349877565a70c375ef55508f215eaaf8 Mon Sep 17 00:00:00 2001+From ed77588c57704030a9d412dd49f11c172c6268ab Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com>-Date: Wed, 21 May 2014 04:23:49 +0000-Subject: [PATCH] remove TH+Date: Tue, 14 Oct 2014 03:46:03 +0000+Subject: [PATCH] unused ---- process-conduit.cabal | 1 -+ process-conduit.cabal | 1 - 1 file changed, 1 deletion(-) diff --git a/process-conduit.cabal b/process-conduit.cabal-index e6988e0..a2e03e0 100644+index 34bb168..2f137a8 100644 --- a/process-conduit.cabal +++ b/process-conduit.cabal-@@ -24,7 +24,6 @@ source-repository head+@@ -22,7 +22,6 @@ source-repository head library- exposed-modules: Data.Conduit.Process+ exposed-modules: Data.Conduit.ProcessOld - System.Process.QQ build-depends: base == 4.* , template-haskell >= 2.4 -- -2.0.0.rc2+1.7.10.4
+ standalone/no-th/haskell-patches/shakespeare-css_remove_TH.patch view
@@ -0,0 +1,366 @@+From 657fa7135bbcf3d5adb3cc0032e09887dd80a2a7 Mon Sep 17 00:00:00 2001+From: dummy <dummy@example.com>+Date: Thu, 16 Oct 2014 02:05:14 +0000+Subject: [PATCH] hack TH++---+ Text/Cassius.hs | 23 --------+ Text/Css.hs | 151 --------------------------------------------------+ Text/CssCommon.hs | 4 --+ Text/Lucius.hs | 46 +--------------+ shakespeare-css.cabal | 2 +-+ 5 files changed, 3 insertions(+), 223 deletions(-)++diff --git a/Text/Cassius.hs b/Text/Cassius.hs+index 91fc90f..c515807 100644+--- a/Text/Cassius.hs++++ b/Text/Cassius.hs+@@ -13,10 +13,6 @@ module Text.Cassius+ , renderCss+ , renderCssUrl+ -- * Parsing+- , cassius+- , cassiusFile+- , cassiusFileDebug+- , cassiusFileReload+ -- * ToCss instances+ -- ** Color+ , Color (..)+@@ -27,11 +23,8 @@ module Text.Cassius+ , AbsoluteUnit (..)+ , AbsoluteSize (..)+ , absoluteSize+- , EmSize (..)+- , ExSize (..)+ , PercentageSize (..)+ , percentageSize+- , PixelSize (..)+ -- * Internal+ , cassiusUsedIdentifiers+ ) where+@@ -43,25 +36,9 @@ import Language.Haskell.TH.Quote (QuasiQuoter (..))+ import Language.Haskell.TH.Syntax+ import qualified Data.Text.Lazy as TL+ import Text.CssCommon+-import Text.Lucius (lucius)+ import qualified Text.Lucius+ import Text.IndentToBrace (i2b)+ +-cassius :: QuasiQuoter+-cassius = QuasiQuoter { quoteExp = quoteExp lucius . i2b }+-+-cassiusFile :: FilePath -> Q Exp+-cassiusFile fp = do+-#ifdef GHC_7_4+- qAddDependentFile fp+-#endif+- contents <- fmap TL.unpack $ qRunIO $ readUtf8File fp+- quoteExp cassius contents+-+-cassiusFileDebug, cassiusFileReload :: FilePath -> Q Exp+-cassiusFileDebug = cssFileDebug True [|Text.Lucius.parseTopLevels|] Text.Lucius.parseTopLevels+-cassiusFileReload = cassiusFileDebug+-+ -- | Determine which identifiers are used by the given template, useful for+ -- creating systems like yesod devel.+ cassiusUsedIdentifiers :: String -> [(Deref, VarType)]+diff --git a/Text/Css.hs b/Text/Css.hs+index 75dc549..20c206c 100644+--- a/Text/Css.hs++++ b/Text/Css.hs+@@ -166,22 +166,6 @@ cssUsedIdentifiers toi2b parseBlocks s' =+ (scope, rest') = go rest+ go' (Attr k v) = k ++ v+ +-cssFileDebug :: Bool -- ^ perform the indent-to-brace conversion+- -> Q Exp+- -> Parser [TopLevel Unresolved]+- -> FilePath+- -> Q Exp+-cssFileDebug toi2b parseBlocks' parseBlocks fp = do+- s <- fmap TL.unpack $ qRunIO $ readUtf8File fp+-#ifdef GHC_7_4+- qAddDependentFile fp+-#endif+- let vs = cssUsedIdentifiers toi2b parseBlocks s+- c <- mapM vtToExp vs+- cr <- [|cssRuntime toi2b|]+- parseBlocks'' <- parseBlocks'+- return $ cr `AppE` parseBlocks'' `AppE` (LitE $ StringL fp) `AppE` ListE c+-+ combineSelectors :: HasLeadingSpace+ -> [Contents]+ -> [Contents]+@@ -287,18 +271,6 @@ cssRuntime toi2b parseBlocks fp cd render' = unsafePerformIO $ do+ + addScope scope = map (DerefIdent . Ident *** CDPlain . fromString) scope ++ cd+ +-vtToExp :: (Deref, VarType) -> Q Exp+-vtToExp (d, vt) = do+- d' <- lift d+- c' <- c vt+- return $ TupE [d', c' `AppE` derefToExp [] d]+- where+- c :: VarType -> Q Exp+- c VTPlain = [|CDPlain . toCss|]+- c VTUrl = [|CDUrl|]+- c VTUrlParam = [|CDUrlParam|]+- c VTMixin = [|CDMixin|]+-+ getVars :: Monad m => [(String, String)] -> Content -> m [(Deref, VarType)]+ getVars _ ContentRaw{} = return []+ getVars scope (ContentVar d) =+@@ -342,111 +314,8 @@ compressBlock (Block x y blocks mixins) =+ cc (ContentRaw a:ContentRaw b:c) = cc $ ContentRaw (a ++ b) : c+ cc (a:b) = a : cc b+ +-blockToMixin :: Name+- -> Scope+- -> Block Unresolved+- -> Q Exp+-blockToMixin r scope (Block _sel props subblocks mixins) =+- [|Mixin+- { mixinAttrs = concat+- $ $(listE $ map go props)+- : map mixinAttrs $mixinsE+- -- FIXME too many complications to implement sublocks for now...+- , mixinBlocks = [] -- foldr (.) id $(listE $ map subGo subblocks) []+- }|]+- {-+- . foldr (.) id $(listE $ map subGo subblocks)+- . (concatMap mixinBlocks $mixinsE ++)+- |]+- -}+- where+- mixinsE = return $ ListE $ map (derefToExp []) mixins+- go (Attr x y) = conE 'Attr+- `appE` (contentsToBuilder r scope x)+- `appE` (contentsToBuilder r scope y)+- subGo (Block sel' b c d) = blockToCss r scope $ Block sel' b c d+-+-blockToCss :: Name+- -> Scope+- -> Block Unresolved+- -> Q Exp+-blockToCss r scope (Block sel props subblocks mixins) =+- [|((Block+- { blockSelector = $(selectorToBuilder r scope sel)+- , blockAttrs = concat+- $ $(listE $ map go props)+- : map mixinAttrs $mixinsE+- , blockBlocks = ()+- , blockMixins = ()+- } :: Block Resolved):)+- . foldr (.) id $(listE $ map subGo subblocks)+- . (concatMap mixinBlocks $mixinsE ++)+- |]+- where+- mixinsE = return $ ListE $ map (derefToExp []) mixins+- go (Attr x y) = conE 'Attr+- `appE` (contentsToBuilder r scope x)+- `appE` (contentsToBuilder r scope y)+- subGo (hls, Block sel' b c d) =+- blockToCss r scope $ Block sel'' b c d+- where+- sel'' = combineSelectors hls sel sel'+-+-selectorToBuilder :: Name -> Scope -> [Contents] -> Q Exp+-selectorToBuilder r scope sels =+- contentsToBuilder r scope $ intercalate [ContentRaw ","] sels+-+-contentsToBuilder :: Name -> Scope -> [Content] -> Q Exp+-contentsToBuilder r scope contents =+- appE [|mconcat|] $ listE $ map (contentToBuilder r scope) contents+-+-contentToBuilder :: Name -> Scope -> Content -> Q Exp+-contentToBuilder _ _ (ContentRaw x) =+- [|fromText . pack|] `appE` litE (StringL x)+-contentToBuilder _ scope (ContentVar d) =+- case d of+- DerefIdent (Ident s)+- | Just val <- lookup s scope -> [|fromText . pack|] `appE` litE (StringL val)+- _ -> [|toCss|] `appE` return (derefToExp [] d)+-contentToBuilder r _ (ContentUrl u) =+- [|fromText|] `appE`+- (varE r `appE` return (derefToExp [] u) `appE` listE [])+-contentToBuilder r _ (ContentUrlParam u) =+- [|fromText|] `appE`+- ([|uncurry|] `appE` varE r `appE` return (derefToExp [] u))+-contentToBuilder _ _ ContentMixin{} = error "contentToBuilder on ContentMixin"+-+ type Scope = [(String, String)]+ +-topLevelsToCassius :: [TopLevel Unresolved]+- -> Q Exp+-topLevelsToCassius a = do+- r <- newName "_render"+- lamE [varP r] $ appE [|CssNoWhitespace . foldr ($) []|] $ fmap ListE $ go r [] a+- where+- go _ _ [] = return []+- go r scope (TopBlock b:rest) = do+- e <- [|(++) $ map TopBlock ($(blockToCss r scope b) [])|]+- es <- go r scope rest+- return $ e : es+- go r scope (TopAtBlock name s b:rest) = do+- let s' = contentsToBuilder r scope s+- e <- [|(:) $ TopAtBlock $(lift name) $(s') $(blocksToCassius r scope b)|]+- es <- go r scope rest+- return $ e : es+- go r scope (TopAtDecl dec cs:rest) = do+- e <- [|(:) $ TopAtDecl $(lift dec) $(contentsToBuilder r scope cs)|]+- es <- go r scope rest+- return $ e : es+- go r scope (TopVar k v:rest) = go r ((k, v) : scope) rest+-+-blocksToCassius :: Name+- -> Scope+- -> [Block Unresolved]+- -> Q Exp+-blocksToCassius r scope a = do+- appE [|foldr ($) []|] $ listE $ map (blockToCss r scope) a+-+ renderCss :: Css -> TL.Text+ renderCss css =+ toLazyText $ mconcat $ map go tops+@@ -515,23 +384,3 @@ renderBlock haveWhiteSpace indent (Block sel attrs () ())+ | haveWhiteSpace = fromString ";\n"+ | otherwise = singleton ';'+ +-instance Lift Mixin where+- lift (Mixin a b) = [|Mixin a b|]+-instance Lift (Attr Unresolved) where+- lift (Attr k v) = [|Attr k v :: Attr Unresolved |]+-instance Lift (Attr Resolved) where+- lift (Attr k v) = [|Attr $(liftBuilder k) $(liftBuilder v) :: Attr Resolved |]+-+-liftBuilder :: Builder -> Q Exp+-liftBuilder b = [|fromText $ pack $(lift $ TL.unpack $ toLazyText b)|]+-+-instance Lift Content where+- lift (ContentRaw s) = [|ContentRaw s|]+- lift (ContentVar d) = [|ContentVar d|]+- lift (ContentUrl d) = [|ContentUrl d|]+- lift (ContentUrlParam d) = [|ContentUrlParam d|]+- lift (ContentMixin m) = [|ContentMixin m|]+-instance Lift (Block Unresolved) where+- lift (Block a b c d) = [|Block a b c d|]+-instance Lift (Block Resolved) where+- lift (Block a b () ()) = [|Block $(liftBuilder a) b () ()|]+diff --git a/Text/CssCommon.hs b/Text/CssCommon.hs+index 719e0a8..8c40e8c 100644+--- a/Text/CssCommon.hs++++ b/Text/CssCommon.hs+@@ -1,4 +1,3 @@+-{-# LANGUAGE TemplateHaskell #-}+ {-# LANGUAGE GeneralizedNewtypeDeriving #-}+ {-# LANGUAGE FlexibleInstances #-}+ {-# LANGUAGE CPP #-}+@@ -156,6 +155,3 @@ showSize :: Rational -> String -> String+ showSize value' unit = printf "%f" value ++ unit+ where value = fromRational value' :: Double+ +-mkSizeType "EmSize" "em"+-mkSizeType "ExSize" "ex"+-mkSizeType "PixelSize" "px"+diff --git a/Text/Lucius.hs b/Text/Lucius.hs+index 346883d..f38492b 100644+--- a/Text/Lucius.hs++++ b/Text/Lucius.hs+@@ -8,13 +8,9 @@+ {-# OPTIONS_GHC -fno-warn-missing-fields #-}+ module Text.Lucius+ ( -- * Parsing+- lucius+- , luciusFile+- , luciusFileDebug+- , luciusFileReload+ -- ** Mixins+- , luciusMixin+- , Mixin++ -- luciusMixin++ Mixin+ -- ** Runtime+ , luciusRT+ , luciusRT'+@@ -40,11 +36,8 @@ module Text.Lucius+ , AbsoluteUnit (..)+ , AbsoluteSize (..)+ , absoluteSize+- , EmSize (..)+- , ExSize (..)+ , PercentageSize (..)+ , percentageSize+- , PixelSize (..)+ -- * Internal+ , parseTopLevels+ , luciusUsedIdentifiers+@@ -67,18 +60,6 @@ import Data.List (isSuffixOf)+ import Control.Arrow (second)+ import Text.Shakespeare (VarType)+ +--- |+---+--- >>> renderCss ([lucius|foo{bar:baz}|] undefined)+--- "foo{bar:baz}"+-lucius :: QuasiQuoter+-lucius = QuasiQuoter { quoteExp = luciusFromString }+-+-luciusFromString :: String -> Q Exp+-luciusFromString s =+- topLevelsToCassius+- $ either (error . show) id $ parse parseTopLevels s s+-+ whiteSpace :: Parser ()+ whiteSpace = many whiteSpace1 >> return ()+ +@@ -218,17 +199,6 @@ parseComment = do+ _ <- manyTill anyChar $ try $ string "*/"+ return $ ContentRaw ""+ +-luciusFile :: FilePath -> Q Exp+-luciusFile fp = do+-#ifdef GHC_7_4+- qAddDependentFile fp+-#endif+- contents <- fmap TL.unpack $ qRunIO $ readUtf8File fp+- luciusFromString contents+-+-luciusFileDebug, luciusFileReload :: FilePath -> Q Exp+-luciusFileDebug = cssFileDebug False [|parseTopLevels|] parseTopLevels+-luciusFileReload = luciusFileDebug+ + parseTopLevels :: Parser [TopLevel Unresolved]+ parseTopLevels =+@@ -377,15 +347,3 @@ luciusRTMinified tl scope = either Left (Right . renderCss . CssNoWhitespace) $+ -- creating systems like yesod devel.+ luciusUsedIdentifiers :: String -> [(Deref, VarType)]+ luciusUsedIdentifiers = cssUsedIdentifiers False parseTopLevels+-+-luciusMixin :: QuasiQuoter+-luciusMixin = QuasiQuoter { quoteExp = luciusMixinFromString }+-+-luciusMixinFromString :: String -> Q Exp+-luciusMixinFromString s' = do+- r <- newName "_render"+- case fmap compressBlock $ parse parseBlock s s of+- Left e -> error $ show e+- Right block -> blockToMixin r [] block+- where+- s = concat ["mixin{", s', "}"]+diff --git a/shakespeare-css.cabal b/shakespeare-css.cabal+index 2d3b25a..cc0553c 100644+--- a/shakespeare-css.cabal++++ b/shakespeare-css.cabal+@@ -35,8 +35,8 @@ library+ + exposed-modules: Text.Cassius+ Text.Lucius+- other-modules: Text.MkSizeType+ Text.Css++ other-modules: Text.MkSizeType+ Text.IndentToBrace+ Text.CssCommon+ ghc-options: -Wall+-- +2.1.1+
+ standalone/no-th/haskell-patches/shakespeare-js_hack_TH.patch view
@@ -0,0 +1,316 @@+From 26f7328b0123d3ffa66873b91189ba3bdae3356c Mon Sep 17 00:00:00 2001+From: dummy <dummy@example.com>+Date: Thu, 16 Oct 2014 02:07:32 +0000+Subject: [PATCH] hack 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 6e5e246..9ab0dbc 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+-- +2.1.1+
standalone/no-th/haskell-patches/shakespeare_remove-TH.patch view
@@ -1,1314 +1,181 @@-From 6de4e75bfbfccb8aedcbf3ee75e5d544f1eeeca5 Mon Sep 17 00:00:00 2001-From: dummy <dummy@example.com>-Date: Thu, 3 Jul 2014 21:48:14 +0000-Subject: [PATCH] remove TH------ Text/Cassius.hs | 23 ------- Text/Coffee.hs | 56 ++-------------- Text/Css.hs | 151 ---------------------------------------- Text/CssCommon.hs | 4 --- Text/Hamlet.hs | 86 +++++++---------------- Text/Hamlet/Parse.hs | 3 +-- Text/Julius.hs | 67 +++--------------- Text/Lucius.hs | 46 +------------ Text/Roy.hs | 51 ++------------ Text/Shakespeare.hs | 70 +++---------------- Text/Shakespeare/Base.hs | 28 --------- Text/Shakespeare/I18N.hs | 178 ++--------------------------------------------- Text/Shakespeare/Text.hs | 125 +++------------------------------ shakespeare.cabal | 3 +-- 14 files changed, 78 insertions(+), 813 deletions(-)--diff --git a/Text/Cassius.hs b/Text/Cassius.hs-index 91fc90f..c515807 100644---- a/Text/Cassius.hs-+++ b/Text/Cassius.hs-@@ -13,10 +13,6 @@ module Text.Cassius- , renderCss- , renderCssUrl- -- * Parsing-- , cassius-- , cassiusFile-- , cassiusFileDebug-- , cassiusFileReload- -- * ToCss instances- -- ** Color- , Color (..)-@@ -27,11 +23,8 @@ module Text.Cassius- , AbsoluteUnit (..)- , AbsoluteSize (..)- , absoluteSize-- , EmSize (..)-- , ExSize (..)- , PercentageSize (..)- , percentageSize-- , PixelSize (..)- -- * Internal- , cassiusUsedIdentifiers- ) where-@@ -43,25 +36,9 @@ import Language.Haskell.TH.Quote (QuasiQuoter (..))- import Language.Haskell.TH.Syntax- import qualified Data.Text.Lazy as TL- import Text.CssCommon--import Text.Lucius (lucius)- import qualified Text.Lucius- import Text.IndentToBrace (i2b)- --cassius :: QuasiQuoter--cassius = QuasiQuoter { quoteExp = quoteExp lucius . i2b }----cassiusFile :: FilePath -> Q Exp--cassiusFile fp = do--#ifdef GHC_7_4-- qAddDependentFile fp--#endif-- contents <- fmap TL.unpack $ qRunIO $ readUtf8File fp-- quoteExp cassius contents----cassiusFileDebug, cassiusFileReload :: FilePath -> Q Exp--cassiusFileDebug = cssFileDebug True [|Text.Lucius.parseTopLevels|] Text.Lucius.parseTopLevels--cassiusFileReload = cassiusFileDebug--- -- | Determine which identifiers are used by the given template, useful for- -- creating systems like yesod devel.- cassiusUsedIdentifiers :: String -> [(Deref, VarType)]-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/Css.hs b/Text/Css.hs-index 75dc549..20c206c 100644---- a/Text/Css.hs-+++ b/Text/Css.hs-@@ -166,22 +166,6 @@ cssUsedIdentifiers toi2b parseBlocks s' =- (scope, rest') = go rest- go' (Attr k v) = k ++ v- --cssFileDebug :: Bool -- ^ perform the indent-to-brace conversion-- -> Q Exp-- -> Parser [TopLevel Unresolved]-- -> FilePath-- -> Q Exp--cssFileDebug toi2b parseBlocks' parseBlocks fp = do-- s <- fmap TL.unpack $ qRunIO $ readUtf8File fp--#ifdef GHC_7_4-- qAddDependentFile fp--#endif-- let vs = cssUsedIdentifiers toi2b parseBlocks s-- c <- mapM vtToExp vs-- cr <- [|cssRuntime toi2b|]-- parseBlocks'' <- parseBlocks'-- return $ cr `AppE` parseBlocks'' `AppE` (LitE $ StringL fp) `AppE` ListE c--- combineSelectors :: HasLeadingSpace- -> [Contents]- -> [Contents]-@@ -287,18 +271,6 @@ cssRuntime toi2b parseBlocks fp cd render' = unsafePerformIO $ do- - addScope scope = map (DerefIdent . Ident *** CDPlain . fromString) scope ++ cd- --vtToExp :: (Deref, VarType) -> Q Exp--vtToExp (d, vt) = do-- d' <- lift d-- c' <- c vt-- return $ TupE [d', c' `AppE` derefToExp [] d]-- where-- c :: VarType -> Q Exp-- c VTPlain = [|CDPlain . toCss|]-- c VTUrl = [|CDUrl|]-- c VTUrlParam = [|CDUrlParam|]-- c VTMixin = [|CDMixin|]--- getVars :: Monad m => [(String, String)] -> Content -> m [(Deref, VarType)]- getVars _ ContentRaw{} = return []- getVars scope (ContentVar d) =-@@ -342,111 +314,8 @@ compressBlock (Block x y blocks mixins) =- cc (ContentRaw a:ContentRaw b:c) = cc $ ContentRaw (a ++ b) : c- cc (a:b) = a : cc b- --blockToMixin :: Name-- -> Scope-- -> Block Unresolved-- -> Q Exp--blockToMixin r scope (Block _sel props subblocks mixins) =-- [|Mixin-- { mixinAttrs = concat-- $ $(listE $ map go props)-- : map mixinAttrs $mixinsE-- -- FIXME too many complications to implement sublocks for now...-- , mixinBlocks = [] -- foldr (.) id $(listE $ map subGo subblocks) []-- }|]-- {--- . foldr (.) id $(listE $ map subGo subblocks)-- . (concatMap mixinBlocks $mixinsE ++)-- |]-- -}-- where-- mixinsE = return $ ListE $ map (derefToExp []) mixins-- go (Attr x y) = conE 'Attr-- `appE` (contentsToBuilder r scope x)-- `appE` (contentsToBuilder r scope y)-- subGo (Block sel' b c d) = blockToCss r scope $ Block sel' b c d----blockToCss :: Name-- -> Scope-- -> Block Unresolved-- -> Q Exp--blockToCss r scope (Block sel props subblocks mixins) =-- [|((Block-- { blockSelector = $(selectorToBuilder r scope sel)-- , blockAttrs = concat-- $ $(listE $ map go props)-- : map mixinAttrs $mixinsE-- , blockBlocks = ()-- , blockMixins = ()-- } :: Block Resolved):)-- . foldr (.) id $(listE $ map subGo subblocks)-- . (concatMap mixinBlocks $mixinsE ++)-- |]-- where-- mixinsE = return $ ListE $ map (derefToExp []) mixins-- go (Attr x y) = conE 'Attr-- `appE` (contentsToBuilder r scope x)-- `appE` (contentsToBuilder r scope y)-- subGo (hls, Block sel' b c d) =-- blockToCss r scope $ Block sel'' b c d-- where-- sel'' = combineSelectors hls sel sel'----selectorToBuilder :: Name -> Scope -> [Contents] -> Q Exp--selectorToBuilder r scope sels =-- contentsToBuilder r scope $ intercalate [ContentRaw ","] sels----contentsToBuilder :: Name -> Scope -> [Content] -> Q Exp--contentsToBuilder r scope contents =-- appE [|mconcat|] $ listE $ map (contentToBuilder r scope) contents----contentToBuilder :: Name -> Scope -> Content -> Q Exp--contentToBuilder _ _ (ContentRaw x) =-- [|fromText . pack|] `appE` litE (StringL x)--contentToBuilder _ scope (ContentVar d) =-- case d of-- DerefIdent (Ident s)-- | Just val <- lookup s scope -> [|fromText . pack|] `appE` litE (StringL val)-- _ -> [|toCss|] `appE` return (derefToExp [] d)--contentToBuilder r _ (ContentUrl u) =-- [|fromText|] `appE`-- (varE r `appE` return (derefToExp [] u) `appE` listE [])--contentToBuilder r _ (ContentUrlParam u) =-- [|fromText|] `appE`-- ([|uncurry|] `appE` varE r `appE` return (derefToExp [] u))--contentToBuilder _ _ ContentMixin{} = error "contentToBuilder on ContentMixin"--- type Scope = [(String, String)]- --topLevelsToCassius :: [TopLevel Unresolved]-- -> Q Exp--topLevelsToCassius a = do-- r <- newName "_render"-- lamE [varP r] $ appE [|CssNoWhitespace . foldr ($) []|] $ fmap ListE $ go r [] a-- where-- go _ _ [] = return []-- go r scope (TopBlock b:rest) = do-- e <- [|(++) $ map TopBlock ($(blockToCss r scope b) [])|]-- es <- go r scope rest-- return $ e : es-- go r scope (TopAtBlock name s b:rest) = do-- let s' = contentsToBuilder r scope s-- e <- [|(:) $ TopAtBlock $(lift name) $(s') $(blocksToCassius r scope b)|]-- es <- go r scope rest-- return $ e : es-- go r scope (TopAtDecl dec cs:rest) = do-- e <- [|(:) $ TopAtDecl $(lift dec) $(contentsToBuilder r scope cs)|]-- es <- go r scope rest-- return $ e : es-- go r scope (TopVar k v:rest) = go r ((k, v) : scope) rest----blocksToCassius :: Name-- -> Scope-- -> [Block Unresolved]-- -> Q Exp--blocksToCassius r scope a = do-- appE [|foldr ($) []|] $ listE $ map (blockToCss r scope) a--- renderCss :: Css -> TL.Text- renderCss css =- toLazyText $ mconcat $ map go tops-@@ -515,23 +384,3 @@ renderBlock haveWhiteSpace indent (Block sel attrs () ())- | haveWhiteSpace = fromString ";\n"- | otherwise = singleton ';'- --instance Lift Mixin where-- lift (Mixin a b) = [|Mixin a b|]--instance Lift (Attr Unresolved) where-- lift (Attr k v) = [|Attr k v :: Attr Unresolved |]--instance Lift (Attr Resolved) where-- lift (Attr k v) = [|Attr $(liftBuilder k) $(liftBuilder v) :: Attr Resolved |]----liftBuilder :: Builder -> Q Exp--liftBuilder b = [|fromText $ pack $(lift $ TL.unpack $ toLazyText b)|]----instance Lift Content where-- lift (ContentRaw s) = [|ContentRaw s|]-- lift (ContentVar d) = [|ContentVar d|]-- lift (ContentUrl d) = [|ContentUrl d|]-- lift (ContentUrlParam d) = [|ContentUrlParam d|]-- lift (ContentMixin m) = [|ContentMixin m|]--instance Lift (Block Unresolved) where-- lift (Block a b c d) = [|Block a b c d|]--instance Lift (Block Resolved) where-- lift (Block a b () ()) = [|Block $(liftBuilder a) b () ()|]-diff --git a/Text/CssCommon.hs b/Text/CssCommon.hs-index 719e0a8..8c40e8c 100644---- a/Text/CssCommon.hs-+++ b/Text/CssCommon.hs-@@ -1,4 +1,3 @@--{-# LANGUAGE TemplateHaskell #-}- {-# LANGUAGE GeneralizedNewtypeDeriving #-}- {-# LANGUAGE FlexibleInstances #-}- {-# LANGUAGE CPP #-}-@@ -156,6 +155,3 @@ showSize :: Rational -> String -> String- showSize value' unit = printf "%f" value ++ unit- where value = fromRational value' :: Double- --mkSizeType "EmSize" "em"--mkSizeType "ExSize" "ex"--mkSizeType "PixelSize" "px"-diff --git a/Text/Hamlet.hs b/Text/Hamlet.hs-index 39c1528..6321cd3 100644---- a/Text/Hamlet.hs-+++ b/Text/Hamlet.hs-@@ -11,36 +11,36 @@- module Text.Hamlet- ( -- * Plain HTML- Html-- , shamlet-- , shamletFile-- , xshamlet-- , xshamletFile-+ --, shamlet-+ --, shamletFile-+ --, xshamlet-+ --, xshamletFile- -- * Hamlet- , HtmlUrl-- , hamlet-- , hamletFile-- , hamletFileReload-- , ihamletFileReload-- , xhamlet-- , xhamletFile-+ --, hamlet-+ --, hamletFile-+ --, hamletFileReload-+ --, ihamletFileReload-+ --, 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-@@ -110,47 +110,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- -@@ -158,6 +120,7 @@ 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.- ---@@ -296,10 +259,12 @@ hamlet = hamletWithSettings hamletRules defaultHamletSettings- - xhamlet :: QuasiQuoter- xhamlet = hamletWithSettings hamletRules xhtmlHamletSettings-+-}- - asHtmlUrl :: HtmlUrl url -> HtmlUrl url- asHtmlUrl = id- -+{-- hamletRules :: Q HamletRules- hamletRules = do- i <- [|id|]-@@ -360,6 +325,7 @@ hamletFromString :: Q HamletRules -> HamletSettings -> String -> Q Exp- hamletFromString qhr set s = do- hr <- qhr- hrWithEnv hr $ \env -> docsToExp env hr [] $ docFromString set s-+-}- - docFromString :: HamletSettings -> String -> [Doc]- docFromString set s =-@@ -367,6 +333,7 @@ docFromString set s =- Error s' -> error s'- Ok (_, d) -> d- -+{-- hamletFileWithSettings :: Q HamletRules -> HamletSettings -> FilePath -> Q Exp- hamletFileWithSettings qhr set fp = do- #ifdef GHC_7_4-@@ -408,6 +375,7 @@ strToExp s@(c:_)- | 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-@@ -460,7 +428,7 @@ hamletUsedIdentifiers settings =- data HamletRuntimeRules = HamletRuntimeRules {- hrrI18n :: Bool- }---+{-- hamletFileReloadWithSettings :: HamletRuntimeRules- -> HamletSettings -> FilePath -> Q Exp- hamletFileReloadWithSettings hrr settings fp = do-@@ -487,7 +455,7 @@ hamletFileReloadWithSettings hrr settings fp = do- c VTUrlParam = [|EUrlParam|]- c VTMixin = [|\r -> EMixin $ \c -> r c|]- c VTMsg = [|EMsg|]---+-}- -- move to Shakespeare.Base?- readFileUtf8 :: FilePath -> IO String- readFileUtf8 fp = fmap TL.unpack $ readUtf8File fp-diff --git a/Text/Hamlet/Parse.hs b/Text/Hamlet/Parse.hs-index b7e2954..1f14946 100644---- a/Text/Hamlet/Parse.hs-+++ b/Text/Hamlet/Parse.hs-@@ -616,6 +616,7 @@ data NewlineStyle = NoNewlines -- ^ never add newlines- | DefaultNewlineStyle- deriving Show- -+{-- instance Lift NewlineStyle where- lift NoNewlines = [|NoNewlines|]- lift NewlinesText = [|NewlinesText|]-@@ -627,7 +628,7 @@ instance Lift (String -> CloseStyle) where- - instance Lift HamletSettings where- lift (HamletSettings a b c d) = [|HamletSettings $(lift a) $(lift b) $(lift c) $(lift d)|]---+-}- - htmlEmptyTags :: Set String- htmlEmptyTags = Set.fromAscList-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/Lucius.hs b/Text/Lucius.hs-index 346883d..f38492b 100644---- a/Text/Lucius.hs-+++ b/Text/Lucius.hs-@@ -8,13 +8,9 @@- {-# OPTIONS_GHC -fno-warn-missing-fields #-}- module Text.Lucius- ( -- * Parsing-- lucius-- , luciusFile-- , luciusFileDebug-- , luciusFileReload- -- ** Mixins-- , luciusMixin-- , Mixin-+ -- luciusMixin-+ Mixin- -- ** Runtime- , luciusRT- , luciusRT'-@@ -40,11 +36,8 @@ module Text.Lucius- , AbsoluteUnit (..)- , AbsoluteSize (..)- , absoluteSize-- , EmSize (..)-- , ExSize (..)- , PercentageSize (..)- , percentageSize-- , PixelSize (..)- -- * Internal- , parseTopLevels- , luciusUsedIdentifiers-@@ -67,18 +60,6 @@ import Data.List (isSuffixOf)- import Control.Arrow (second)- import Text.Shakespeare (VarType)- ---- |-------- >>> renderCss ([lucius|foo{bar:baz}|] undefined)---- "foo{bar:baz}"--lucius :: QuasiQuoter--lucius = QuasiQuoter { quoteExp = luciusFromString }----luciusFromString :: String -> Q Exp--luciusFromString s =-- topLevelsToCassius-- $ either (error . show) id $ parse parseTopLevels s s--- whiteSpace :: Parser ()- whiteSpace = many whiteSpace1 >> return ()- -@@ -218,17 +199,6 @@ parseComment = do- _ <- manyTill anyChar $ try $ string "*/"- return $ ContentRaw ""- --luciusFile :: FilePath -> Q Exp--luciusFile fp = do--#ifdef GHC_7_4-- qAddDependentFile fp--#endif-- contents <- fmap TL.unpack $ qRunIO $ readUtf8File fp-- luciusFromString contents----luciusFileDebug, luciusFileReload :: FilePath -> Q Exp--luciusFileDebug = cssFileDebug False [|parseTopLevels|] parseTopLevels--luciusFileReload = luciusFileDebug- - parseTopLevels :: Parser [TopLevel Unresolved]- parseTopLevels =-@@ -377,15 +347,3 @@ luciusRTMinified tl scope = either Left (Right . renderCss . CssNoWhitespace) $- -- creating systems like yesod devel.- luciusUsedIdentifiers :: String -> [(Deref, VarType)]- luciusUsedIdentifiers = cssUsedIdentifiers False parseTopLevels----luciusMixin :: QuasiQuoter--luciusMixin = QuasiQuoter { quoteExp = luciusMixinFromString }----luciusMixinFromString :: String -> Q Exp--luciusMixinFromString s' = do-- r <- newName "_render"-- case fmap compressBlock $ parse parseBlock s s of-- Left e -> error $ show e-- Right block -> blockToMixin r [] block-- where-- s = concat ["mixin{", s', "}"]-diff --git a/Text/Roy.hs b/Text/Roy.hs-index 6e5e246..9ab0dbc 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/Shakespeare.hs b/Text/Shakespeare.hs-index 67d7dde..a510215 100644---- a/Text/Shakespeare.hs-+++ b/Text/Shakespeare.hs-@@ -15,12 +15,12 @@ module Text.Shakespeare- , WrapInsertion (..)- , PreConversion (..)- , defaultShakespeareSettings-- , shakespeare-- , shakespeareFile-- , shakespeareFileReload-+ -- , shakespeare-+ -- , shakespeareFile-+ -- , shakespeareFileReload- -- * low-level-- , shakespeareFromString-- , shakespeareUsedIdentifiers-+ -- , shakespeareFromString-+ -- , shakespeareUsedIdentifiers- , RenderUrl- , VarType (..)- , Deref-@@ -153,38 +153,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)-@@ -348,6 +316,7 @@ pack' = TS.pack- {-# NOINLINE pack' #-}- #endif- -+{-- contentsToShakespeare :: ShakespeareSettings -> [Content] -> Q Exp- contentsToShakespeare rs a = do- r <- newName "_render"-@@ -399,16 +368,19 @@ shakespeareFile r fp =- qAddDependentFile fp >>- #endif- readFileQ fp >>= shakespeareFromString r-+-}- - data VarType = VTPlain | VTUrl | VTUrlParam | VTMixin- deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic)- -+{-- 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-@@ -417,8 +389,10 @@ data VarExp url = EPlain Builder- - -- | 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- -@@ -435,28 +409,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 a0e983c..23b4692 100644---- a/Text/Shakespeare/Base.hs-+++ b/Text/Shakespeare/Base.hs-@@ -52,34 +52,6 @@ data Deref = DerefModulesIdent [String] Ident- | DerefTuple [Deref]- deriving (Show, Eq, Read, Data, Typeable, Ord)- --instance Lift Ident where-- lift (Ident s) = [|Ident|] `appE` lift s--instance Lift Deref where-- lift (DerefModulesIdent v s) = do-- dl <- [|DerefModulesIdent|]-- v' <- lift v-- s' <- lift s-- return $ dl `AppE` v' `AppE` s'-- lift (DerefIdent s) = do-- dl <- [|DerefIdent|]-- s' <- lift s-- return $ dl `AppE` s'-- lift (DerefBranch x y) = do-- x' <- lift x-- y' <- lift y-- db <- [|DerefBranch|]-- return $ db `AppE` x' `AppE` y'-- lift (DerefIntegral i) = [|DerefIntegral|] `appE` lift i-- lift (DerefRational r) = do-- n <- lift $ numerator r-- d <- lift $ denominator r-- per <- [|(%) :: Int -> Int -> Ratio Int|]-- dr <- [|DerefRational|]-- return $ dr `AppE` InfixE (Just n) per (Just d)-- lift (DerefString s) = [|DerefString|] `appE` lift s-- lift (DerefList x) = [|DerefList $(lift x)|]-- lift (DerefTuple x) = [|DerefTuple $(lift x)|]--- derefParens, derefCurlyBrackets :: UserParser a Deref- derefParens = between (char '(') (char ')') parseDeref- derefCurlyBrackets = between (char '{') (char '}') parseDeref-diff --git a/Text/Shakespeare/I18N.hs b/Text/Shakespeare/I18N.hs-index a39a614..753cba7 100644---- a/Text/Shakespeare/I18N.hs-+++ b/Text/Shakespeare/I18N.hs-@@ -52,10 +52,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-@@ -106,143 +106,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-@@ -258,39 +121,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-diff --git a/Text/Shakespeare/Text.hs b/Text/Shakespeare/Text.hs-index 6865a5a..e25a8be 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 (..))-@@ -45,106 +45,3 @@ instance ToText Int32 where toText = toText . show- instance ToText Int64 where toText = toText . show- instance ToText Int 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)-diff --git a/shakespeare.cabal b/shakespeare.cabal-index 05b985e..dd8762a 100644---- a/shakespeare.cabal-+++ b/shakespeare.cabal-@@ -61,10 +61,9 @@ library- Text.Lucius- Text.Cassius- Text.Shakespeare.Base-+ Text.Css- Text.Shakespeare-- Text.TypeScript- other-modules: Text.Hamlet.Parse-- Text.Css- Text.MkSizeType- Text.IndentToBrace- Text.CssCommon--- -1.7.10.4+From 38a22dae4f7f9726379fdaa3f85d78d75eee9d8e Mon Sep 17 00:00:00 2001+From: dummy <dummy@example.com>+Date: Thu, 16 Oct 2014 02:01:22 +0000+Subject: [PATCH] hack TH++---+ Text/Shakespeare.hs | 70 ++++++++----------------------------------------+ Text/Shakespeare/Base.hs | 28 -------------------+ 2 files changed, 11 insertions(+), 87 deletions(-)++diff --git a/Text/Shakespeare.hs b/Text/Shakespeare.hs+index 68e344f..97361a2 100644+--- a/Text/Shakespeare.hs++++ b/Text/Shakespeare.hs+@@ -14,12 +14,12 @@ module Text.Shakespeare+ , WrapInsertion (..)+ , PreConversion (..)+ , defaultShakespeareSettings+- , shakespeare+- , shakespeareFile+- , shakespeareFileReload++ -- , shakespeare++ -- , shakespeareFile++ -- , shakespeareFileReload+ -- * low-level+- , shakespeareFromString+- , shakespeareUsedIdentifiers++ -- , shakespeareFromString++ -- , shakespeareUsedIdentifiers+ , RenderUrl+ , VarType (..)+ , Deref+@@ -154,38 +154,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)+@@ -349,6 +317,7 @@ pack' = TS.pack+ {-# NOINLINE pack' #-}+ #endif+ ++{-+ contentsToShakespeare :: ShakespeareSettings -> [Content] -> Q Exp+ contentsToShakespeare rs a = do+ r <- newName "_render"+@@ -400,16 +369,19 @@ shakespeareFile r fp =+ qAddDependentFile fp >>+ #endif+ readFileQ fp >>= shakespeareFromString r++-}+ + data VarType = VTPlain | VTUrl | VTUrlParam | VTMixin+ deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic)+ ++{-+ 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+@@ -418,8 +390,10 @@ data VarExp url = EPlain Builder+ + -- | 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+ +@@ -436,28 +410,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 a0e983c..23b4692 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+-- +2.1.1
standalone/no-th/haskell-patches/vector_hack-to-build-with-new-ghc.patch view
@@ -1,11 +1,12 @@-From b0a79f4f98188ba5d43b7e3912b36d34d099ab65 Mon Sep 17 00:00:00 2001+From 6ffd4fcb7d27ec6df709d80a40a262406446a259 Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com>-Date: Fri, 18 Oct 2013 23:20:35 +0000+Date: Wed, 15 Oct 2014 17:00:56 +0000 Subject: [PATCH] cross build ---- Data/Vector/Fusion/Stream/Monadic.hs | 1 -- 1 file changed, 1 deletion(-)+ Data/Vector/Fusion/Stream/Monadic.hs | 1 -+ Data/Vector/Unboxed/Base.hs | 13 -------------+ 2 files changed, 14 deletions(-) diff --git a/Data/Vector/Fusion/Stream/Monadic.hs b/Data/Vector/Fusion/Stream/Monadic.hs index 51fec75..b089b3d 100644@@ -19,6 +20,30 @@ #endif emptyStream :: String+diff --git a/Data/Vector/Unboxed/Base.hs b/Data/Vector/Unboxed/Base.hs+index 00350cb..34bfc4a 100644+--- a/Data/Vector/Unboxed/Base.hs++++ b/Data/Vector/Unboxed/Base.hs+@@ -65,19 +65,6 @@ vectorTyCon = mkTyCon3 "vector"+ vectorTyCon m s = mkTyCon $ m ++ "." ++ s+ #endif+ +-instance Typeable1 Vector where+- typeOf1 _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed" "Vector") []+-+-instance Typeable2 MVector where+- typeOf2 _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed.Mutable" "MVector") []+-+-instance (Data a, Unbox a) => Data (Vector a) where+- gfoldl = G.gfoldl+- toConstr _ = error "toConstr"+- gunfold _ _ = error "gunfold"+- dataTypeOf _ = G.mkType "Data.Vector.Unboxed.Vector"+- dataCast1 = G.dataCast+-+ -- ----+ -- Unit+ -- ---- -- -1.7.10.4+2.1.1
standalone/no-th/haskell-patches/yesod-core_expand_TH.patch view
@@ -1,18 +1,18 @@-From 9feb37d13dc8449dc4445db83485780caee4b7ff Mon Sep 17 00:00:00 2001+From f1feea61dcba0b16afed5ce8dd5d2433fe505461 Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com>-Date: Tue, 10 Jun 2014 17:44:52 +0000-Subject: [PATCH] expand and remove TH+Date: Thu, 16 Oct 2014 02:15:23 +0000+Subject: [PATCH] hack TH --- Yesod/Core.hs | 30 +++---- Yesod/Core/Class/Yesod.hs | 257 ++++++++++++++++++++++++++++++---------------+ Yesod/Core/Class/Yesod.hs | 256 ++++++++++++++++++++++++++++++--------------- Yesod/Core/Dispatch.hs | 38 ++----- Yesod/Core/Handler.hs | 25 ++---- Yesod/Core/Internal/Run.hs | 8 +-+ Yesod/Core/Internal/Run.hs | 6 +- Yesod/Core/Internal/TH.hs | 111 -------------------- Yesod/Core/Types.hs | 3 +- Yesod/Core/Widget.hs | 32 +------ 8 files changed, 215 insertions(+), 289 deletions(-)+ 8 files changed, 213 insertions(+), 288 deletions(-) diff --git a/Yesod/Core.hs b/Yesod/Core.hs index 9b29317..7c0792d 100644@@ -68,7 +68,7 @@ , renderCssUrl ) where diff --git a/Yesod/Core/Class/Yesod.hs b/Yesod/Core/Class/Yesod.hs-index 140600b..75daabc 100644+index 8631d27..c40eb10 100644 --- a/Yesod/Core/Class/Yesod.hs +++ b/Yesod/Core/Class/Yesod.hs @@ -5,18 +5,22 @@@@ -104,11 +104,11 @@ import Network.HTTP.Types (encodePath) import qualified Network.Wai as W import Data.Default (def)-@@ -94,18 +97,27 @@ class RenderRoute site => Yesod site where+@@ -94,18 +97,26 @@ class RenderRoute site => Yesod site where defaultLayout w = do p <- widgetToPageContent w mmsg <- getMessage-- giveUrlRenderer [hamlet|+- withUrlRenderer [hamlet| - $newline never - $doctype 5 - <html>@@ -120,7 +120,7 @@ - <p .message>#{msg} - ^{pageBody p} - |]-+ giveUrlRenderer $ \ _render_aHra++ withUrlRenderer $ \ _render_aHra + -> do { id + ((Text.Blaze.Internal.preEscapedText . T.pack) + "<!DOCTYPE html>\n<html><head><title>");@@ -140,11 +140,10 @@ + 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-@@ -374,45 +386,103 @@ widgetToPageContent w = do+@@ -374,45 +385,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@@ -287,7 +286,7 @@ return $ PageContent title headAll $ case jsLoader master of-@@ -442,10 +512,13 @@ defaultErrorHandler NotFound = selectRep $ do+@@ -442,10 +511,13 @@ defaultErrorHandler NotFound = selectRep $ do r <- waiRequest let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r setTitle "Not Found"@@ -305,7 +304,7 @@ provideRep $ return $ object ["message" .= ("Not Found" :: Text)] -- For API requests.-@@ -455,10 +528,11 @@ defaultErrorHandler NotFound = selectRep $ do+@@ -455,10 +527,11 @@ defaultErrorHandler NotFound = selectRep $ do defaultErrorHandler NotAuthenticated = selectRep $ do provideRep $ defaultLayout $ do setTitle "Not logged in"@@ -321,7 +320,7 @@ provideRep $ do -- 401 *MUST* include a WWW-Authenticate header-@@ -480,10 +554,13 @@ defaultErrorHandler NotAuthenticated = selectRep $ do+@@ -480,10 +553,13 @@ defaultErrorHandler NotAuthenticated = selectRep $ do defaultErrorHandler (PermissionDenied msg) = selectRep $ do provideRep $ defaultLayout $ do setTitle "Permission Denied"@@ -339,7 +338,7 @@ provideRep $ return $ object $ [ "message" .= ("Permission Denied. " <> msg)-@@ -492,30 +569,42 @@ defaultErrorHandler (PermissionDenied msg) = selectRep $ do+@@ -492,30 +568,42 @@ defaultErrorHandler (PermissionDenied msg) = selectRep $ do defaultErrorHandler (InvalidArgs ia) = selectRep $ do provideRep $ defaultLayout $ do setTitle "Invalid Arguments"@@ -397,7 +396,7 @@ provideRep $ return $ object ["message" .= ("Bad method" :: Text), "method" .= TE.decodeUtf8With TEE.lenientDecode m] asyncHelper :: (url -> [x] -> Text)-@@ -682,8 +771,4 @@ loadClientSession key getCachedDate sessionName req = load+@@ -682,8 +770,4 @@ loadClientSession key getCachedDate sessionName req = load -- turn the TH Loc loaction information into a human readable string -- leaving out the loc_end parameter fileLocationToString :: Loc -> String@@ -484,10 +483,10 @@ -- | Runs your application using default middlewares (i.e., via 'toWaiApp'). It -- reads port information from the PORT environment variable, as used by tools diff --git a/Yesod/Core/Handler.hs b/Yesod/Core/Handler.hs-index 2e5d7cb..83f93bf 100644+index d2b196b..13cac17 100644 --- a/Yesod/Core/Handler.hs +++ b/Yesod/Core/Handler.hs-@@ -172,7 +172,7 @@ import Data.Text.Encoding (decodeUtf8With, encodeUtf8)+@@ -174,7 +174,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@@ -496,7 +495,7 @@ import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L-@@ -201,6 +201,7 @@ import Control.Exception (throwIO)+@@ -203,6 +203,7 @@ import Control.Exception (throwIO) import Blaze.ByteString.Builder (Builder) import Safe (headMay) import Data.CaseInsensitive (CI)@@ -504,11 +503,11 @@ import qualified Data.Conduit.List as CL import Control.Monad (unless) import Control.Monad.Trans.Resource (MonadResource, InternalState, runResourceT, withInternalState, getInternalState, liftResourceT, resourceForkIO-@@ -847,19 +848,15 @@ redirectToPost :: (MonadHandler m, RedirectUrl (HandlerSite m) url)+@@ -855,19 +856,15 @@ redirectToPost :: (MonadHandler m, RedirectUrl (HandlerSite m) url) -> m a redirectToPost url = do urlText <- toTextUrl url-- giveUrlRenderer [hamlet|+- withUrlRenderer [hamlet| -$newline never -$doctype 5 -@@ -521,7 +520,7 @@ - <p>Javascript has been disabled; please click on the button below to be redirected. - <input type="submit" value="Continue"> -|] >>= sendResponse-+ giveUrlRenderer $ \ _render_awps++ withUrlRenderer $ \ _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=\"");@@ -534,20 +533,18 @@ -- | 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 09b4609..e1ef568 100644+index 311f208..63f666f 100644 --- a/Yesod/Core/Internal/Run.hs +++ b/Yesod/Core/Internal/Run.hs-@@ -16,8 +16,8 @@ import Control.Exception.Lifted (catch)+@@ -16,7 +16,7 @@ import Control.Exception.Lifted (catch) import Control.Monad (mplus) import Control.Monad.IO.Class (MonadIO) import Control.Monad.IO.Class (liftIO) -import Control.Monad.Logger (LogLevel (LevelError), LogSource,-- liftLoc) +import Control.Monad.Logger (Loc, 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 @@ -31,7 +31,7 @@ import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) import Data.Text.Encoding (decodeUtf8With)@@ -557,7 +554,7 @@ import qualified Network.HTTP.Types as H import Network.Wai #if MIN_VERSION_wai(2, 0, 0)-@@ -157,8 +157,6 @@ safeEh :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ())+@@ -158,8 +158,6 @@ safeEh :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> ErrorResponse -> YesodApp safeEh log' er req = do@@ -686,7 +683,7 @@ - ] - return $ LetE [fun] (VarE helper) diff --git a/Yesod/Core/Types.hs b/Yesod/Core/Types.hs-index 7e3fd0d..994d322 100644+index 388dfe3..b3fce0f 100644 --- a/Yesod/Core/Types.hs +++ b/Yesod/Core/Types.hs @@ -21,6 +21,7 @@ import Control.Monad.Catch (MonadCatch (..))@@ -697,7 +694,7 @@ import Control.Monad.Logger (LogLevel, LogSource, MonadLogger (..)) import Control.Monad.Trans.Control (MonadBaseControl (..))-@@ -187,7 +188,7 @@ data RunHandlerEnv site = RunHandlerEnv+@@ -191,7 +192,7 @@ data RunHandlerEnv site = RunHandlerEnv , rheRoute :: !(Maybe (Route site)) , rheSite :: !site , rheUpload :: !(RequestBodyLength -> FileUpload)@@ -767,5 +764,5 @@ ihamletToRepHtml :: (MonadHandler m, RenderMessage (HandlerSite m) message) => HtmlUrlI18n message (Route (HandlerSite m)) -- -2.0.0+2.1.1
standalone/no-th/haskell-patches/yesod-form_spliced-TH.patch view
@@ -1,23 +1,32 @@-From 6aabd510081681f81f4259190be32fbb2819b46c Mon Sep 17 00:00:00 2001-From: Joey Hess <joey@kitenet.net>-Date: Fri, 12 Sep 2014 21:30:27 -0400-Subject: [PATCH] splice TH+From 1b24ece1a40c9365f719472ca6e342c8c4065c25 Mon Sep 17 00:00:00 2001+From: dummy <dummy@example.com>+Date: Thu, 16 Oct 2014 02:31:20 +0000+Subject: [PATCH] hack TH ---- Yesod/Form/Bootstrap3.hs | 183 +++++++++---- Yesod/Form/Fields.hs | 753 ++++++++++++++++++++++++++++++++++++++---------- Yesod/Form/Functions.hs | 257 +++++++++++++---- Yesod/Form/Jquery.hs | 134 +++++++--- Yesod/Form/MassInput.hs | 226 +++++++++++---- Yesod/Form/Nic.hs | 67 ++++-- yesod-form.cabal | 1 -- 7 files changed, 1319 insertions(+), 302 deletions(-)+ Yesod/Form/Bootstrap3.hs | 186 +++++++++--+ Yesod/Form/Fields.hs | 816 +++++++++++++++++++++++++++++++++++------------+ Yesod/Form/Functions.hs | 257 ++++++++++++---+ Yesod/Form/Jquery.hs | 134 ++++++--+ Yesod/Form/MassInput.hs | 226 ++++++++++---+ Yesod/Form/Nic.hs | 67 +++-+ 6 files changed, 1322 insertions(+), 364 deletions(-) diff --git a/Yesod/Form/Bootstrap3.hs b/Yesod/Form/Bootstrap3.hs-index 84e85fc..943c416 100644+index 84e85fc..1954fb4 100644 --- a/Yesod/Form/Bootstrap3.hs +++ b/Yesod/Form/Bootstrap3.hs-@@ -152,44 +152,144 @@ renderBootstrap3 formLayout aform fragment = do+@@ -26,6 +26,9 @@ import Data.String (IsString(..))+ import Yesod.Core+ + import qualified Data.Text as T++import qualified Text.Hamlet++import qualified Text.Blaze.Internal++import qualified Data.Foldable+ + import Yesod.Form.Types+ import Yesod.Form.Functions+@@ -152,44 +155,144 @@ renderBootstrap3 formLayout aform fragment = do let views = views' [] has (Just _) = True has Nothing = False@@ -104,7 +113,7 @@ + Nothing; + (asWidgetT . toWidget) (fvInput view_as0a); + (asWidgetT . toWidget) (helpWidget view_as0a) }-+ BootstrapHorizontalForm labelOffset_as0b++ ; BootstrapHorizontalForm labelOffset_as0b + labelSize_as0c + inputOffset_as0d + inputSize_as0e@@ -195,7 +204,7 @@ -- | How the 'bootstrapSubmit' button should be rendered.-@@ -244,7 +344,22 @@ mbootstrapSubmit+@@ -244,7 +347,22 @@ mbootstrapSubmit => BootstrapSubmit msg -> MForm m (FormResult (), FieldView site) mbootstrapSubmit (BootstrapSubmit msg classes attrs) = let res = FormSuccess ()@@ -220,7 +229,7 @@ , fvTooltip = Nothing , fvId = bootstrapSubmitId diff --git a/Yesod/Form/Fields.hs b/Yesod/Form/Fields.hs-index c6091a9..3d7b267 100644+index c6091a9..9e6bd4e 100644 --- a/Yesod/Form/Fields.hs +++ b/Yesod/Form/Fields.hs @@ -1,4 +1,3 @@@@ -908,7 +917,7 @@ + ((Text.Blaze.Internal.preEscapedText . pack) "\">"); + (asWidgetT . toWidget) inside; + (asWidgetT . toWidget)-+ ((Text.Blaze.Internal.preEscapedText . pack) "</div>") }++ ((Text.Blaze.Internal.preEscapedText . pack) "</div>") }) + + (\theId name isSel -> do { (asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack)@@ -1098,7 +1107,77 @@ , fieldEnctype = UrlEncoded } -@@ -665,9 +1114,21 @@ fileField = Field+@@ -559,69 +1008,6 @@ 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]+ +-#if MIN_VERSION_persistent(2, 0, 0)+-optionsPersist :: ( YesodPersist site, PersistEntity a+- , PersistQuery (PersistEntityBackend a)+- , PathPiece (Key a)+- , RenderMessage site msg+- , YesodPersistBackend site ~ PersistEntityBackend a+- )+-#else+-optionsPersist :: ( YesodPersist site, PersistEntity a+- , PersistQuery (YesodPersistBackend site (HandlerT site IO))+- , PathPiece (Key a)+- , PersistEntityBackend a ~ PersistMonadBackend (YesodPersistBackend site (HandlerT site IO))+- , RenderMessage site msg+- )+-#endif+- => [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+-#if MIN_VERSION_persistent(2, 0, 0)+-optionsPersistKey+- :: (YesodPersist site+- , PersistEntity a+- , PersistQuery (PersistEntityBackend a)+- , PathPiece (Key a)+- , RenderMessage site msg+- , YesodPersistBackend site ~ PersistEntityBackend a+- )+-#else+-optionsPersistKey+- :: (YesodPersist site+- , PersistEntity a+- , PersistQuery (YesodPersistBackend site (HandlerT site IO))+- , PathPiece (Key a)+- , RenderMessage site msg+- , PersistEntityBackend a ~ PersistMonadBackend (YesodDB site))+-#endif+- => [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)+@@ -665,9 +1051,21 @@ fileField = Field case files of [] -> Right Nothing file:_ -> Right $ Just file@@ -1123,7 +1202,7 @@ , fieldEnctype = Multipart } -@@ -694,10 +1155,19 @@ fileAFormReq fs = AForm $ \(site, langs) menvs ints -> do+@@ -694,10 +1092,19 @@ 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'@@ -1147,7 +1226,7 @@ , fvErrors = errs , fvRequired = True }-@@ -726,10 +1196,19 @@ fileAFormOpt fs = AForm $ \(master, langs) menvs ints -> do+@@ -726,10 +1133,19 @@ 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'@@ -1172,10 +1251,10 @@ , fvRequired = False } diff --git a/Yesod/Form/Functions.hs b/Yesod/Form/Functions.hs-index 5fd03e6..b14d900 100644+index 9e6abaf..0c2a0ce 100644 --- a/Yesod/Form/Functions.hs +++ b/Yesod/Form/Functions.hs-@@ -59,12 +59,16 @@ import Text.Blaze (Markup, toMarkup)+@@ -60,12 +60,16 @@ import Text.Blaze (Markup, toMarkup) #define toHtml toMarkup import Yesod.Core import Network.Wai (requestMethod)@@ -1193,7 +1272,7 @@ -- | Get a unique identifier. newFormIdent :: Monad m => MForm m Text-@@ -216,7 +220,14 @@ postHelper form env = do+@@ -217,7 +221,14 @@ postHelper form env = do let token = case reqToken req of Nothing -> mempty@@ -1209,7 +1288,7 @@ m <- getYesod langs <- languages ((res, xml), enctype) <- runFormGeneric (form token) m langs env-@@ -296,7 +307,12 @@ getHelper :: MonadHandler m+@@ -297,7 +308,12 @@ getHelper :: MonadHandler m -> Maybe (Env, FileEnv) -> m (a, Enctype) getHelper form env = do@@ -1223,7 +1302,7 @@ langs <- languages m <- getYesod runFormGeneric (form fragment) m langs env-@@ -331,10 +347,15 @@ identifyForm+@@ -332,10 +348,15 @@ identifyForm identifyForm identVal form = \fragment -> do -- Create hidden <input>. let fragment' =@@ -1243,7 +1322,7 @@ -- Check if we got its value back. mp <- askParams-@@ -364,22 +385,70 @@ renderTable, renderDivs, renderDivsNoLabels :: Monad m => FormRender m a+@@ -365,22 +386,70 @@ renderTable, renderDivs, renderDivsNoLabels :: Monad m => FormRender m a renderTable aform fragment = do (res, views') <- aFormToForm aform let views = views' []@@ -1330,7 +1409,7 @@ return (res, widget) where addIsFirst [] = []-@@ -395,19 +464,66 @@ renderDivsMaybeLabels :: Monad m => Bool -> FormRender m a+@@ -396,19 +465,66 @@ renderDivsMaybeLabels :: Monad m => Bool -> FormRender m a renderDivsMaybeLabels withLabels aform fragment = do (res, views') <- aFormToForm aform let views = views' []@@ -1410,7 +1489,7 @@ return (res, widget) -- | Render a form using Bootstrap v2-friendly shamlet syntax.-@@ -435,19 +551,62 @@ renderBootstrap2 aform fragment = do+@@ -436,19 +552,62 @@ renderBootstrap2 aform fragment = do let views = views' [] has (Just _) = True has Nothing = False@@ -2002,18 +2081,6 @@ , fieldEnctype = UrlEncoded } where-diff --git a/yesod-form.cabal b/yesod-form.cabal-index bfe94df..1f5aef5 100644---- a/yesod-form.cabal-+++ b/yesod-form.cabal-@@ -51,7 +51,6 @@ library- exposed-modules: Yesod.Form- Yesod.Form.Types- Yesod.Form.Functions-- Yesod.Form.Bootstrap3- Yesod.Form.Input- Yesod.Form.Fields- Yesod.Form.Jquery -- -2.1.0+2.1.1
standalone/no-th/haskell-patches/yesod-persistent_do-not-really-build.patch view
@@ -1,14 +1,14 @@-From 92a34bc2b09572a58a4e696e0d8a0a61475535f7 Mon Sep 17 00:00:00 2001+From e82ed4e6fd7b5ea6dbe474b5de2755ec5794161c Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com>-Date: Tue, 10 Jun 2014 19:09:56 +0000-Subject: [PATCH] do not really build+Date: Thu, 16 Oct 2014 02:23:50 +0000+Subject: [PATCH] stub out --- yesod-persistent.cabal | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/yesod-persistent.cabal b/yesod-persistent.cabal-index b44499b..ef33863 100644+index b116f3a..017b184 100644 --- a/yesod-persistent.cabal +++ b/yesod-persistent.cabal @@ -14,16 +14,6 @@ description: Some helpers for using Persistent from Yesod.@@ -16,8 +16,8 @@ library build-depends: base >= 4 && < 5 - , yesod-core >= 1.2.2 && < 1.3-- , persistent >= 1.2 && < 1.4-- , persistent-template >= 1.2 && < 1.4+- , persistent >= 1.2 && < 2.1+- , persistent-template >= 1.2 && < 2.1 - , transformers >= 0.2.2 - , blaze-builder - , conduit@@ -29,5 +29,5 @@ test-suite test -- -2.0.0+2.1.1
standalone/no-th/haskell-patches/yesod_hack-TH.patch view
@@ -1,13 +1,13 @@-From da032b804c0a35c2831664e28c9211f4fe712593 Mon Sep 17 00:00:00 2001+From 59091cd37958fee79b9e346fe3118d5ed7d0104b Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com>-Date: Tue, 10 Jun 2014 20:39:42 +0000-Subject: [PATCH] avoid TH+Date: Thu, 16 Oct 2014 02:36:37 +0000+Subject: [PATCH] hack TH --- Yesod.hs | 19 ++++++++++++--- Yesod/Default/Main.hs | 32 +-----------------------+ Yesod/Default/Main.hs | 31 +---------------------- Yesod/Default/Util.hs | 69 ++-------------------------------------------------- 3 files changed, 20 insertions(+), 100 deletions(-)+ 3 files changed, 20 insertions(+), 99 deletions(-) diff --git a/Yesod.hs b/Yesod.hs index b367144..fbe309c 100644@@ -41,7 +41,7 @@ +insert = undefined + diff --git a/Yesod/Default/Main.hs b/Yesod/Default/Main.hs-index 565ed35..41c2df0 100644+index 565ed35..bf46642 100644 --- a/Yesod/Default/Main.hs +++ b/Yesod/Default/Main.hs @@ -1,10 +1,8 @@@@ -64,7 +64,7 @@ import System.Log.FastLogger (LogStr, toLogStr) import Language.Haskell.TH.Syntax (qLocation) -@@ -55,34 +53,6 @@ defaultMain load getApp = do+@@ -55,33 +53,6 @@ defaultMain load getApp = do type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO () @@ -95,10 +95,9 @@ -#else - const True -#endif--+ -- | Run your application continously, listening for SIGINT and exiting -- when received- -- diff --git a/Yesod/Default/Util.hs b/Yesod/Default/Util.hs index a10358e..0547424 100644 --- a/Yesod/Default/Util.hs@@ -196,5 +195,5 @@ - else return $ Just ex - else return Nothing -- -2.0.0+2.1.1