    {-# 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           Data.Maybe ( fromMaybe )
    import qualified Data.Text as T
    import           Pantry.HPack ( hpackVersion )
    import           Pantry.SQLite ( initStorage )
    import           Pantry.Types

    -- | 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 :: String -> Either String String
    normalizeParents String
    "" = String -> Either String String
    forall a b. a -> Either a b
    Left String
    "empty file path"
    normalizeParents (Char
    '/':String
    _) = String -> Either String String
    forall a b. a -> Either a b
    Left String
    "absolute path"
    normalizeParents (Char
    '.':Char
    '.':Char
    '/':String
    _) = String -> Either String String
    forall a b. a -> Either a b
    Left String
    "absolute path"
    normalizeParents String
    fp = do
      -- Strip a single trailing, but not multiple

      let t0 :: Text
    t0 = String -> Text
    T.pack String
    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
    '/') -> String -> Either String ()
    forall a b. a -> Either a b
    Left String
    "multiple trailing slashes"
        Maybe (Text, Char)
    _ -> () -> Either String ()
    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]
    _ -> String -> Either String ()
    forall a b. a -> Either a b
    Left String
    "last component is a single dot"
        [Text]
    _ -> () -> Either String ()
    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
        [] -> String -> Either String String
    forall a b. a -> Either a b
    Left String
    "no non-empty components"
        [Text]
    c' -> String -> Either String String
    forall a b. b -> Either a b
    Right (String -> Either String String) -> String -> Either String String
    forall a b. (a -> b) -> a -> b
    $ Text -> String
    T.unpack (Text -> String) -> Text -> String
    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 :: String -> String -> Either String String
    makeTarRelative String
    _ (Char
    '/':String
    _) = String -> Either String String
    forall a b. a -> Either a b
    Left String
    "absolute path found"
    makeTarRelative String
    base String
    rel =
      case String -> String
    forall a. [a] -> [a]
    reverse String
    base of
        [] -> String -> Either String String
    forall a b. a -> Either a b
    Left String
    "cannot have empty base"
        Char
    '/':String
    _ -> String -> Either String String
    forall a b. a -> Either a b
    Left String
    "base cannot be a directory"
        Char
    _:String
    rest -> String -> Either String String
    forall a b. b -> Either a b
    Right (String -> Either String String) -> String -> Either String String
    forall a b. (a -> b) -> a -> b
    $
          case (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '/') String
    rest of
            Char
    '/':String
    rest' -> String -> String
    forall a. [a] -> [a]
    reverse String
    rest' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Char
    '/' Char -> String -> String
    forall a. a -> [a] -> [a]
    : String
    rel
            String
    rest' -> Bool -> String -> String
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    rest') String
    rel