got webdav going on android

This commit is contained in:
Joey Hess 2013-04-18 19:41:09 -04:00
parent 5bab1b89ac
commit c3748ae70d
5 changed files with 772 additions and 0 deletions

View file

@ -0,0 +1,306 @@
From d195f807dac2351d29aeff00d2aee3e151eb82e3 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 18 Apr 2013 19:37:28 -0400
Subject: [PATCH] build without TH
Used the EvilSplicer to expand the TH
Left off CmdArgs to save time.
---
DAV.cabal | 20 +----
Network/Protocol/HTTP/DAV.hs | 53 ++++++++++---
Network/Protocol/HTTP/DAV/TH.hs | 167 ++++++++++++++++++++++++++++++++++++++-
3 files changed, 207 insertions(+), 33 deletions(-)
diff --git a/DAV.cabal b/DAV.cabal
index 774d4e5..8b85133 100644
--- a/DAV.cabal
+++ b/DAV.cabal
@@ -38,25 +38,7 @@ library
, transformers >= 0.3
, xml-conduit >= 1.0 && <= 1.1
, xml-hamlet >= 0.4 && <= 0.5
-executable hdav
- main-is: hdav.hs
- ghc-options: -Wall
- build-depends: base >= 4.5 && <= 5
- , bytestring
- , bytestring
- , case-insensitive >= 0.4
- , cmdargs >= 0.9
- , containers
- , http-conduit >= 1.4
- , http-types >= 0.7
- , lens >= 3.0
- , lifted-base >= 0.1
- , mtl >= 2.1
- , network >= 2.3
- , resourcet >= 0.3
- , transformers >= 0.3
- , xml-conduit >= 1.0 && <= 1.1
- , xml-hamlet >= 0.4 && <= 0.5
+ , text
source-repository head
type: git
diff --git a/Network/Protocol/HTTP/DAV.hs b/Network/Protocol/HTTP/DAV.hs
index 02e5d15..c0be362 100644
--- a/Network/Protocol/HTTP/DAV.hs
+++ b/Network/Protocol/HTTP/DAV.hs
@@ -52,7 +52,8 @@ import Network.HTTP.Types (hContentType, Method, Status, RequestHeaders, unautho
import qualified Text.XML as XML
import Text.XML.Cursor (($/), (&/), element, node, fromDocument, checkName)
-import Text.Hamlet.XML (xml)
+import Text.Hamlet.XML
+import qualified Data.Text
import Data.CaseInsensitive (mk)
@@ -246,18 +247,48 @@ makeCollection url username password = withDS url username password $
propname :: XML.Document
propname = XML.Document (XML.Prologue [] Nothing []) root []
where
- root = XML.Element "D:propfind" (Map.fromList [("xmlns:D", "DAV:")]) [xml|
-<D:allprop>
-|]
+ root = XML.Element "D:propfind" (Map.fromList [("xmlns:D", "DAV:")]) $ concat
+ [[XML.NodeElement
+ (XML.Element
+ (XML.Name
+ (Data.Text.pack "D:allprop") Nothing Nothing)
+ Map.empty
+ (concat []))]]
+
locky :: XML.Document
locky = XML.Document (XML.Prologue [] Nothing []) root []
where
- root = XML.Element "D:lockinfo" (Map.fromList [("xmlns:D", "DAV:")]) [xml|
-<D:lockscope>
- <D:exclusive>
-<D:locktype>
- <D:write>
-<D:owner>Haskell DAV user
-|]
+ root = XML.Element "D:lockinfo" (Map.fromList [("xmlns:D", "DAV:")]) $ concat
+ [[XML.NodeElement
+ (XML.Element
+ (XML.Name
+ (Data.Text.pack "D:lockscope") Nothing Nothing)
+ Map.empty
+ (concat
+ [[XML.NodeElement
+ (XML.Element
+ (XML.Name
+ (Data.Text.pack "D:exclusive") Nothing Nothing)
+ Map.empty
+ (concat []))]]))],
+ [XML.NodeElement
+ (XML.Element
+ (XML.Name
+ (Data.Text.pack "D:locktype") Nothing Nothing)
+ Map.empty
+ (concat
+ [[XML.NodeElement
+ (XML.Element
+ (XML.Name (Data.Text.pack "D:write") Nothing Nothing)
+ Map.empty
+ (concat []))]]))],
+ [XML.NodeElement
+ (XML.Element
+ (XML.Name (Data.Text.pack "D:owner") Nothing Nothing)
+ Map.empty
+ (concat
+ [[XML.NodeContent
+ (Data.Text.pack "Haskell DAV user")]]))]]
+
diff --git a/Network/Protocol/HTTP/DAV/TH.hs b/Network/Protocol/HTTP/DAV/TH.hs
index 036a2bc..4d3c0f4 100644
--- a/Network/Protocol/HTTP/DAV/TH.hs
+++ b/Network/Protocol/HTTP/DAV/TH.hs
@@ -16,11 +16,13 @@
-- You should have received a copy of the GNU General Public License
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE RankNTypes #-}
module Network.Protocol.HTTP.DAV.TH where
-import Control.Lens (makeLenses)
+import Control.Lens
+import qualified Control.Lens.Type
+import qualified Data.Functor
import qualified Data.ByteString as B
import Network.HTTP.Conduit (Manager, Request)
@@ -33,4 +35,163 @@ data DAVContext a = DAVContext {
, _basicusername :: B.ByteString
, _basicpassword :: B.ByteString
}
-makeLenses ''DAVContext
+allowedMethods ::
+ forall a_a4Oo.
+ Control.Lens.Type.Lens' (DAVContext a_a4Oo) [B.ByteString]
+allowedMethods
+ _f_a5tt
+ (DAVContext __allowedMethods'_a5tu
+ __baseRequest_a5tw
+ __complianceClasses_a5tx
+ __httpManager_a5ty
+ __lockToken_a5tz
+ __basicusername_a5tA
+ __basicpassword_a5tB)
+ = ((\ __allowedMethods_a5tv
+ -> DAVContext
+ __allowedMethods_a5tv
+ __baseRequest_a5tw
+ __complianceClasses_a5tx
+ __httpManager_a5ty
+ __lockToken_a5tz
+ __basicusername_a5tA
+ __basicpassword_a5tB)
+ Data.Functor.<$> (_f_a5tt __allowedMethods'_a5tu))
+{-# INLINE allowedMethods #-}
+baseRequest ::
+ forall a_a4Oo a_a5tC.
+ Control.Lens.Type.Lens (DAVContext a_a4Oo) (DAVContext a_a5tC) (Request a_a4Oo) (Request a_a5tC)
+baseRequest
+ _f_a5tD
+ (DAVContext __allowedMethods_a5tE
+ __baseRequest'_a5tF
+ __complianceClasses_a5tH
+ __httpManager_a5tI
+ __lockToken_a5tJ
+ __basicusername_a5tK
+ __basicpassword_a5tL)
+ = ((\ __baseRequest_a5tG
+ -> DAVContext
+ __allowedMethods_a5tE
+ __baseRequest_a5tG
+ __complianceClasses_a5tH
+ __httpManager_a5tI
+ __lockToken_a5tJ
+ __basicusername_a5tK
+ __basicpassword_a5tL)
+ Data.Functor.<$> (_f_a5tD __baseRequest'_a5tF))
+{-# INLINE baseRequest #-}
+basicpassword ::
+ forall a_a4Oo.
+ Control.Lens.Type.Lens' (DAVContext a_a4Oo) B.ByteString
+basicpassword
+ _f_a5tM
+ (DAVContext __allowedMethods_a5tN
+ __baseRequest_a5tO
+ __complianceClasses_a5tP
+ __httpManager_a5tQ
+ __lockToken_a5tR
+ __basicusername_a5tS
+ __basicpassword'_a5tT)
+ = ((\ __basicpassword_a5tU
+ -> DAVContext
+ __allowedMethods_a5tN
+ __baseRequest_a5tO
+ __complianceClasses_a5tP
+ __httpManager_a5tQ
+ __lockToken_a5tR
+ __basicusername_a5tS
+ __basicpassword_a5tU)
+ Data.Functor.<$> (_f_a5tM __basicpassword'_a5tT))
+{-# INLINE basicpassword #-}
+basicusername ::
+ forall a_a4Oo.
+ Control.Lens.Type.Lens' (DAVContext a_a4Oo) B.ByteString
+basicusername
+ _f_a5tV
+ (DAVContext __allowedMethods_a5tW
+ __baseRequest_a5tX
+ __complianceClasses_a5tY
+ __httpManager_a5tZ
+ __lockToken_a5u0
+ __basicusername'_a5u1
+ __basicpassword_a5u3)
+ = ((\ __basicusername_a5u2
+ -> DAVContext
+ __allowedMethods_a5tW
+ __baseRequest_a5tX
+ __complianceClasses_a5tY
+ __httpManager_a5tZ
+ __lockToken_a5u0
+ __basicusername_a5u2
+ __basicpassword_a5u3)
+ Data.Functor.<$> (_f_a5tV __basicusername'_a5u1))
+{-# INLINE basicusername #-}
+complianceClasses ::
+ forall a_a4Oo.
+ Control.Lens.Type.Lens' (DAVContext a_a4Oo) [B.ByteString]
+complianceClasses
+ _f_a5u4
+ (DAVContext __allowedMethods_a5u5
+ __baseRequest_a5u6
+ __complianceClasses'_a5u7
+ __httpManager_a5u9
+ __lockToken_a5ua
+ __basicusername_a5ub
+ __basicpassword_a5uc)
+ = ((\ __complianceClasses_a5u8
+ -> DAVContext
+ __allowedMethods_a5u5
+ __baseRequest_a5u6
+ __complianceClasses_a5u8
+ __httpManager_a5u9
+ __lockToken_a5ua
+ __basicusername_a5ub
+ __basicpassword_a5uc)
+ Data.Functor.<$> (_f_a5u4 __complianceClasses'_a5u7))
+{-# INLINE complianceClasses #-}
+httpManager ::
+ forall a_a4Oo. Control.Lens.Type.Lens' (DAVContext a_a4Oo) Manager
+httpManager
+ _f_a5ud
+ (DAVContext __allowedMethods_a5ue
+ __baseRequest_a5uf
+ __complianceClasses_a5ug
+ __httpManager'_a5uh
+ __lockToken_a5uj
+ __basicusername_a5uk
+ __basicpassword_a5ul)
+ = ((\ __httpManager_a5ui
+ -> DAVContext
+ __allowedMethods_a5ue
+ __baseRequest_a5uf
+ __complianceClasses_a5ug
+ __httpManager_a5ui
+ __lockToken_a5uj
+ __basicusername_a5uk
+ __basicpassword_a5ul)
+ Data.Functor.<$> (_f_a5ud __httpManager'_a5uh))
+{-# INLINE httpManager #-}
+lockToken ::
+ forall a_a4Oo.
+ Control.Lens.Type.Lens' (DAVContext a_a4Oo) (Maybe B.ByteString)
+lockToken
+ _f_a5um
+ (DAVContext __allowedMethods_a5un
+ __baseRequest_a5uo
+ __complianceClasses_a5up
+ __httpManager_a5uq
+ __lockToken'_a5ur
+ __basicusername_a5ut
+ __basicpassword_a5uu)
+ = ((\ __lockToken_a5us
+ -> DAVContext
+ __allowedMethods_a5un
+ __baseRequest_a5uo
+ __complianceClasses_a5up
+ __httpManager_a5uq
+ __lockToken_a5us
+ __basicusername_a5ut
+ __basicpassword_a5uu)
+ Data.Functor.<$> (_f_a5um __lockToken'_a5ur))
+{-# INLINE lockToken #-}
--
1.7.10.4

View file

@ -0,0 +1,39 @@
From ddf49377d37c82575c1b0b712a476fa93fc00d6b Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 18 Apr 2013 17:39:28 -0400
Subject: [PATCH] fixes for cross build
---
distributive.cabal | 2 +-
src/Data/Distributive.hs | 2 --
2 files changed, 1 insertion(+), 3 deletions(-)
diff --git a/distributive.cabal b/distributive.cabal
index 66ac73c..5204755 100644
--- a/distributive.cabal
+++ b/distributive.cabal
@@ -12,7 +12,7 @@ bug-reports: http://github.com/ekmett/distributive/issues
copyright: Copyright (C) 2011 Edward A. Kmett
synopsis: Haskell 98 Distributive functors -- Dual to Traversable
description: Haskell 98 Distributive functors -- Dual to Traversable
-build-type: Custom
+build-type: Simple
extra-source-files:
.ghci
.travis.yml
diff --git a/src/Data/Distributive.hs b/src/Data/Distributive.hs
index 6f5613d..66eaed2 100644
--- a/src/Data/Distributive.hs
+++ b/src/Data/Distributive.hs
@@ -26,8 +26,6 @@ import Data.Functor.Identity
import Data.Functor.Product
import Data.Functor.Reverse
-{-# ANN module "ignore Use section" #-}
-
-- | This is the categorical dual of 'Traversable'. However, there appears
-- to be little benefit to allow the distribution via an arbitrary comonad
-- so we restrict ourselves to 'Functor'.
--
1.8.2.rc3

View file

@ -0,0 +1,293 @@
From bbb49942123f06a36b170966e445692297f71d26 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 18 Apr 2013 19:14:30 -0400
Subject: [PATCH] build without TH
---
lens.cabal | 13 +------------
src/Control/Exception/Lens.hs | 2 +-
src/Control/Lens.hs | 6 +++---
src/Control/Lens/Equality.hs | 4 ++--
src/Control/Lens/Fold.hs | 6 +++---
src/Control/Lens/Internal.hs | 2 +-
src/Control/Lens/Internal/Zipper.hs | 2 +-
src/Control/Lens/Iso.hs | 2 --
src/Control/Lens/Lens.hs | 2 +-
src/Control/Lens/Operators.hs | 2 +-
src/Control/Lens/Plated.hs | 2 +-
src/Control/Lens/Setter.hs | 2 --
src/Control/Lens/TH.hs | 2 +-
src/Data/Data/Lens.hs | 6 +++---
14 files changed, 19 insertions(+), 34 deletions(-)
diff --git a/lens.cabal b/lens.cabal
index a06b3ce..a654b3d 100644
--- a/lens.cabal
+++ b/lens.cabal
@@ -10,7 +10,7 @@ stability: provisional
homepage: http://github.com/ekmett/lens/
bug-reports: http://github.com/ekmett/lens/issues
copyright: Copyright (C) 2012-2013 Edward A. Kmett
-build-type: Custom
+build-type: Simple
tested-with: GHC == 7.0.4, GHC == 7.4.1, GHC == 7.4.2, GHC == 7.6.1, GHC == 7.7.20121213, GHC == 7.7.20130117
synopsis: Lenses, Folds and Traversals
description:
@@ -171,7 +171,6 @@ library
containers >= 0.4.0 && < 0.6,
distributive >= 0.3 && < 1,
filepath >= 1.2.0.0 && < 1.4,
- generic-deriving == 1.4.*,
ghc-prim,
hashable >= 1.1.2.3 && < 1.3,
MonadCatchIO-transformers >= 0.3 && < 0.4,
@@ -233,14 +232,12 @@ library
Control.Lens.Review
Control.Lens.Setter
Control.Lens.Simple
- Control.Lens.TH
Control.Lens.Traversal
Control.Lens.Tuple
Control.Lens.Type
Control.Lens.Wrapped
Control.Lens.Zipper
Control.Lens.Zoom
- Control.Monad.Error.Lens
Control.Parallel.Strategies.Lens
Control.Seq.Lens
Data.Array.Lens
@@ -264,12 +261,8 @@ library
Data.Typeable.Lens
Data.Vector.Lens
Data.Vector.Generic.Lens
- Generics.Deriving.Lens
- GHC.Generics.Lens
System.Exit.Lens
System.FilePath.Lens
- System.IO.Error.Lens
- Language.Haskell.TH.Lens
Numeric.Lens
if flag(safe)
@@ -368,7 +361,6 @@ test-suite doctests
deepseq,
doctest >= 0.9.1,
filepath,
- generic-deriving,
mtl,
nats,
parallel,
@@ -394,7 +386,6 @@ benchmark plated
comonad,
criterion,
deepseq,
- generic-deriving,
lens,
transformers
@@ -429,7 +420,6 @@ benchmark unsafe
comonads-fd,
criterion,
deepseq,
- generic-deriving,
lens,
transformers
@@ -446,6 +436,5 @@ benchmark zipper
comonads-fd,
criterion,
deepseq,
- generic-deriving,
lens,
transformers
diff --git a/src/Control/Exception/Lens.hs b/src/Control/Exception/Lens.hs
index 5c26d4e..9909132 100644
--- a/src/Control/Exception/Lens.hs
+++ b/src/Control/Exception/Lens.hs
@@ -112,7 +112,7 @@ import Prelude
, Maybe(..), Either(..), Functor(..), String, IO
)
-{-# ANN module "HLint: ignore Use Control.Exception.catch" #-}
+
-- $setup
-- >>> :set -XNoOverloadedStrings
diff --git a/src/Control/Lens.hs b/src/Control/Lens.hs
index 8481e44..74700ae 100644
--- a/src/Control/Lens.hs
+++ b/src/Control/Lens.hs
@@ -59,7 +59,7 @@ module Control.Lens
, module Control.Lens.Review
, module Control.Lens.Setter
, module Control.Lens.Simple
-#ifndef DISABLE_TEMPLATE_HASKELL
+#if 0
, module Control.Lens.TH
#endif
, module Control.Lens.Traversal
@@ -89,7 +89,7 @@ import Control.Lens.Reified
import Control.Lens.Review
import Control.Lens.Setter
import Control.Lens.Simple
-#ifndef DISABLE_TEMPLATE_HASKELL
+#if 0
import Control.Lens.TH
#endif
import Control.Lens.Traversal
@@ -99,4 +99,4 @@ import Control.Lens.Wrapped
import Control.Lens.Zipper
import Control.Lens.Zoom
-{-# ANN module "HLint: ignore Use import/export shortcut" #-}
+
diff --git a/src/Control/Lens/Equality.hs b/src/Control/Lens/Equality.hs
index 982c2d7..3a3fe1a 100644
--- a/src/Control/Lens/Equality.hs
+++ b/src/Control/Lens/Equality.hs
@@ -28,8 +28,8 @@ module Control.Lens.Equality
import Control.Lens.Internal.Setter
import Control.Lens.Type
-{-# ANN module "HLint: ignore Use id" #-}
-{-# ANN module "HLint: ignore Eta reduce" #-}
+
+
-- $setup
-- >>> import Control.Lens
diff --git a/src/Control/Lens/Fold.hs b/src/Control/Lens/Fold.hs
index ae5100d..467eb37 100644
--- a/src/Control/Lens/Fold.hs
+++ b/src/Control/Lens/Fold.hs
@@ -161,9 +161,9 @@ import Data.Traversable
-- >>> let g :: Expr -> Expr; g = Debug.SimpleReflect.Vars.g
-- >>> let timingOut :: NFData a => a -> IO a; timingOut = fmap (fromMaybe (error "timeout")) . timeout (5*10^6) . evaluate . force
-{-# ANN module "HLint: ignore Eta reduce" #-}
-{-# ANN module "HLint: ignore Use camelCase" #-}
-{-# ANN module "HLint: ignore Use curry" #-}
+
+
+
infixl 8 ^.., ^?, ^?!, ^@.., ^@?, ^@?!
diff --git a/src/Control/Lens/Internal.hs b/src/Control/Lens/Internal.hs
index 295662e..539642d 100644
--- a/src/Control/Lens/Internal.hs
+++ b/src/Control/Lens/Internal.hs
@@ -43,4 +43,4 @@ import Control.Lens.Internal.Review
import Control.Lens.Internal.Setter
import Control.Lens.Internal.Zoom
-{-# ANN module "HLint: ignore Use import/export shortcut" #-}
+
diff --git a/src/Control/Lens/Internal/Zipper.hs b/src/Control/Lens/Internal/Zipper.hs
index 95875b7..76060be 100644
--- a/src/Control/Lens/Internal/Zipper.hs
+++ b/src/Control/Lens/Internal/Zipper.hs
@@ -53,7 +53,7 @@ import Data.Profunctor.Unsafe
-- >>> import Control.Lens
-- >>> import Data.Char
-{-# ANN module "HLint: ignore Use foldl" #-}
+
------------------------------------------------------------------------------
-- * Jacket
diff --git a/src/Control/Lens/Iso.hs b/src/Control/Lens/Iso.hs
index 62d40ef..235511a 100644
--- a/src/Control/Lens/Iso.hs
+++ b/src/Control/Lens/Iso.hs
@@ -70,8 +70,6 @@ import Data.Profunctor.Unsafe
import Unsafe.Coerce
#endif
-{-# ANN module "HLint: ignore Use on" #-}
-
-- $setup
-- >>> :set -XNoOverloadedStrings
-- >>> import Control.Lens
diff --git a/src/Control/Lens/Lens.hs b/src/Control/Lens/Lens.hs
index ff2a45f..5401ec4 100644
--- a/src/Control/Lens/Lens.hs
+++ b/src/Control/Lens/Lens.hs
@@ -120,7 +120,7 @@ import Data.Profunctor
import Data.Profunctor.Rep
import Data.Profunctor.Unsafe
-{-# ANN module "HLint: ignore Use ***" #-}
+
-- $setup
-- >>> :set -XNoOverloadedStrings
diff --git a/src/Control/Lens/Operators.hs b/src/Control/Lens/Operators.hs
index d88cb49..fa7b37e 100644
--- a/src/Control/Lens/Operators.hs
+++ b/src/Control/Lens/Operators.hs
@@ -107,4 +107,4 @@ import Control.Lens.Review
import Control.Lens.Setter
import Control.Lens.Zipper
-{-# ANN module "HLint: ignore Use import/export shortcut" #-}
+
diff --git a/src/Control/Lens/Plated.hs b/src/Control/Lens/Plated.hs
index 07d9212..27070c0 100644
--- a/src/Control/Lens/Plated.hs
+++ b/src/Control/Lens/Plated.hs
@@ -95,7 +95,7 @@ import Data.Data.Lens
import Data.Monoid
import Data.Tree
-{-# ANN module "HLint: ignore Reduce duplication" #-}
+
-- | A 'Plated' type is one where we know how to extract its immediate self-similar children.
--
diff --git a/src/Control/Lens/Setter.hs b/src/Control/Lens/Setter.hs
index 2acbfa6..4a12c6b 100644
--- a/src/Control/Lens/Setter.hs
+++ b/src/Control/Lens/Setter.hs
@@ -87,8 +87,6 @@ import Data.Profunctor
import Data.Profunctor.Rep
import Data.Profunctor.Unsafe
-{-# ANN module "HLint: ignore Avoid lambda" #-}
-
-- $setup
-- >>> import Control.Lens
-- >>> import Control.Monad.State
diff --git a/src/Control/Lens/TH.hs b/src/Control/Lens/TH.hs
index fbf4adb..ee723d7 100644
--- a/src/Control/Lens/TH.hs
+++ b/src/Control/Lens/TH.hs
@@ -87,7 +87,7 @@ import Language.Haskell.TH
import Language.Haskell.TH.Syntax
import Language.Haskell.TH.Lens
-{-# ANN module "HLint: ignore Use foldl" #-}
+
-- | Flags for 'Lens' construction
data LensFlag
diff --git a/src/Data/Data/Lens.hs b/src/Data/Data/Lens.hs
index cf1e7c9..b39dacf 100644
--- a/src/Data/Data/Lens.hs
+++ b/src/Data/Data/Lens.hs
@@ -65,9 +65,9 @@ import Data.Monoid
import GHC.Exts (realWorld#)
#endif
-{-# ANN module "HLint: ignore Eta reduce" #-}
-{-# ANN module "HLint: ignore Use foldl" #-}
-{-# ANN module "HLint: ignore Reduce duplication" #-}
+
+
+
-- $setup
-- >>> :set -XNoOverloadedStrings
--
1.8.2.rc3

View file

@ -0,0 +1,26 @@
From 392602f5ff14c0b5a801397d075ddcbcd890aa83 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 18 Apr 2013 17:50:59 -0400
Subject: [PATCH] fix cross build
---
src/Data/Profunctor/Unsafe.hs | 3 ---
1 file changed, 3 deletions(-)
diff --git a/src/Data/Profunctor/Unsafe.hs b/src/Data/Profunctor/Unsafe.hs
index 025c7c4..0249274 100644
--- a/src/Data/Profunctor/Unsafe.hs
+++ b/src/Data/Profunctor/Unsafe.hs
@@ -40,9 +40,6 @@ import Data.Tagged
import Prelude hiding (id,(.),sequence)
import Unsafe.Coerce
-{-# ANN module "Hlint: ignore Redundant lambda" #-}
-{-# ANN module "Hlint: ignore Collapse lambdas" #-}
-
infixr 9 #.
infixl 8 .#
--
1.8.2.rc3

View file

@ -0,0 +1,108 @@
From 3e988dec5ea248611d07d59914e3eb131dc6a165 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 18 Apr 2013 17:44:46 -0400
Subject: [PATCH] remove TH code
---
Text/Hamlet/XML.hs | 81 +-----------------------------------------------------
1 file changed, 1 insertion(+), 80 deletions(-)
diff --git a/Text/Hamlet/XML.hs b/Text/Hamlet/XML.hs
index f587410..bf8ce9e 100644
--- a/Text/Hamlet/XML.hs
+++ b/Text/Hamlet/XML.hs
@@ -1,8 +1,7 @@
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-missing-fields #-}
module Text.Hamlet.XML
- ( xml
- , xmlFile
+ (
) where
import Language.Haskell.TH.Syntax
@@ -18,81 +17,3 @@ import Data.String (fromString)
import qualified Data.Foldable as F
import Data.Maybe (fromMaybe)
import qualified Data.Map as Map
-
-xml :: QuasiQuoter
-xml = QuasiQuoter { quoteExp = strToExp }
-
-xmlFile :: FilePath -> Q Exp
-xmlFile = strToExp . TL.unpack <=< qRunIO . readUtf8File
-
-strToExp :: String -> Q Exp
-strToExp s =
- case parseDoc s of
- Error e -> error e
- Ok x -> docsToExp [] x
-
-docsToExp :: Scope -> [Doc] -> Q Exp
-docsToExp scope docs = [| concat $(fmap ListE $ mapM (docToExp scope) docs) |]
-
-docToExp :: Scope -> Doc -> Q Exp
-docToExp scope (DocTag name attrs cs) =
- [| [ X.NodeElement (X.Element ($(liftName name)) $(mkAttrs scope attrs) $(docsToExp scope cs))
- ] |]
-docToExp _ (DocContent (ContentRaw s)) = [| [ X.NodeContent (pack $(lift s)) ] |]
-docToExp scope (DocContent (ContentVar d)) = [| [ X.NodeContent $(return $ derefToExp scope d) ] |]
-docToExp scope (DocContent (ContentEmbed d)) = return $ derefToExp scope d
-docToExp scope (DocForall deref ident@(Ident ident') inside) = do
- let list' = derefToExp scope deref
- name <- newName ident'
- let scope' = (ident, VarE name) : scope
- inside' <- docsToExp scope' inside
- let lam = LamE [VarP name] inside'
- [| F.concatMap $(return lam) $(return list') |]
-docToExp scope (DocWith [] inside) = docsToExp scope inside
-docToExp scope (DocWith ((deref, ident@(Ident name)):dis) inside) = do
- let deref' = derefToExp scope deref
- name' <- newName name
- let scope' = (ident, VarE name') : scope
- inside' <- docToExp scope' (DocWith dis inside)
- let lam = LamE [VarP name'] inside'
- return $ lam `AppE` deref'
-docToExp scope (DocMaybe deref ident@(Ident name) just nothing) = do
- let deref' = derefToExp scope deref
- name' <- newName name
- let scope' = (ident, VarE name') : scope
- inside' <- docsToExp scope' just
- let inside'' = LamE [VarP name'] inside'
- nothing' <-
- case nothing of
- Nothing -> [| [] |]
- Just n -> docsToExp scope n
- [| maybe $(return nothing') $(return inside'') $(return deref') |]
-docToExp scope (DocCond conds final) = do
- unit <- [| () |]
- body <- fmap GuardedB $ mapM go $ conds ++ [(DerefIdent $ Ident "otherwise", fromMaybe [] final)]
- return $ CaseE unit [Match (TupP []) body []]
- where
- go (deref, inside) = do
- inside' <- docsToExp scope inside
- return (NormalG $ derefToExp scope deref, inside')
-
-mkAttrs :: Scope -> [(Maybe Deref, String, [Content])] -> Q Exp
-mkAttrs _ [] = [| Map.empty |]
-mkAttrs scope ((mderef, name, value):rest) = do
- rest' <- mkAttrs scope rest
- this <- [| Map.insert $(liftName name) (T.concat $(fmap ListE $ mapM go value)) |]
- let with = [| $(return this) $(return rest') |]
- case mderef of
- Nothing -> with
- Just deref -> [| if $(return $ derefToExp scope deref) then $(with) else $(return rest') |]
- where
- go (ContentRaw s) = [| pack $(lift s) |]
- go (ContentVar d) = return $ derefToExp scope d
- go ContentEmbed{} = error "Cannot use embed interpolation in attribute value"
-
-liftName :: String -> Q Exp
-liftName s = do
- X.Name local mns _ <- return $ fromString s
- case mns of
- Nothing -> [| X.Name (pack $(lift $ unpack local)) Nothing Nothing |]
- Just ns -> [| X.Name (pack $(lift $ unpack local)) (Just $ pack $(lift $ unpack ns)) Nothing |]
--
1.8.2.rc3