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

-- | Description: This module provides a type safe way to work with specific, well formed, components of a POSIX path. 

module System.Filesystem.PathComponent
 ( PathComponent
 , pathComponent
 , isPathComponent
 , getPC
 , slashify
 , splitPathComponents
 ) 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.Posix.FilePath
import           Text.Printf

-- | The restricted subset of 'B.ByteString's that are valid names in a POSIX path.
newtype PathComponent = PC {
    getPC :: B.ByteString -- ^ Get the 'B.ByteString' out of a 'PathComponent'
  } deriving (Eq, Ord, Show, Semigroup)

instance IsString PathComponent where
  fromString = fromMaybe (error "not a PathComponent") . pathComponent . fromString

-- | Safe constructor for 'PathComponent'
pathComponent :: MonadFail m => B.ByteString -> m PathComponent
pathComponent b | isPathComponent b = pure (PC b)
                | otherwise         = fail (printf "Not a valud PathComponent (%s)" (show b))

-- | True when 'pathComponent' will result in a Just
isPathComponent :: B.ByteString -> Bool
isPathComponent "" = False
isPathComponent b  = B.all (`B.notElem` "\x00/") b

-- | Add a trailing @/@ unconditionally.
slashify :: PathComponent -> B.ByteString
slashify (PC p) = B.snoc p 0x2f

-- | A version of 'splitDirectories' for 'PathComponent's.
splitPathComponents :: MonadFail m => RawFilePath -> m [PathComponent]
splitPathComponents =
  -- We can only get a Nothing when the future path component:
  --   1) contains a slash, which it can't due to coming from spliDirectories
  --   2) contains a Null byte, which is illegal in a path
  --      and thus the path is not a valid RawFilePath
  maybe (fail "path contained a null byte") pure . mapM pathComponent . splitDirectories