{-# LANGUAGE OverloadedStrings #-}
module Pantry.Internal
( parseTree
, renderTree
, Tree (..)
, TreeEntry (..)
, FileType(..)
, mkSafeFilePath
, pcHpackExecutable
, normalizeParents
, makeTarRelative
, getGlobalHintsFile
, hpackVersion
, Storage
, initStorage
, withStorage_
) where
import Control.Exception ( assert )
import Data.Maybe ( fromMaybe )
import qualified Data.Text as T
import Pantry.HPack ( hpackVersion )
import Pantry.SQLite ( initStorage )
import Pantry.Types
normalizeParents ::
FilePath
-> Either String FilePath
normalizeParents :: String -> Either String String
normalizeParents String
"" = forall a b. a -> Either a b
Left String
"empty file path"
normalizeParents (Char
'/':String
_) = forall a b. a -> Either a b
Left String
"absolute path"
normalizeParents (Char
'.':Char
'.':Char
'/':String
_) = forall a b. a -> Either a b
Left String
"absolute path"
normalizeParents String
fp = do
let t0 :: Text
t0 = String -> Text
T.pack String
fp
t :: Text
t = forall a. a -> Maybe a -> a
fromMaybe Text
t0 forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
T.stripSuffix Text
"/" Text
t0
case Text -> Maybe (Text, Char)
T.unsnoc Text
t of
Just (Text
_, Char
'/') -> forall a b. a -> Either a b
Left String
"multiple trailing slashes"
Maybe (Text, Char)
_ -> forall a b. b -> Either a b
Right ()
let c1 :: [Text]
c1 = (Char -> Bool) -> Text -> [Text]
T.split (forall a. Eq a => a -> a -> Bool
== Char
'/') Text
t
case forall a. [a] -> [a]
reverse [Text]
c1 of
Text
".":[Text]
_ -> forall a b. a -> Either a b
Left String
"last component is a single dot"
[Text]
_ -> forall a b. b -> Either a b
Right ()
let c2 :: [Text]
c2 = forall a. (a -> Bool) -> [a] -> [a]
filter (\Text
x -> Bool -> Bool
not (Text -> Bool
T.null Text
x Bool -> Bool -> Bool
|| Text
x forall a. Eq a => a -> a -> Bool
== Text
".")) [Text]
c1
let loop :: [a] -> [a] -> [a]
loop [] [a]
routput = forall a. [a] -> [a]
reverse [a]
routput
loop (a
"..":[a]
rest) (a
_:[a]
routput) = [a] -> [a] -> [a]
loop [a]
rest [a]
routput
loop (a
x:[a]
xs) [a]
routput = [a] -> [a] -> [a]
loop [a]
xs (a
xforall a. a -> [a] -> [a]
:[a]
routput)
case forall {a}. (Eq a, IsString a) => [a] -> [a] -> [a]
loop [Text]
c2 [] of
[] -> forall a b. a -> Either a b
Left String
"no non-empty components"
[Text]
c' -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"/" [Text]
c'
makeTarRelative ::
FilePath
-> FilePath
-> Either String FilePath
makeTarRelative :: String -> String -> Either String String
makeTarRelative String
_ (Char
'/':String
_) = forall a b. a -> Either a b
Left String
"absolute path found"
makeTarRelative String
base String
rel =
case forall a. [a] -> [a]
reverse String
base of
[] -> forall a b. a -> Either a b
Left String
"cannot have empty base"
Char
'/':String
_ -> forall a b. a -> Either a b
Left String
"base cannot be a directory"
Char
_:String
rest -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$
case forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/= Char
'/') String
rest of
Char
'/':String
rest' -> forall a. [a] -> [a]
reverse String
rest' forall a. [a] -> [a] -> [a]
++ Char
'/' forall a. a -> [a] -> [a]
: String
rel
String
rest' -> forall a. (?callStack::CallStack) => Bool -> a -> a
assert (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest') String
rel