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
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.concatMap fixSpace $ T.map fixSlash $ either id id $ FP.toText fp
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.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