uri-enumerator (empty) → 0.0.0
raw patch · 6 files changed
+305/−0 lines, 6 filesdep +basedep +bytestringdep +containerssetup-changed
Dependencies added: base, bytestring, containers, enumerator, failure, http-enumerator, http-types, monad-control, network, system-fileio, system-filepath, text, transformers
Files
- LICENSE +30/−0
- Network/URI/Enumerator.hs +142/−0
- Network/URI/Enumerator/File.hs +62/−0
- Network/URI/Enumerator/HTTP.hs +34/−0
- Setup.lhs +7/−0
- uri-enumerator.cabal +30/−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/Enumerator.hs view
@@ -0,0 +1,142 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+module Network.URI.Enumerator+ ( -- * 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 Data.Enumerator (Enumerator, throwError)+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)++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 m = Scheme+ { schemeNames :: Set.Set Text+ , schemeReader :: forall b. Maybe (URI -> Enumerator ByteString m b)+ , schemeWriter :: Maybe (URI -> Enumerator ByteString m () -> m ())+ }++type SchemeMap m = Map.Map Text (Scheme m)++toSchemeMap :: [Scheme m] -> SchemeMap m+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 :: Monad m => SchemeMap m -> URI -> Enumerator ByteString m b+readURI sm uri step =+ case Map.lookup (uriScheme uri) sm >>= schemeReader of+ Nothing -> throwError $ UnknownReadScheme uri+ Just f -> f uri step++writeURI :: Failure URIException m => SchemeMap m -> URI -> Enumerator ByteString m () -> m ()+writeURI sm uri enum =+ case Map.lookup (uriScheme uri) sm >>= schemeWriter of+ Nothing -> failure $ UnknownWriteScheme uri+ Just f -> f uri enum++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 :: Failure URIException m => SchemeMap m -> URI -> URI -> m ()+copyURI sm src dst = writeURI sm dst $ readURI sm src
+ Network/URI/Enumerator/File.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.URI.Enumerator.File+ ( decodeString+ , fileScheme+ , toFilePath+ ) where++import Prelude hiding (catch)+import Network.URI.Enumerator+import qualified Filesystem as F+import qualified Filesystem.Path.CurrentOS as FP+import qualified Data.Text as T+import qualified Data.Set as Set+import Data.Enumerator (run_, ($$), Enumerator, tryIO, Iteratee (..))+import Data.Enumerator.Binary (iterHandle, enumHandle)+import Control.Monad.IO.Class (liftIO)+import qualified System.IO as SIO+import Data.ByteString (ByteString)+import Control.Exception.Control (bracket, finally)+import Control.Monad.IO.Control (MonadControlIO)++-- | 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 :: MonadControlIO m => Scheme m+fileScheme = Scheme+ { schemeNames = Set.singleton "file:"+ , schemeReader = Just $ \uri step -> do+ let fp = toFilePath uri+ enumFile fp step+ , schemeWriter = Just $ \uri enum -> do+ let fp = toFilePath uri+ liftIO $ F.createTree $ FP.directory fp+ withFile fp F.WriteMode $ \h -> run_ $ enum $$ iterHandle h+ }++withFile :: MonadControlIO m => FP.FilePath -> F.IOMode -> (SIO.Handle -> m a) -> m a+withFile fp mode = bracket (liftIO $ SIO.openBinaryFile (FP.encodeString fp) mode) $ liftIO . SIO.hClose++enumFile :: MonadControlIO m => FP.FilePath -> Enumerator ByteString m a+enumFile fp step = do+ h <- tryIO $ SIO.openBinaryFile (FP.encodeString fp) SIO.ReadMode+ let iter = enumHandle 4096 h step+ Iteratee (finally (runIteratee iter) (liftIO $ SIO.hClose h))++toFilePath :: URI -> FP.FilePath+toFilePath uri = FP.fromText $+ case uriAuthority uri of+ Nothing -> uriPath uri+ Just a -> T.concat [uriRegName a, uriPort a, uriPath uri]
+ Network/URI/Enumerator/HTTP.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+module Network.URI.Enumerator.HTTP+ ( httpScheme+ , withManager+ ) where++import Network.URI.Enumerator (Scheme (..), toNetworkURI)+import Network.HTTP.Enumerator (Manager, parseUrl, httpRedirect, withManager, HttpException)+import Network.HTTP.Types (Status, status200)+import Data.Enumerator (throwError, returnI)+import Control.Exception (Exception)+import Data.Typeable (Typeable)+import qualified Data.Set as Set+import Control.Monad.Trans.Class (lift)+import Control.Monad.IO.Class (MonadIO)+import Control.Failure (Failure)++data HTTPURIException = NotOKResponse Status+ deriving (Show, Typeable)+instance Exception HTTPURIException++httpScheme :: (MonadIO m, Failure HttpException m) => Manager -> Scheme m+httpScheme m = Scheme+ { schemeNames = Set.fromList ["http:", "https:"]+ , schemeReader = Just $ \uri step -> do+ req <- lift $ parseUrl $ show $ toNetworkURI uri+ flip (httpRedirect req) m $ \status _ ->+ if status == status200+ then returnI step+ else throwError $ NotOKResponse status+ , schemeWriter = Nothing+ }
+ Setup.lhs view
@@ -0,0 +1,7 @@+#!/usr/bin/env runhaskell++> module Main where+> import Distribution.Simple++> main :: IO ()+> main = defaultMain
+ uri-enumerator.cabal view
@@ -0,0 +1,30 @@+Name: uri-enumerator+Version: 0.0.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.Enumerator+ Network.URI.Enumerator.File+ Network.URI.Enumerator.HTTP+ Build-depends: base >= 4 && < 5+ , enumerator >= 0.4.14 && < 0.5+ , text >= 0.5 && < 1.0+ , system-filepath >= 0.4 && < 0.5+ , system-fileio >= 0.3 && < 0.4+ , 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+ , http-types >= 0.6 && < 0.7+ , http-enumerator >= 0.6.6 && < 0.8+ , monad-control >= 0.2.0.3 && < 0.3