diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -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. diff --git a/Network/URI/Enumerator/File.hs b/Network/URI/Enumerator/File.hs --- a/Network/URI/Enumerator/File.hs +++ b/Network/URI/Enumerator/File.hs @@ -1,63 +1,64 @@ -{-# LANGUAGE OverloadedStrings #-} -module Network.URI.Enumerator.File - ( decodeString - , fileScheme - , toFilePath - ) where - -import Prelude hiding (catch) -import Network.URI (unEscapeString) -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, T.pack $ unEscapeString $ T.unpack $ uriPath uri] +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleContexts #-} +module Network.URI.Enumerator.File + ( decodeString + , fileScheme + , toFilePath + ) where + +import Prelude hiding (catch) +import Network.URI (unEscapeString) +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 (MonadIO, liftIO) +import qualified System.IO as SIO +import Data.ByteString (ByteString) +import Control.Exception.Lifted (bracket, finally) +import Control.Monad.Trans.Control (MonadBaseControl) + +-- | 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 :: (MonadIO m, MonadBaseControl IO 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 :: (MonadIO m, MonadBaseControl IO 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 :: (MonadIO m, MonadBaseControl IO 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, T.pack $ unEscapeString $ T.unpack $ uriPath uri] diff --git a/Setup.lhs b/Setup.lhs --- a/Setup.lhs +++ b/Setup.lhs @@ -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 diff --git a/uri-enumerator-file.cabal b/uri-enumerator-file.cabal --- a/uri-enumerator-file.cabal +++ b/uri-enumerator-file.cabal @@ -1,26 +1,27 @@ -Name: uri-enumerator-file -Version: 0.1.0 -Synopsis: uri-enumerator backend for the file scheme -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: uri-enumerator backend for the file scheme - -Library - Exposed-modules: Network.URI.Enumerator.File - 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 - , monad-control >= 0.2.0.3 && < 0.3 - , uri-enumerator >= 0.1 && < 0.2 +Name: uri-enumerator-file +Version: 0.1.1 +Synopsis: uri-enumerator backend for the file scheme +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: uri-enumerator backend for the file scheme + +Library + Exposed-modules: Network.URI.Enumerator.File + 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 + , monad-control >= 0.3 && < 0.4 + , lifted-base >= 0.1 && < 0.2 + , uri-enumerator >= 0.1 && < 0.2