module Storage.Hashed.AnchoredPath
( Name(..), AnchoredPath(..), anchoredRoot, appendPath, anchorPath
, isPrefix, parent, parents, catPaths, flatten, makeName
, floatBS, floatPath ) where
import qualified Data.ByteString.Char8 as BS
import Data.List( isPrefixOf, inits )
import System.FilePath( (</>), splitDirectories, normalise, dropTrailingPathSeparator )
newtype Name = Name BS.ByteString deriving (Eq, Show, Ord)
newtype AnchoredPath = AnchoredPath [Name] deriving (Eq, Show, Ord)
isPrefix :: AnchoredPath -> AnchoredPath -> Bool
(AnchoredPath a) `isPrefix` (AnchoredPath b) = a `isPrefixOf` b
appendPath :: AnchoredPath -> Name -> AnchoredPath
appendPath (AnchoredPath p) n =
case n of
(Name s) | s == BS.empty -> AnchoredPath p
| s == BS.pack "." -> AnchoredPath p
| otherwise -> AnchoredPath $ p ++ [n]
catPaths :: AnchoredPath -> AnchoredPath -> AnchoredPath
catPaths (AnchoredPath p) (AnchoredPath n) = AnchoredPath $ p ++ n
parent :: AnchoredPath -> AnchoredPath
parent (AnchoredPath x) = AnchoredPath (init x)
parents :: AnchoredPath -> [AnchoredPath]
parents (AnchoredPath x) = map AnchoredPath . init . inits $ x
anchorPath :: FilePath -> AnchoredPath -> FilePath
anchorPath dir p = dir </> BS.unpack (flatten p)
floatBS :: BS.ByteString -> AnchoredPath
floatBS = AnchoredPath . map Name . takeWhile (not . BS.null) . BS.split '/'
flatten :: AnchoredPath -> BS.ByteString
flatten (AnchoredPath []) = BS.singleton '.'
flatten (AnchoredPath p) = BS.intercalate (BS.singleton '/')
[ n | (Name n) <- p ]
makeName :: String -> Name
makeName = Name . BS.pack
floatPath :: FilePath -> AnchoredPath
floatPath = AnchoredPath . map (Name . BS.pack) . splitDirectories
. normalise . dropTrailingPathSeparator
anchoredRoot :: AnchoredPath
anchoredRoot = AnchoredPath []