diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,6 @@ +# Revision history for file-uri + +## 0.1.0.0 -- 2024-01-19 + +* Initial release + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2024, Julian Ospald + +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 Julian Ospald 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/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,9 @@ +# file-uri + +This Haskell library parses `file:///foo/bar` URIs based on RFC [8089](https://www.rfc-editor.org/rfc/rfc8089.html), +including windows filepaths. It's a subset of [RFC3986](https://www.rfc-editor.org/rfc/rfc3986), +but is better at interpreting the filepaths (especially on windows). + +Part of the code is based on [uri-bytestring](https://hackage.haskell.org/package/uri-bytestring) +from Soostone. + diff --git a/bench/Bench.hs b/bench/Bench.hs new file mode 100644 --- /dev/null +++ b/bench/Bench.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main (main) where + +import System.URI.File +import Test.Tasty.Bench + +main :: IO () +main = defaultMain benchMark + + +benchMark :: [Benchmark] +benchMark = + [ bgroup "parseFileURI StrictPosix" + [ bench "file://hostname/path/to/file/foo/bar/baz" + $ whnf (parseFileURI StrictPosix) "file://user@hostname/path/to/file/foo/bar/baz" + ] + , bgroup "parseFileURI ExtendedPosix" + [ bench "file://user@hostname/path/to/file/foo/bar/baz" + $ whnf (parseFileURI ExtendedPosix) "file://user@hostname/path/to/file/foo/bar/baz" + ] + , bgroup "parseFileURI ExtendedWindows" + [ bench "file://user@hostname/c|/path/to/file" + $ whnf (parseFileURI ExtendedWindows) "file://user@hostname/c|/path/to/file" + , bench "file://///host.example.com/path/to/file" + $ whnf (parseFileURI ExtendedWindows) "file://///host.example.com/path/to/file" + ] + ] + diff --git a/file-uri.cabal b/file-uri.cabal new file mode 100644 --- /dev/null +++ b/file-uri.cabal @@ -0,0 +1,66 @@ +cabal-version: 2.2 +name: file-uri +version: 0.1.0.0 +synopsis: File URI parsing +description: Parses file:///foo/bar URIs based on RFC 8089, including windows filepaths. +license: BSD-3-Clause +license-file: LICENSE +author: Julian Ospald +maintainer: hasufell@posteo.de +copyright: Julian Ospald 2024 +category: System +build-type: Simple +extra-doc-files: CHANGELOG.md + README.md +-- extra-source-files: +-- +source-repository head + type: git + location: https://github.com/haskell/ghcup-hs.git + +common warnings + ghc-options: -Wall + +library + import: warnings + exposed-modules: System.URI.File + System.URI.File.Internal + -- other-modules: + -- other-extensions: + build-depends: base >=4.12.0.0 && <4.20 + , bytestring >=0.9.1 + , attoparsec >=0.13.1.0 + hs-source-dirs: lib + default-language: Haskell2010 + +test-suite file-uri-test + import: warnings + default-language: Haskell2010 + -- other-modules: + -- other-extensions: + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Main.hs + build-depends: + base + , bytestring + , file-uri + , tasty + , tasty-hunit + +benchmark file-uri-benchmark + import: warnings + default-language: Haskell2010 + -- other-modules: + -- other-extensions: + type: exitcode-stdio-1.0 + hs-source-dirs: bench + ghc-options: -O2 "-with-rtsopts=-A32m" + if impl(ghc >= 8.6) + ghc-options: -fproc-alignment=64 + main-is: Bench.hs + build-depends: + base + , file-uri + , tasty-bench + diff --git a/lib/System/URI/File.hs b/lib/System/URI/File.hs new file mode 100644 --- /dev/null +++ b/lib/System/URI/File.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} + +-- | +-- +-- Module : System.URI.File +-- Description : ByteString file URI Parser +-- Copyright : (c) Soostone Inc., 2014-2015 +-- Michael Xavier, 2014-2015 +-- Julian Ospald, 2024 +-- License : BSD3 +-- Maintainer : hasufell@posteo.de +-- Stability : experimental +-- +-- @System.URI.File@ aims to be an compliant URI file parser that uses +-- efficient ByteStrings for parsing and representing the data. +-- +-- As such it only parses a subset of , but is better at interpreting +-- the file paths. __Filepaths are always absolute according to the spec__. +-- +-- Part of this module was ripped off of the package from +-- Soostone (specifically the host part parsing). +module System.URI.File ( + -- * Data types + FileURI(..) +, ParseSyntax(..) + + -- * Parsing +, parseFileURI + + -- * Attoparsec parsers +, fileURIStrictP +, fileURIExtendedPosixP +, fileURIExtendedWindowsP +) where + +import System.URI.File.Internal + diff --git a/lib/System/URI/File/Internal.hs b/lib/System/URI/File/Internal.hs new file mode 100644 --- /dev/null +++ b/lib/System/URI/File/Internal.hs @@ -0,0 +1,355 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} + +module System.URI.File.Internal where + +import Control.Applicative +import Control.Monad +import Data.Attoparsec.ByteString (Parser) +import Data.Bits +import Data.ByteString (ByteString) +import Data.Maybe +import Data.Ix (range) +import Data.Word +import qualified Data.Attoparsec.ByteString as A +import qualified Data.Attoparsec.ByteString.Char8 as A (decimal) + +import qualified Data.ByteString as BS + + +-- $setup +-- >>> :set -XOverloadedStrings + + + + ----------------------- + --[ Main data types ]-- + ----------------------- + + +-- | A parsed file URI. It can have an auth/host part. +data FileURI = FileURI { + fileAuth :: Maybe ByteString -- ^ optional host part ("localhost" is parsed as 'Nothing'); paths on windows go into 'filePath' and are not split + , filePath :: ByteString -- ^ the proper absolute filepath + } deriving (Show, Eq) + + +-- | RFC syntax configuration. +data ParseSyntax = StrictPosix -- ^ Only parses the strict syntax according to , which is technically posix paths. + | ExtendedPosix -- ^ Also parses extended user information described in + | ExtendedWindows -- ^ Parses windows paths according to , and . Unlike the spec, posix paths are rejected. + deriving (Show, Eq) + + + + + --------------- + --[ Parsing ]-- + --------------- + + +-- | Parse a file URI such as @file:\/\/\/foo\/bar@ into 'FileURI'. +-- +-- >>> parseFileURI StrictPosix "file:/path/to/file" +-- Right (FileURI {fileAuth = Nothing, filePath = "/path/to/file"}) +-- >>> parseFileURI StrictPosix "file:///path/to/file" +-- Right (FileURI {fileAuth = Nothing, filePath = "/path/to/file"}) +-- >>> parseFileURI StrictPosix "file://hostname/path/to/file" +-- Right (FileURI {fileAuth = Just "hostname", filePath = "/path/to/file"}) +-- >>> parseFileURI StrictPosix "file://localhost/path/to/file" +-- Right (FileURI {fileAuth = Nothing, filePath = "/path/to/file"}) +-- >>> parseFileURI StrictPosix "http://localhost/path/to/file" +-- Left "string" +-- >>> parseFileURI StrictPosix "/path/to/file" +-- Left "string" +-- >>> parseFileURI ExtendedWindows "file://///host.example.com/path/to/file" +-- Right (FileURI {fileAuth = Nothing, filePath = "//host.example.com/path/to/file"}) +-- >>> parseFileURI ExtendedWindows "file:///c:/path/to/file" +-- Right (FileURI {fileAuth = Nothing, filePath = "c:/path/to/file"}) +-- >>> parseFileURI ExtendedWindows "file:/c:/path/to/file" +-- Right (FileURI {fileAuth = Nothing, filePath = "c:/path/to/file"}) +-- >>> parseFileURI ExtendedWindows "file:c:/path/to/file" +-- Right (FileURI {fileAuth = Nothing, filePath = "c:/path/to/file"}) +parseFileURI :: ParseSyntax -- ^ RFC syntax configuration + -> ByteString -- ^ input file URI + -> Either String FileURI +parseFileURI StrictPosix = A.parseOnly (fileURIStrictP <* A.endOfInput) +parseFileURI ExtendedPosix = A.parseOnly (fileURIExtendedPosixP <* A.endOfInput) +parseFileURI ExtendedWindows = A.parseOnly (fileURIExtendedWindowsP <* A.endOfInput) + + + + -------------------------- + --[ Attoparsec parsers ]-- + -------------------------- + + +-- | Parse a file URI according to the , without +-- any extended rules, which is as follows: +-- +-- @ +-- file-URI = file-scheme ":" file-hier-part +-- +-- file-scheme = "file" +-- +-- file-hier-part = ( "//" auth-path ) +-- / local-path +-- +-- auth-path = [ file-auth ] path-absolute +-- +-- local-path = path-absolute +-- +-- file-auth = "localhost" +-- / host +-- @ +fileURIStrictP :: Parser FileURI +fileURIStrictP = A.string "file:" *> fileHierPart + where + fileHierPart = (A.string "//" *> authPath) <|> localPath + authPath = (\mfA -> FileURI (if mfA == Just "localhost" then Nothing else mfA)) + <$> A.option Nothing (Just <$> fileAuth') + <*> pathAbsoluteP + fileAuth' = A.string "localhost" <|> hostP + localPath = FileURI Nothing <$> pathAbsoluteP + +-- | Parse a file URI according to the , with +-- extended rule . +-- +-- @ +-- file-URI = file-scheme ":" file-hier-part +-- +-- file-scheme = "file" +-- +-- file-hier-part = ( "//" auth-path ) +-- / local-path +-- +-- auth-path = [ file-auth ] path-absolute +-- +-- local-path = path-absolute +-- +-- file-auth = "localhost" +-- / [ userinfo "@" ] host +-- @ +fileURIExtendedPosixP :: Parser FileURI +fileURIExtendedPosixP = A.string "file:" *> fileHierPart + where + fileHierPart = (A.string "//" *> authPath) <|> localPath + authPath = (\mfA -> FileURI (if mfA == Just "localhost" then Nothing else mfA)) + <$> A.option Nothing (Just <$> fileAuth') + <*> pathAbsoluteP + fileAuth' = A.string "localhost" <|> sequenceM [A.option BS.empty (sequenceM [userInfoP, "@"]), hostP] + localPath = FileURI Nothing <$> pathAbsoluteP + + +-- | Parse a file URI according for windows according to , +-- and +-- . Unlike the spec, posix paths are rejected. The ABNF +-- is a slight modification of . +-- +-- @ +-- file-URI = file-scheme ":" file-hier-part +-- +-- file-scheme = "file" +-- +-- file-hier-part = ( "//" auth-path ) +-- / local-path +-- +-- auth-path = [ file-auth ] file-absolute +-- / unc-authority path-absolute +-- +-- local-path = drive-letter path-absolute +-- / file-absolute +-- +-- file-auth = "localhost" +-- / [ userinfo "@" ] host +-- +-- unc-authority = 2*3"/" file-host +-- +-- file-host = inline-IP / IPv4address / reg-name +-- +-- inline-IP = "%5B" ( IPv6address / IPvFuture ) "%5D" +-- +-- file-absolute = "/" drive-letter path-absolute +-- +-- drive-letter = ALPHA ":" +-- / ALPHA "|" +-- @ +fileURIExtendedWindowsP :: Parser FileURI +fileURIExtendedWindowsP = A.string "file:" *> fileHierPart + where + fileHierPart = (A.string "//" *> authPath) <|> localPath + authPath = (\(mfA, p) -> FileURI (if mfA == Just "localhost" then Nothing else mfA) p) <$> ( + ((,) <$> A.option Nothing (Just <$> fileAuth') <*> fileAbsoluteP <* A.endOfInput) + <|> ((,) <$> pure Nothing <*> sequenceM [uncAuthorityP, pathAbsoluteP] <* A.endOfInput) + ) + fileAuth' = A.string "localhost" <|> sequenceM [A.option BS.empty (sequenceM [userInfoP, "@"]), hostP] + localPath = fmap (FileURI Nothing) $ (fileAbsoluteP <* A.endOfInput) <|> + (sequenceM [driveLetterP', pathAbsoluteP] <* A.endOfInput) + +pathAbsoluteP :: Parser ByteString +pathAbsoluteP = sequenceM [A.string "/", A.option BS.empty $ sequenceM [segmentNZP, pathAbEmpty]] + +uncAuthorityP :: Parser ByteString +uncAuthorityP = (\a b -> BS.concat [a, b]) <$> (A.string "//" <* (A.option BS.empty (A.string "/"))) <*> fileHostP + +fileHostP :: Parser ByteString +fileHostP = hostP + +fileAbsoluteP :: Parser ByteString +fileAbsoluteP = A.string "/" *> sequenceM [driveLetterP', pathAbsoluteP] + +driveLetterP :: Parser Word8 +driveLetterP = A.satisfy (A.inClass alpha) <* (A.string ":" <|> A.string "|") + +-- | Like 'driveLetterP', but appends ':'. +driveLetterP' :: Parser ByteString +driveLetterP' = ((<> ":") . BS.singleton) <$> driveLetterP + +userInfoP :: Parser ByteString +userInfoP = BS.pack <$> many (pctEncodedP <|> satisfyClass (":" ++ subDelims ++ unreserved)) + +hostP :: Parser ByteString +hostP = ipLiteralP <|> ipV4P <|> regNameP + +regNameP :: Parser ByteString +regNameP = BS.pack <$> A.many1 (pctEncodedP <|> satisfyClass (subDelims ++ unreserved)) + +ipLiteralP :: Parser ByteString +ipLiteralP = A.word8 oBracket *> (ipVFutureP <|> ipV6P) <* A.word8 cBracket + +-- | Parses IPVFuture addresses. See relevant section in RFC. +ipVFutureP :: Parser ByteString +ipVFutureP = do + _ <- A.word8 lowercaseV + ds <- A.takeWhile1 hexDigit + _ <- A.word8 period + rest <- A.takeWhile1 $ A.inClass $ subDelims ++ ":" ++ unreserved + return $ "v" <> ds <> "." <> rest + where + lowercaseV = 118 + +-- | Parses IPV6 addresses. See relevant section in RFC. +ipV6P :: Parser ByteString +ipV6P = do + leading <- h16s + elided <- maybe [] (const [""]) <$> optional (A.string "::") + trailing <- many (A.takeWhile (/= colon) <* A.word8 colon) + (finalChunkLen, final) <- finalChunk + let len = length (leading ++ trailing) + finalChunkLen + when (len > 8) $ fail "Too many digits in IPv6 address" + return $ rejoin $ [rejoin leading] ++ elided ++ trailing ++ maybeToList final + where + finalChunk = fromMaybe (0, Nothing) <$> optional (finalIpV4 <|> finalH16) + finalH16 = (1,) . Just <$> h16 + finalIpV4 = (2,) . Just <$> ipV4P + rejoin = BS.intercalate ":" + h16s = h16 `A.sepBy` A.word8 colon + h16 = mconcat <$> parseBetween 1 4 (A.takeWhile1 hexDigit) + +-- | Parses a valid IPV4 address +ipV4P :: Parser ByteString +ipV4P = + sequenceM + [ decOctet, + dot, + decOctet, + dot, + decOctet, + dot, + decOctet + ] + where + decOctet :: Parser ByteString + decOctet = do + (s, num) <- A.match A.decimal + let len = BS.length s + guard $ len <= 3 + guard $ num >= (1 :: Int) && num <= 255 + return s + dot = A.string "." + + + + +pathAbEmpty :: Parser ByteString +pathAbEmpty = fmap BS.concat . many . sequenceM $ [A.string "/", segmentP] + +segmentP :: Parser ByteString +segmentP = BS.pack <$> A.many' pcharP + +segmentNZP :: Parser ByteString +segmentNZP = BS.pack <$> A.many1 pcharP + +segmentNZNCP :: Parser ByteString +segmentNZNCP = BS.pack <$> A.many1 (pctEncodedP <|> satisfyClass (subDelims ++ "@" ++ unreserved)) + +pcharP :: Parser Word8 +pcharP = pctEncodedP <|> satisfyClass (subDelims ++ ":" ++ "@" ++ unreserved) + +pctEncodedP :: Parser Word8 +pctEncodedP = A.string "%" *> (decode <$> A.satisfy hexDigit <*> A.satisfy hexDigit) + where + decode w1 w2 = combine (hexVal w1) (hexVal w2) + hexVal w + | 48 <= w && w <= 57 = w - 48 -- 0 - 9 + | 65 <= w && w <= 70 = w - 55 -- A - F + | 97 <= w && w <= 102 = w - 87 -- a - f + | otherwise = error $ "Not a hex value: " <> show w + combine a b = shiftL a 4 .|. b + + + + + --------------------------- + --[ Word/String classes ]-- + --------------------------- + + +hexDigit :: Word8 -> Bool +hexDigit = A.inClass "0-9a-fA-F" + +unreserved :: String +unreserved = alphaNum ++ "~._-" + +subDelims :: String +subDelims = "!$&'()*+,;=" + +alphaNum :: String +alphaNum = alpha ++ digit + +alpha :: String +alpha = "a-zA-Z" + +digit :: String +digit = "0-9" + +oBracket :: Word8 +oBracket = 91 + +cBracket :: Word8 +cBracket = 93 + +colon :: Word8 +colon = 58 + +period :: Word8 +period = 46 + + + + ------------------------------------- + --[ Custom attoparsec combinators ]-- + ------------------------------------- + + +satisfyClass :: String -> Parser Word8 +satisfyClass = A.satisfy . A.inClass + +sequenceM :: Monad m => [(m ByteString)] -> m ByteString +sequenceM = fmap BS.concat . sequence + +parseBetween :: (Alternative m, Monad m) => Int -> Int -> m a -> m [a] +parseBetween a b f = A.choice parsers + where + parsers = map (`A.count` f) $ reverse $ range (a, b) + diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,131 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main (main) where + +import System.URI.File + +import Data.ByteString +import Test.Tasty +import Test.Tasty.HUnit + +import qualified Data.ByteString.Char8 as B8 + +main :: IO () +main = defaultMain tests + + +tests :: TestTree +tests = + testGroup + "System.URI.File" + [ parseFileURIStrictPosix + , parseFileURIExtendedPosix + , parseFileURIExtendedWindows + ] + +parseFileURIStrictPosix :: TestTree +parseFileURIStrictPosix = + testGroup + "parseFileURI (StrictPosix)" + [ parseTestURI StrictPosix "file:/path/to/file" + (Right FileURI { fileAuth = Nothing, filePath = "/path/to/file" }) + , parseTestURI StrictPosix "file:///path/to/file" + (Right FileURI { fileAuth = Nothing, filePath = "/path/to/file" }) + , parseTestURI StrictPosix "file://hostname/path/to/file" + (Right FileURI { fileAuth = Just "hostname", filePath = "/path/to/file" }) + , parseTestURI StrictPosix "file://localhost/path/to/file" + (Right FileURI { fileAuth = Nothing, filePath = "/path/to/file" }) + , parseTestURI StrictPosix "http://localhost/path/to/file" + (Left "string") + , parseTestURI StrictPosix "/path/to/file" + (Left "string") + + , parseTestURI StrictPosix "file:///c:/path/to/file" + (Right FileURI { fileAuth = Nothing, filePath = "/c:/path/to/file" }) + , parseTestURI StrictPosix "file:/c:/path/to/file" + (Right FileURI { fileAuth = Nothing, filePath = "/c:/path/to/file" }) + , parseTestURI StrictPosix "file:c:/path/to/file" + (Left "string") + + , parseTestURI StrictPosix "file://user@hostname/path/to/file" + (Left "endOfInput") + ] + +parseFileURIExtendedPosix :: TestTree +parseFileURIExtendedPosix = + testGroup + "parseFileURI (ExtendedPosix)" + [ parseTestURI ExtendedPosix "file:/path/to/file" + (Right FileURI { fileAuth = Nothing, filePath = "/path/to/file" }) + , parseTestURI ExtendedPosix "file:///path/to/file" + (Right FileURI { fileAuth = Nothing, filePath = "/path/to/file" }) + , parseTestURI ExtendedPosix "file://hostname/path/to/file" + (Right FileURI { fileAuth = Just "hostname", filePath = "/path/to/file" }) + , parseTestURI ExtendedPosix "file://localhost/path/to/file" + (Right FileURI { fileAuth = Nothing, filePath = "/path/to/file" }) + , parseTestURI ExtendedPosix "http://localhost/path/to/file" + (Left "string") + , parseTestURI ExtendedPosix "/path/to/file" + (Left "string") + + , parseTestURI ExtendedPosix "file:///c:/path/to/file" + (Right FileURI { fileAuth = Nothing, filePath = "/c:/path/to/file" }) + , parseTestURI ExtendedPosix "file:/c:/path/to/file" + (Right FileURI { fileAuth = Nothing, filePath = "/c:/path/to/file" }) + , parseTestURI ExtendedPosix "file:c:/path/to/file" + (Left "string") + + , parseTestURI ExtendedPosix "file://user@hostname/path/to/file" + (Right (FileURI {fileAuth = Just "user@hostname", filePath = "/path/to/file"})) + ] + +parseFileURIExtendedWindows :: TestTree +parseFileURIExtendedWindows = + testGroup + "parseFileURI (ExtendedWindows)" + [ parseTestURI ExtendedWindows "file:///c|/path/to/file" + (Right FileURI { fileAuth = Nothing, filePath = "c:/path/to/file" }) + , parseTestURI ExtendedWindows "file:/c|/path/to/file" + (Right FileURI { fileAuth = Nothing, filePath = "c:/path/to/file" }) + , parseTestURI ExtendedWindows "file:c|/path/to/file" + (Right FileURI { fileAuth = Nothing, filePath = "c:/path/to/file" }) + , parseTestURI ExtendedWindows "file://localhost/c|/path/to/file" + (Right FileURI { fileAuth = Nothing, filePath = "c:/path/to/file" }) + , parseTestURI ExtendedWindows "file://hostname/c|/path/to/file" + (Right FileURI { fileAuth = Just "hostname", filePath = "c:/path/to/file" }) + + , parseTestURI ExtendedWindows "file://user@hostname/c|/path/to/file" + (Right FileURI { fileAuth = Just "user@hostname", filePath = "c:/path/to/file" }) + + , parseTestURI ExtendedWindows "file:///c:/path/to/file" + (Right FileURI { fileAuth = Nothing, filePath = "c:/path/to/file" }) + , parseTestURI ExtendedWindows "file:/c:/path/to/file" + (Right FileURI { fileAuth = Nothing, filePath = "c:/path/to/file" }) + , parseTestURI ExtendedWindows "file:c:/path/to/file" + (Right FileURI { fileAuth = Nothing, filePath = "c:/path/to/file" }) + + , parseTestURI ExtendedWindows "file:/path/to/file" + (Left "Failed reading: satisfy") + , parseTestURI ExtendedWindows "file:///path/to/file" + (Left "Failed reading: satisfy") + , parseTestURI ExtendedWindows "file://hostname/path/to/file" + (Left "Failed reading: satisfy") + , parseTestURI ExtendedWindows "file://localhost/path/to/file" + (Left "Failed reading: satisfy") + , parseTestURI ExtendedWindows "http://localhost/path/to/file" + (Left "string") + , parseTestURI ExtendedWindows "/path/to/file" + (Left "string") + , parseTestURI ExtendedWindows "file:///c:\\path\\to\\file" + (Left "Failed reading: satisfy") + + , parseTestURI ExtendedWindows "file://///host.example.com/path/to/file" + (Right (FileURI {fileAuth = Nothing, filePath = "//host.example.com/path/to/file"})) + , parseTestURI ExtendedWindows "file:////system07/C$/" + (Right (FileURI {fileAuth = Nothing, filePath = "//system07/C$/"})) + ] + + +parseTestURI :: ParseSyntax -> ByteString -> Either String FileURI -> TestTree +parseTestURI cfg s r = testCase (B8.unpack s) $ parseFileURI cfg s @?= r +