Path.hs

{-# LANGUAGE OverloadedStrings #-}

module Network.Wai.Application.Classic.Path (
    Path(..)
  , fromString, fromByteString
  , (+++), (</>), (<\>), (<.>)
  , breakAtSeparator, hasLeadingPathSeparator, hasTrailingPathSeparator
  , isSuffixOf
  ) where

import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as B8
import Data.Function
import Data.String
import Data.Word

----------------------------------------------------------------

-- | Smart file path.
data Path = Path {
    pathString :: FilePath
  , pathByteString :: ByteString
  }

instance IsString Path where
    fromString path = Path {
        pathString = path
      , pathByteString = B8.pack path
      }

instance Show Path where
    show = show . pathByteString

instance Eq Path where
    (==) = (==) `on` pathByteString

----------------------------------------------------------------

fromByteString :: ByteString -> Path
fromByteString path = Path {
    pathString = B8.unpack path
  , pathByteString = path
  }

-- pathDot :: Word8
-- pathDot = 46

pathDotBS :: ByteString
pathDotBS = "."

pathSep :: Word8
pathSep = 47

pathSepBS :: ByteString
pathSepBS = "/"

{-|
  Checking if the path ends with the path separator.

>>> hasLeadingPathSeparator "/foo/bar"
True
>>> hasLeadingPathSeparator "foo/bar"
False
-}
hasLeadingPathSeparator :: Path -> Bool
hasLeadingPathSeparator path
  | BS.null bs            = False
  | BS.head bs == pathSep = True
  | otherwise             = False
  where
    bs = pathByteString path

{-|
  Checking if the path ends with the path separator.

>>> hasTrailingPathSeparator "/foo/bar/"
True
>>> hasTrailingPathSeparator "/foo/bar"
False
-}
hasTrailingPathSeparator :: Path -> Bool
hasTrailingPathSeparator path
  | BS.null bs            = False
  | BS.last bs == pathSep = True
  | otherwise             = False
  where
    bs = pathByteString path

infixr +++

{-|
  Appending.
-}

(+++) :: Path -> Path -> Path
p1 +++ p2 = fromByteString p
  where
    p = pathByteString p1 `BS.append` pathByteString p2

{-|
  Appending with the file separator.

>>> "/foo" </> "bar"
"/foo/bar"
>>> "/foo/" </> "bar"
"/foo/bar"
>>> "/foo" </> "/bar"
"/foo/bar"
>>> "/foo/" </> "/bar"
"/foo/bar"
-}

(</>) :: Path -> Path -> Path
p1 </> p2
  | has1 && not has2 || not has1 && has2 = p1 +++ p2
  | has1      = fromByteString pp1
  | otherwise = fromByteString pp2
  where
    has1 = hasTrailingPathSeparator p1
    has2 = hasLeadingPathSeparator p2
    p1' = pathByteString p1
    p2' = pathByteString p2
    pp1 = p1' `BS.append` BS.tail p2'
    pp2 = BS.concat [p1',pathSepBS,p2']

{-|
  Removing prefix. The prefix of the second argument is removed
  from the first argument.

>>> "foobar" <\> "foo"
"bar"
>>> "foo" <\> "foobar"
""
>>> "foobar" <\> "baz"
"bar"
-}
(<\>) :: Path -> Path -> Path
p1 <\> p2 = fromByteString p
  where
    p1' = pathByteString p1
    p2' = pathByteString p2
    p = BS.drop (BS.length p2') p1'

{-|
  Adding suffix.
-}
(<.>) :: Path -> Path -> Path
p1 <.> p2 = fromByteString p
  where
    p1' = pathByteString p1
    p2' = pathByteString p2
    p = BS.concat [p1',pathDotBS,p2']

{-|
  Breaking at the first path separator.

>>> breakAtSeparator "/foo/bar/baz"
("","/foo/bar/baz")
>>> breakAtSeparator "foo/bar/baz"
("foo","/bar/baz")
>>> breakAtSeparator "foo"
("foo","")
-}
breakAtSeparator :: Path -> (Path,Path)
breakAtSeparator p = (fromByteString r1, fromByteString r2)
  where
    p' = pathByteString p
    (r1,r2) = BS.break (== pathSep) p'

isSuffixOf :: Path -> Path -> Bool
isSuffixOf p1 p2 = p1' `BS.isSuffixOf` p2'
  where
    p1' = pathByteString p1
    p2' = pathByteString p2