From d195f807dac2351d29aeff00d2aee3e151eb82e3 Mon Sep 17 00:00:00 2001 From: Joey Hess 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| - -|] + 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| - - - - -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 . -{-# 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