Formats.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}

-- | This module provides some standard formats used for correctness across miss.
--   In many cases git only allows specific subsets of bytestrings due to parsing ambiguity
--   or system restrictions.

module Data.Git.Formats (
   SafeString()
 , safeString
 , getSS
 , LfFree
 , lfFree
 , isLfFree
 , getLfFree
 , module System.Filesystem.PathComponent
 ) where

import           Control.Monad.Fail
import qualified Data.ByteString       as B
import           Data.Maybe (fromMaybe)
import           Data.Semigroup
import           Data.String
import           Prelude hiding (fail)
import           System.Filesystem.PathComponent

-- | Strings allowed in email addresses.
newtype SafeString = SS {
      getSS :: B.ByteString -- ^ Get a 'B.ByteString' out of a 'SafeString'
    } deriving (Eq, Ord, Show, Semigroup, Monoid)

instance IsString SafeString where
    fromString = fromMaybe (error "Not a SafeString.") . safeString . fromString

-- | Try to make a 'SafeString'.
safeString :: MonadFail m => B.ByteString -> m SafeString
safeString b | isSafeString b = pure (SS b)
             | otherwise      = fail "Not a valid SafeString."

-- | True when 'safeString' will give back a 'Just'
isSafeString :: B.ByteString -> Bool
isSafeString "" = True
isSafeString b = safe (B.head b) && safe (B.last b) && safeInBetween
    where safe = (`B.notElem` " .,:;<>\"'")
          safeInBetween = B.any (`B.notElem` "<>\x0a\x00") b

-- | The restricted subset of 'B.ByteString's that do not include a linefeed.
newtype LfFree = LfFree {
    getLfFree :: B.ByteString -- ^ Get the 'B.ByteString' out of a 'LfFree'
  } deriving (Eq, Ord, Show, Monoid, Semigroup)

instance IsString LfFree where
  fromString = fromMaybe (error "Not a LfFree, contains a linefeed.") . lfFree . fromString

-- | True when 'lfFree' will result in a Just
isLfFree :: B.ByteString -> Bool
isLfFree = B.notElem 0x0a

-- | Safe constructor for 'LfFree'
lfFree :: MonadFail m => B.ByteString -> m LfFree
lfFree b | isLfFree b = pure (LfFree b)
         | otherwise  = fail "Not a valid LfFree; contains a linefeed."