-- | This module implements relative paths within a Tree. All paths are -- anchored at a certain root (this is usually the Tree root). They are -- represented by a list of Names (these are just strict bytestrings). module Storage.Hashed.AnchoredPath ( Name(..), AnchoredPath(..), appendPath, anchorPath , isPrefix, parent, parents, catPaths, flatten, makeName -- * Unsafe functions. , nameToFilePath, nameFromFilePath, floatBS ) where import qualified Data.ByteString.Char8 as BS import Data.List( isPrefixOf, inits ) import System.FilePath( () ) ------------------------------- -- AnchoredPath utilities -- newtype Name = Name BS.ByteString deriving (Eq, Show, Ord) newtype AnchoredPath = AnchoredPath [Name] deriving (Eq, Show, Ord) -- | Unsafe. nameToFilePath :: Name -> FilePath nameToFilePath (Name p) = BS.unpack p -- | Unsafe. nameFromFilePath :: FilePath -> Name nameFromFilePath = Name . BS.pack -- | Check whether a path is a prefix of another path. isPrefix :: AnchoredPath -> AnchoredPath -> Bool (AnchoredPath a) `isPrefix` (AnchoredPath b) = a `isPrefixOf` b -- | Append an element to the end of a path. appendPath :: AnchoredPath -> Name -> AnchoredPath appendPath (AnchoredPath p) n = case n of (Name s) | s == BS.empty -> AnchoredPath p | otherwise -> AnchoredPath $ p ++ [n] -- | Catenate two paths together. Not very safe, but sometimes useful -- (e.g. when you are representing paths relative to a different point than a -- Tree root). catPaths :: AnchoredPath -> AnchoredPath -> AnchoredPath catPaths (AnchoredPath p) (AnchoredPath n) = AnchoredPath $ p ++ n -- | Get parent (path) of a given path. foo/bar/baz -> foo/bar parent :: AnchoredPath -> AnchoredPath parent (AnchoredPath x) = AnchoredPath (init x) -- | List all parents of a given path. foo/bar/baz -> [foo, foo/bar] parents :: AnchoredPath -> [AnchoredPath] parents (AnchoredPath x) = map AnchoredPath . init . inits $ x -- | Take a "root" directory and an anchored path and produce a full -- 'FilePath'. Moreover, you can use @anchorPath \"\"@ to get a relative -- 'FilePath'. anchorPath :: FilePath -> AnchoredPath -> FilePath anchorPath dir p = dir BS.unpack (flatten p) {-# INLINE anchorPath #-} floatBS :: BS.ByteString -> AnchoredPath floatBS = AnchoredPath . map Name . takeWhile (not . BS.null) . BS.split '/' flatten :: AnchoredPath -> BS.ByteString flatten (AnchoredPath p) = BS.intercalate (BS.singleton '/') [ n | (Name n) <- p ] makeName :: String -> Name makeName = Name . BS.pack