module Hpack.Syntax.Git (
  isValidRef
) where

import           Imports

import           Data.Char (chr)
import           System.FilePath.Posix

-- https://git-scm.com/docs/git-check-ref-format
isValidRef :: String -> Bool
isValidRef :: String -> Bool
isValidRef String
ref =
     Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ref)
  Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf String
".lock") [String]
components)
  Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
".") [String]
components)
  Bool -> Bool -> Bool
&& Bool -> Bool
not (String
".." forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
ref)
  Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isControl String
ref)
  Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
" ~^:?*[\\") String
ref
  Bool -> Bool -> Bool
&& Bool -> Bool
not (String
"//" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
ref)
  Bool -> Bool -> Bool
&& Bool -> Bool
not (String
"/" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
ref)
  Bool -> Bool -> Bool
&& Bool -> Bool
not (String
"/" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
ref)
  Bool -> Bool -> Bool
&& Bool -> Bool
not (String
"." forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
ref)
  Bool -> Bool -> Bool
&& Bool -> Bool
not (String
"@{" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
ref)
  Bool -> Bool -> Bool
&& Bool -> Bool
not (String
ref forall a. Eq a => a -> a -> Bool
== String
"@")
  where
    components :: [String]
components = String -> [String]
splitDirectories String
ref

isControl :: Char -> Bool
isControl :: Char -> Bool
isControl Char
c = Char
c forall a. Ord a => a -> a -> Bool
< Int -> Char
chr Int
0o040 Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Int -> Char
chr Int
0o177