{-# LANGUAGE OverloadedStrings #-}
-- | Exposed for testing, do not use!
module Pantry.Internal
  ( parseTree
  , renderTree
  , Tree (..)
  , TreeEntry (..)
  , FileType(..)
  , mkSafeFilePath
  , pcHpackExecutable
  , normalizeParents
  , makeTarRelative
  , getGlobalHintsFile
  , hpackVersion
  , Storage
  , initStorage
  , withStorage_
  ) where

import Control.Exception (assert)
import Pantry.Types
import Pantry.SQLite (initStorage)
import Pantry.HPack (hpackVersion)
import qualified Data.Text as T
import Data.Maybe (fromMaybe)

-- | Like @System.FilePath.normalise@, however:
--
-- * Only works on relative paths, absolute paths fail
--
-- * Strips trailing slashes
--
-- * Only works on forward slashes, even on Windows
--
-- * Normalizes parent dirs @foo/../@ get stripped
--
-- * Cannot begin with a parent directory (@../@)
--
-- * Spelled like an American, sorry
normalizeParents
  :: FilePath
  -> Either String FilePath
normalizeParents :: FilePath -> Either FilePath FilePath
normalizeParents FilePath
"" = FilePath -> Either FilePath FilePath
forall a b. a -> Either a b
Left FilePath
"empty file path"
normalizeParents (Char
'/':FilePath
_) = FilePath -> Either FilePath FilePath
forall a b. a -> Either a b
Left FilePath
"absolute path"
normalizeParents (Char
'.':Char
'.':Char
'/':FilePath
_) = FilePath -> Either FilePath FilePath
forall a b. a -> Either a b
Left FilePath
"absolute path"
normalizeParents FilePath
fp = do
  -- Strip a single trailing, but not multiple
  let t0 :: Text
t0 = FilePath -> Text
T.pack FilePath
fp
      t :: Text
t = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
t0 (Maybe Text -> Text) -> Maybe Text -> Text
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
'/') -> FilePath -> Either FilePath ()
forall a b. a -> Either a b
Left FilePath
"multiple trailing slashes"
    Maybe (Text, Char)
_ -> () -> Either FilePath ()
forall a b. b -> Either a b
Right ()

  let c1 :: [Text]
c1 = (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') Text
t

  case [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
c1 of
    Text
".":[Text]
_ -> FilePath -> Either FilePath ()
forall a b. a -> Either a b
Left FilePath
"last component is a single dot"
    [Text]
_ -> () -> Either FilePath ()
forall a b. b -> Either a b
Right ()

  let c2 :: [Text]
c2 = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Text
x -> Bool -> Bool
not (Text -> Bool
T.null Text
x Bool -> Bool -> Bool
|| Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
".")) [Text]
c1

  let loop :: [a] -> [a] -> [a]
loop [] [a]
routput = [a] -> [a]
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
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
routput)

  case [Text] -> [Text] -> [Text]
forall a. (Eq a, IsString a) => [a] -> [a] -> [a]
loop [Text]
c2 [] of
    [] -> FilePath -> Either FilePath FilePath
forall a b. a -> Either a b
Left FilePath
"no non-empty components"
    [Text]
c' -> FilePath -> Either FilePath FilePath
forall a b. b -> Either a b
Right (FilePath -> Either FilePath FilePath)
-> FilePath -> Either FilePath FilePath
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"/" [Text]
c'

-- | Following tar file rules (Unix file paths only), make the second
-- file relative to the first file.
makeTarRelative
  :: FilePath -- ^ base file
  -> FilePath -- ^ relative part
  -> Either String FilePath
makeTarRelative :: FilePath -> FilePath -> Either FilePath FilePath
makeTarRelative FilePath
_ (Char
'/':FilePath
_) = FilePath -> Either FilePath FilePath
forall a b. a -> Either a b
Left FilePath
"absolute path found"
makeTarRelative FilePath
base FilePath
rel =
  case FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
base of
    [] -> FilePath -> Either FilePath FilePath
forall a b. a -> Either a b
Left FilePath
"cannot have empty base"
    Char
'/':FilePath
_ -> FilePath -> Either FilePath FilePath
forall a b. a -> Either a b
Left FilePath
"base cannot be a directory"
    Char
_:FilePath
rest -> FilePath -> Either FilePath FilePath
forall a b. b -> Either a b
Right (FilePath -> Either FilePath FilePath)
-> FilePath -> Either FilePath FilePath
forall a b. (a -> b) -> a -> b
$
      case (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/') FilePath
rest of
        Char
'/':FilePath
rest' -> FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
rest' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Char
'/' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
rel
        FilePath
rest' -> Bool -> FilePath -> FilePath
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
rest') FilePath
rel