uri-conduit 0.2.1.1 → 0.3.0
raw patch · 5 files changed
+281/−291 lines, 5 filesdep ~conduitsetup-changed
Dependency ranges changed: conduit
Files
- LICENSE +30/−30
- Network/URI/Conduit.hs +154/−157
- Network/URI/Conduit/File.hs +63/−70
- Setup.lhs +7/−7
- uri-conduit.cabal +27/−27
LICENSE view
@@ -1,30 +1,30 @@-Copyright (c)2011, Michael Snoyman - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - * Neither the name of Michael Snoyman nor the names of other - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +Copyright (c)2011, Michael Snoyman++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Michael Snoyman nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
Network/URI/Conduit.hs view
@@ -1,157 +1,154 @@-{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE RankNTypes #-} -module Network.URI.Conduit - ( -- * Base datatypes - URI (..) - , URIAuth (..) - -- * Parsing - , parseURI - , parseURIReference - , parseRelativeReference - -- * Utils - , nullURI - , hasExtension - , relativeTo - -- * Conversion - , toNetworkURI - , fromNetworkURI - -- * Perform I/O - , Scheme (..) - , SchemeMap - , toSchemeMap - , readURI - , writeURI - , copyURI - -- * Exception - , URIException (..) - ) where - -import qualified Network.URI as N -import Data.Text (Text, cons, isSuffixOf, pack, unpack) -import qualified Data.Conduit as C -import Data.ByteString (ByteString) -import qualified Data.Map as Map -import qualified Data.Set as Set -import Control.Failure (Failure (..)) -import Control.Exception (Exception) -import Data.Typeable (Typeable) -import Control.Monad.Trans.Resource (ResourceIO) -import Control.Monad.Trans.Class (lift) - -data URI = URI - { uriScheme :: Text - , uriAuthority :: Maybe URIAuth - , uriPath :: Text - , uriQuery :: Text - , uriFragment :: Text - } - deriving (Show, Eq, Ord) - -data URIAuth = URIAuth - { uriUserInfo :: Text - , uriRegName :: Text - , uriPort :: Text - } - deriving (Show, Eq, Ord) - -parseURI :: Failure URIException m => Text -> m URI -parseURI t = maybe (failure $ InvalidURI t) (return . fromNetworkURI) $ N.parseURI $ unpack t - -parseURIReference :: Failure URIException m => Text -> m URI -parseURIReference t = maybe (failure $ InvalidURI t) (return . fromNetworkURI) $ N.parseURIReference $ unpack t - -parseRelativeReference :: Failure URIException m => Text -> m URI -parseRelativeReference t = maybe (failure $ InvalidRelativeReference t) (return . fromNetworkURI) $ N.parseRelativeReference $ unpack t - -hasExtension :: URI -> Text -> Bool -hasExtension URI { uriPath = p } t = (cons '.' t) `isSuffixOf` p - -data Scheme = Scheme - { schemeNames :: Set.Set Text - , schemeReader :: forall m. ResourceIO m => Maybe (URI -> C.Source m ByteString) - , schemeWriter :: forall m. ResourceIO m => Maybe (URI -> C.Sink ByteString m ()) - } - -type SchemeMap = Map.Map Text Scheme - -toSchemeMap :: [Scheme] -> SchemeMap -toSchemeMap = - Map.unions . map go - where - go s = - Map.unions $ map go' $ Set.toList $ schemeNames s - where - go' name = Map.singleton name s - -data URIException = UnknownReadScheme URI - | UnknownWriteScheme URI - | InvalidURI Text - | InvalidRelativeReference Text - deriving (Show, Typeable) -instance Exception URIException - -readURI :: ResourceIO m - => SchemeMap - -> URI - -> C.Source m ByteString -readURI sm uri = C.Source - { C.sourcePull = - case Map.lookup (uriScheme uri) sm >>= schemeReader of - Nothing -> lift $ C.resourceThrow $ UnknownReadScheme uri - Just f -> C.sourcePull $ f uri - , C.sourceClose = return () - } - -writeURI :: ResourceIO m - => SchemeMap - -> URI - -> C.Sink ByteString m () -writeURI sm uri = - case Map.lookup (uriScheme uri) sm >>= schemeWriter of - Nothing -> lift $ C.resourceThrow $ UnknownWriteScheme uri - Just f -> f uri - -toNetworkURI :: URI -> N.URI -toNetworkURI u = N.URI - { N.uriScheme = unpack $ uriScheme u - , N.uriAuthority = fmap go $ uriAuthority u - , N.uriPath = unpack $ uriPath u - , N.uriQuery = unpack $ uriQuery u - , N.uriFragment = unpack $ uriFragment u - } - where - go a = N.URIAuth - { N.uriUserInfo = unpack $ uriUserInfo a - , N.uriRegName = unpack $ uriRegName a - , N.uriPort = unpack $ uriPort a - } - -fromNetworkURI :: N.URI -> URI -fromNetworkURI u = URI - { uriScheme = pack $ N.uriScheme u - , uriAuthority = fmap go $ N.uriAuthority u - , uriPath = pack $ N.uriPath u - , uriQuery = pack $ N.uriQuery u - , uriFragment = pack $ N.uriFragment u - } - where - go a = URIAuth - { uriUserInfo = pack $ N.uriUserInfo a - , uriRegName = pack $ N.uriRegName a - , uriPort = pack $ N.uriPort a - } - -relativeTo :: URI -> URI -> Maybe URI -relativeTo a b = fmap fromNetworkURI $ toNetworkURI a `N.relativeTo` toNetworkURI b - -nullURI :: URI -nullURI = fromNetworkURI N.nullURI - -copyURI :: ResourceIO m - => SchemeMap - -> URI - -> URI - -> m () -copyURI sm src dst = C.runResourceT $ readURI sm src C.$$ writeURI sm dst +{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+module Network.URI.Conduit+ ( -- * Base datatypes+ URI (..)+ , URIAuth (..)+ -- * Parsing+ , parseURI+ , parseURIReference+ , parseRelativeReference+ -- * Utils+ , nullURI+ , hasExtension+ , relativeTo+ -- * Conversion+ , toNetworkURI+ , fromNetworkURI+ -- * Perform I/O+ , Scheme (..)+ , SchemeMap+ , toSchemeMap+ , readURI+ , writeURI+ , copyURI+ -- * Exception+ , URIException (..)+ ) where++import qualified Network.URI as N+import Data.Text (Text, cons, isSuffixOf, pack, unpack)+import qualified Data.Conduit as C+import Data.ByteString (ByteString)+import qualified Data.Map as Map+import qualified Data.Set as Set+import Control.Failure (Failure (..))+import Control.Exception (Exception)+import Data.Typeable (Typeable)+import Control.Monad.Trans.Class (lift)++data URI = URI+ { uriScheme :: Text+ , uriAuthority :: Maybe URIAuth+ , uriPath :: Text+ , uriQuery :: Text+ , uriFragment :: Text+ }+ deriving (Show, Eq, Ord)++data URIAuth = URIAuth+ { uriUserInfo :: Text+ , uriRegName :: Text+ , uriPort :: Text+ }+ deriving (Show, Eq, Ord)++parseURI :: Failure URIException m => Text -> m URI+parseURI t = maybe (failure $ InvalidURI t) (return . fromNetworkURI) $ N.parseURI $ unpack t++parseURIReference :: Failure URIException m => Text -> m URI+parseURIReference t = maybe (failure $ InvalidURI t) (return . fromNetworkURI) $ N.parseURIReference $ unpack t++parseRelativeReference :: Failure URIException m => Text -> m URI+parseRelativeReference t = maybe (failure $ InvalidRelativeReference t) (return . fromNetworkURI) $ N.parseRelativeReference $ unpack t++hasExtension :: URI -> Text -> Bool+hasExtension URI { uriPath = p } t = (cons '.' t) `isSuffixOf` p++data Scheme = Scheme+ { schemeNames :: Set.Set Text+ , schemeReader :: forall m. C.MonadResource m => Maybe (URI -> C.Source m ByteString)+ , schemeWriter :: forall m. C.MonadResource m => Maybe (URI -> C.Sink ByteString m ())+ }++type SchemeMap = Map.Map Text Scheme++toSchemeMap :: [Scheme] -> SchemeMap+toSchemeMap =+ Map.unions . map go+ where+ go s =+ Map.unions $ map go' $ Set.toList $ schemeNames s+ where+ go' name = Map.singleton name s++data URIException = UnknownReadScheme URI+ | UnknownWriteScheme URI+ | InvalidURI Text+ | InvalidRelativeReference Text+ deriving (Show, Typeable)+instance Exception URIException++readURI :: C.MonadResource m+ => SchemeMap+ -> URI+ -> C.Source m ByteString+readURI sm uri = C.SourceM+ (case Map.lookup (uriScheme uri) sm >>= schemeReader of+ Nothing -> C.monadThrow $ UnknownReadScheme uri+ Just f -> return $ f uri)+ (return ())++writeURI :: C.MonadResource m+ => SchemeMap+ -> URI+ -> C.Sink ByteString m ()+writeURI sm uri =+ case Map.lookup (uriScheme uri) sm >>= schemeWriter of+ Nothing -> lift $ C.monadThrow $ UnknownWriteScheme uri+ Just f -> f uri++toNetworkURI :: URI -> N.URI+toNetworkURI u = N.URI+ { N.uriScheme = unpack $ uriScheme u+ , N.uriAuthority = fmap go $ uriAuthority u+ , N.uriPath = unpack $ uriPath u+ , N.uriQuery = unpack $ uriQuery u+ , N.uriFragment = unpack $ uriFragment u+ }+ where+ go a = N.URIAuth+ { N.uriUserInfo = unpack $ uriUserInfo a+ , N.uriRegName = unpack $ uriRegName a+ , N.uriPort = unpack $ uriPort a+ }++fromNetworkURI :: N.URI -> URI+fromNetworkURI u = URI+ { uriScheme = pack $ N.uriScheme u+ , uriAuthority = fmap go $ N.uriAuthority u+ , uriPath = pack $ N.uriPath u+ , uriQuery = pack $ N.uriQuery u+ , uriFragment = pack $ N.uriFragment u+ }+ where+ go a = URIAuth+ { uriUserInfo = pack $ N.uriUserInfo a+ , uriRegName = pack $ N.uriRegName a+ , uriPort = pack $ N.uriPort a+ }++relativeTo :: URI -> URI -> Maybe URI+relativeTo a b = fmap fromNetworkURI $ toNetworkURI a `N.relativeTo` toNetworkURI b++nullURI :: URI+nullURI = fromNetworkURI N.nullURI++copyURI :: C.MonadResource m+ => SchemeMap+ -> URI+ -> URI+ -> m ()+copyURI sm src dst = readURI sm src C.$$ writeURI sm dst
Network/URI/Conduit/File.hs view
@@ -1,70 +1,63 @@-{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE FlexibleContexts #-} -module Network.URI.Conduit.File - ( decodeString - , fileScheme - , toFilePath - ) where - -import Prelude hiding (catch, FilePath) -import Network.URI (unEscapeString) -import Network.URI.Conduit -import qualified Filesystem.Path.CurrentOS as FP -import qualified Data.Text as T -import qualified Data.Set as Set -import qualified Data.Conduit as C -import qualified Data.Conduit.Binary as CB -import qualified Filesystem as F -import Control.Monad.IO.Class (liftIO) -import qualified Data.ByteString as S - --- | Converts a string, such as a command-line argument, into a URI. First --- tries to parse as an absolute URI. If this fails, it interprets as a --- relative or absolute filepath. -decodeString :: String -> IO URI -decodeString s = - case parseURI $ T.pack s of - Just u -> return u - Nothing -> do - wd <- F.getWorkingDirectory - let fp = wd FP.</> FP.decodeString s - t = T.append "file:///" $ T.concatMap fixSpace $ T.map fixSlash $ either id id $ FP.toText fp - parseURI t - where - fixSlash '\\' = '/' - fixSlash c = c - fixSpace ' ' = "%20" - fixSpace c = T.singleton c - -fileScheme :: Scheme -fileScheme = Scheme - { schemeNames = Set.singleton "file:" - , schemeReader = Just $ sourceFile . toFilePath - , schemeWriter = Just $ \uri -> C.SinkData - { C.sinkPush = \bs -> do - let fp = toFilePath uri - liftIO $ F.createTree $ FP.directory fp - C.sinkPush (CB.sinkFile $ FP.encodeString fp) bs - , C.sinkClose = return () - } - } - -toFilePath :: URI -> FP.FilePath -toFilePath uri = FP.fromText $ - case uriAuthority uri of - Nothing -> fixWinPath $ uriPath uri - Just a -> T.concat [uriRegName a, uriPort a, T.pack $ unEscapeString $ T.unpack $ fixWinPath $ uriPath uri] - where - fixWinPath t = - res - where - c1 = T.head t - c3 = T.head $ T.drop 2 t - len = T.length t - res = - if len > 3 && c1 == '/' && c3 == ':' - then T.tail t -- Windows absolute path - else t - -sourceFile :: C.ResourceIO m => FP.FilePath -> C.Source m S.ByteString -sourceFile = CB.sourceFile . FP.encodeString +{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+module Network.URI.Conduit.File+ ( decodeString+ , fileScheme+ , toFilePath+ ) where++import Prelude hiding (catch, FilePath)+import Network.URI (unEscapeString)+import Network.URI.Conduit+import qualified Filesystem.Path.CurrentOS as FP+import qualified Data.Text as T+import qualified Data.Set as Set+import qualified Data.Conduit as C+import qualified Data.Conduit.Binary as CB+import qualified Filesystem as F+import Control.Monad.IO.Class (liftIO)++-- | Converts a string, such as a command-line argument, into a URI. First+-- tries to parse as an absolute URI. If this fails, it interprets as a+-- relative or absolute filepath.+decodeString :: String -> IO URI+decodeString s =+ case parseURI $ T.pack s of+ Just u -> return u+ Nothing -> do+ wd <- F.getWorkingDirectory+ let fp = wd FP.</> FP.decodeString s+ t = T.append "file:///" $ T.concatMap fixSpace $ T.map fixSlash $ either id id $ FP.toText fp+ parseURI t+ where+ fixSlash '\\' = '/'+ fixSlash c = c+ fixSpace ' ' = "%20"+ fixSpace c = T.singleton c++fileScheme :: Scheme+fileScheme = Scheme+ { schemeNames = Set.singleton "file:"+ , schemeReader = Just $ CB.sourceFile . FP.encodeString . toFilePath+ , schemeWriter = Just $ \uri -> C.SinkM $ do+ let fp = toFilePath uri+ liftIO $ F.createTree $ FP.directory fp+ return $ CB.sinkFile $ FP.encodeString fp+ }++toFilePath :: URI -> FP.FilePath+toFilePath uri = FP.fromText $+ case uriAuthority uri of+ Nothing -> fixWinPath $ uriPath uri+ Just a -> T.concat [uriRegName a, uriPort a, T.pack $ unEscapeString $ T.unpack $ fixWinPath $ uriPath uri]+ where+ fixWinPath t =+ res+ where+ c1 = T.head t+ c3 = T.head $ T.drop 2 t+ len = T.length t+ res =+ if len > 3 && c1 == '/' && c3 == ':'+ then T.tail t -- Windows absolute path+ else t
Setup.lhs view
@@ -1,7 +1,7 @@-#!/usr/bin/env runhaskell - -> module Main where -> import Distribution.Simple - -> main :: IO () -> main = defaultMain +#!/usr/bin/env runhaskell++> module Main where+> import Distribution.Simple++> main :: IO ()+> main = defaultMain
uri-conduit.cabal view
@@ -1,27 +1,27 @@-Name: uri-conduit -Version: 0.2.1.1 -Synopsis: Read and write URIs -Homepage: http://github.com/snoyberg/xml -License: BSD3 -License-file: LICENSE -Author: Michael Snoyman -Maintainer: michaels@suite-sol.com -Category: Text -Build-type: Simple -Cabal-version: >=1.6 -Description: Read and write URIs - -Library - Exposed-modules: Network.URI.Conduit - Network.URI.Conduit.File - Build-depends: base >= 4 && < 5 - , conduit >= 0.2 && < 0.3 - , text >= 0.5 && < 1.0 - , transformers >= 0.2 && < 0.3 - , bytestring >= 0.9 && < 0.10 - , network >= 2.2 && < 2.4 - , containers >= 0.2 && < 0.5 - , failure >= 0.1 && < 0.3 - , monad-control >= 0.3 && < 0.4 - , system-filepath >= 0.4.3 && < 0.5 - , system-fileio >= 0.3.3 && < 0.4 +Name: uri-conduit+Version: 0.3.0+Synopsis: Read and write URIs+Homepage: http://github.com/snoyberg/xml+License: BSD3+License-file: LICENSE+Author: Michael Snoyman+Maintainer: michaels@suite-sol.com+Category: Text+Build-type: Simple+Cabal-version: >=1.6+Description: Read and write URIs++Library+ Exposed-modules: Network.URI.Conduit+ Network.URI.Conduit.File+ Build-depends: base >= 4 && < 5+ , conduit >= 0.3 && < 0.4+ , text >= 0.5 && < 1.0+ , transformers >= 0.2 && < 0.3+ , bytestring >= 0.9 && < 0.10+ , network >= 2.2 && < 2.4+ , containers >= 0.2 && < 0.5+ , failure >= 0.1 && < 0.3+ , monad-control >= 0.3 && < 0.4+ , system-filepath >= 0.4.3 && < 0.5+ , system-fileio >= 0.3.3 && < 0.4