uri-conduit (empty) → 0.2.0
raw patch · 5 files changed
+271/−0 lines, 5 filesdep +basedep +bytestringdep +conduitsetup-changed
Dependencies added: base, bytestring, conduit, containers, failure, monad-control, network, system-fileio, system-filepath, text, transformers
Files
- LICENSE +30/−0
- Network/URI/Conduit.hs +154/−0
- Network/URI/Conduit/File.hs +53/−0
- Setup.lhs +7/−0
- uri-conduit.cabal +27/−0
+ LICENSE view
@@ -0,0 +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.
+ Network/URI/Conduit.hs view
@@ -0,0 +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 $ do+ case Map.lookup (uriScheme uri) sm >>= schemeReader of+ Nothing -> lift $ C.resourceThrow $ UnknownReadScheme uri+ Just f -> C.prepareSource $ f uri++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
+ Network/URI/Conduit/File.hs view
@@ -0,0 +1,53 @@+{-# 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+ parseURI $ T.append "file://" $ T.map fixSlash $ either id id $ FP.toText fp+ where+ fixSlash '\\' = '/'+ fixSlash c = c++fileScheme :: Scheme+fileScheme = Scheme+ { schemeNames = Set.singleton "file:"+ , schemeReader = Just $ sourceFile . toFilePath+ , schemeWriter = Just $ \uri -> C.Sink $ do+ let fp = toFilePath uri+ liftIO $ F.createTree $ FP.directory fp+ C.prepareSink $ CB.sinkFile (FP.encodeString fp)+ }++toFilePath :: URI -> FP.FilePath+toFilePath uri = FP.fromText $+ case uriAuthority uri of+ Nothing -> uriPath uri+ Just a -> T.concat [uriRegName a, uriPort a, T.pack $ unEscapeString $ T.unpack $ uriPath uri]++sourceFile :: C.ResourceIO m => FP.FilePath -> C.Source m S.ByteString+sourceFile = CB.sourceFile . FP.encodeString
+ Setup.lhs view
@@ -0,0 +1,7 @@+#!/usr/bin/env runhaskell++> module Main where+> import Distribution.Simple++> main :: IO ()+> main = defaultMain
+ uri-conduit.cabal view
@@ -0,0 +1,27 @@+Name: uri-conduit+Version: 0.2.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.0.0.2 && < 0.1+ , 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.2+ , monad-control >= 0.3 && < 0.4+ , system-filepath >= 0.4.3 && < 0.5+ , system-fileio >= 0.3.3 && < 0.4