Types.hs

{-|

Description: The types that make up this library.

-}

module Data.Conduit.VFS.Types
( FilePath
, ConduitT
, VFSSource
, VFSPipe
, VFSSink
, VFileType(..)
, ReadVFSC(..)
, WriteVFSC(..)
, VFSC(..)
, ByteString
) where

import ClassyPrelude hiding (ByteString)
import System.FilePath (FilePath, takeDirectory)
import Conduit
import qualified Data.ByteString.Lazy as LBS
import Data.Either (fromRight)
import Control.Monad.Extra (ifM)

type ByteString = LBS.ByteString

-- | The type of conduits that generate file paths.
type VFSSource m = ConduitT Void FilePath m ()

-- | The type of conduits that consume file paths and generate file paths.
type VFSPipe m = ConduitT FilePath FilePath m ()

-- | The type of conduits that consume file paths.
type VFSSink m r = ConduitT FilePath Void m r

-- | The types that our virtual file system supports.
data VFileType
	= VFile        -- ^ A node containing bytes
	| VDirectory   -- ^ A node containing zero or more other nodes
	deriving (Eq, Ord, Show, Generic, Typeable, Enum, Bounded)

-- | A class denoting that the type is usable as VFS conduits for reading.
class (Monad m) => ReadVFSC m where

	{-# MINIMAL ( vfsContentsEitherC | vfsContentsC ), vfsTypeC, ( vfsChildrenC | vfsDescendentsC ) #-}

	-- | Given an input path, generates a tuple of the input path itself and the input path's 'VFileType' (or 'Nothing' if the node does not exist).
	--   Note that a directory containing no elements may be reported by the VFS as not existing.
	vfsTypeC :: ConduitT FilePath (FilePath, Maybe VFileType) m ()

	-- | Given an input of 'FilePath' files, generates a tuple containing the input and the bytestring for the contents of the file.
	--   Note that the entire contents of the file are pulled into memory.  If the input 'FilePath' does not denote a 'VFile', it should be dropped.
	vfsContentsC :: ConduitT FilePath (FilePath, LBS.ByteString) m ()
	vfsContentsC = awaitForever $ \path -> do
			bytes <- yield path .| vfsContentsEitherC .| mapC (fromRight mempty) .| foldC
			yield (path, bytes)
	{-# INLINEABLE vfsContentsC #-}

	-- | Given an input of 'FilePath' files, generates a 'Left' of the input, followed by zero or more 'Right' values holding a bytestring. The concatenation of the
	--   'Right' values after a given 'Left' and before the next 'Left' (or EOS) are the bytes of the input value. If the input 'FilePath' does not denote a 'VFile',
	--   it should be dropped.
	vfsContentsEitherC :: ConduitT FilePath (Either FilePath LBS.ByteString) m ()
	vfsContentsEitherC = awaitForever $ \path -> do
			yield $ Left path
			bytes <- yield path .| vfsContentsC .| mapC snd .| foldC
			yield $ Right bytes
	{-# INLINEABLE vfsContentsEitherC #-}

	-- | Given an input of 'FilePath' directories, generates the non-special direct children, each path-prepended (using '</>') with the parent directory.
	--   If an input 'FilePath' is not a 'VDirectory', it should be passed through directly.
	vfsChildrenC :: VFSPipe m
	vfsChildrenC = awaitForever $ \path -> do
			children <- yield path .| vfsDescendentsC .| filterC (\it -> path == takeDirectory it ) .| sinkList -- TODO: Is this a bug if we encounter paths like /foo/bar/foo?
			yieldMany children
	{-# INLINEABLE vfsChildrenC #-}

	-- | Given an input of 'FilePath' directories, generates the non-special direct children that are files, each path-prepended (using '</>') with the
	--   parent directory.  If an input 'FilePath' is not a 'VDirectory', it should be passed through directly.
	vfsChildFilesC :: VFSPipe m
	vfsChildFilesC = vfsChildrenC .| vfsTypeC .| filterC ( (Just VFile ==) . snd ) .| mapC fst
	{-# INLINE vfsChildFilesC #-}

	-- | Given an input of 'FilePath' directories, generates the non-special direct children that are files, each path-prepended (using '</>') with the
	--   parent directory.  If an input 'FilePath' is not a 'VDirectory', it should be dropped.
	vfsChildDirsC :: VFSPipe m
	vfsChildDirsC = vfsChildrenC .| vfsTypeC .| filterC ( (Just VDirectory ==) . snd ) .| mapC fst
	{-# INLINE vfsChildDirsC #-}

	-- | Given an input of 'FilePath' directories, generates all the paths in the VFS that have the input as a prefix, with the outputs being each
	--   path-prepended (using '</>') with the corresponding input directory. If an  input 'FilePath' is not a 'VDirectory', it should be passed through
	--   directly.
	vfsDescendentsC :: VFSPipe m
	vfsDescendentsC = awaitForever $ \path -> do
			yield path
			loop path
		where
			loop path = do
				children <- yield path .| vfsChildrenC .| sinkList
				yieldMany children
				unless (null children) (sequence_ $ loop <$> children)
	{-# INLINEABLE vfsDescendentsC #-}

	-- | Given an input 'FilePath' directories, generates all the paths in the VFS that are files and have the input as a prefix, with the outputs being
	--   each path-prepended (using '</>') with the corresponding input directory. If an input 'FilePath' is not a 'VDirectory', it should be passed through directly.
	vfsDescFilesC :: VFSPipe m
	vfsDescFilesC = vfsDescendentsC .| vfsTypeC .| filterC (\(_, maybeFileType) -> Just VFile == maybeFileType) .| mapC fst
	{-# INLINE vfsDescFilesC #-}

	-- | Given an input of 'FilePath' directories, generates all the paths in the VFS that are directories and have the input as a prefix, with the outputs being
	--   each path-prepended (using '</>') with the corresponding input directory. If an input 'FilePath' is not a 'VDirectory', it should be dropped.
	vfsDescDirsC :: VFSPipe m
	vfsDescDirsC = vfsDescendentsC .| vfsTypeC .| filterC ( (Just VDirectory ==) . snd ) .| mapC fst
	{-# INLINE vfsDescDirsC #-}

-- | A class denoting that the type is usable as VFS conduits for writing.
class (Monad m) => WriteVFSC m where

	{-# MINIMAL (vfsWriteSink | vfsWriteEitherSink), vfsRemoveSink #-}

	-- | Given an input tuple of 'FilePath' files and their bytestring contents, writes the contents to the filepath. This write should be atomic if possible, and if
	--   it is not an atomic operation, the implementation's documentation should make this clear. This write should also create any necessary directories that may
	--   not have previously existed.
	vfsWriteSink :: ConduitT (FilePath, LBS.ByteString) Void m ()
	vfsWriteSink = awaitForever $ \(filepath, bs) -> yieldMany [Left filepath, Right bs] .| vfsWriteEitherSink
	{-# INLINE vfsWriteSink #-}

	-- | Given an input of either 'FilePath' files or bytestring contents, writes the contents to the filepath. The write is marked as complete when the next
	--   'FilePath' input or end-of-stream is reached. This write should be atomic at completion if possible, and if it is not an atomic operation, the
	--   implementation's documentation should make this clear. This write should also create any necessary directories that may not have previously existed.
	vfsWriteEitherSink :: ConduitT (Either FilePath LBS.ByteString) Void m ()
	vfsWriteEitherSink = awaitForever $ \case
			(Right _) -> return () -- WTF?
			(Left filepath) -> do
				bytes <- bytesLoop
				yield (filepath, bytes) .| vfsWriteSink
		where
			bytesLoop = peekC >>= \case
				(Just (Right bytes)) -> await >> (bytes <>) <$> bytesLoop
				_                    -> return mempty
	{-# INLINEABLE vfsWriteEitherSink #-}

	-- | Given 'FilePath' inputs, remove those nodes from the VFS. If the path denotes a directory, the directory is
	--   removed along with all of its descendents. If the path denotes a file, the file itself is removed. After a removal,
	--   any newly-empty directories may also be removed.
	vfsRemoveSink :: VFSSink m ()

-- | A class denoting that the type is usable as VFS conduits for both reading and writing.
class (ReadVFSC m, WriteVFSC m) => VFSC m where

	-- | Given an input tuple of a filetype and a filepath, ensure that a node exists at the filepath. If it does not exist, it should be created as either
	--   a directory or a zero-length file, as denoted by the filetype, with any missing parent directories created.  Note that a directory which does not
	--   contain a node may be reported as not present by the VFS, and therefore an acceptable implementation for 'VDirectory' inputs is simply 'return ()'
	vfsTouchSink :: ConduitT (VFileType, FilePath) Void m ()
	vfsTouchSink = awaitForever $ \(filetype, filepath) ->
		ifM
			( yield filepath .| vfsTypeC .| headC >>= \case
				Nothing -> return False
				(Just (_, Nothing)) -> return False
				(Just (_, Just foundFileType)) -> return $ filetype == foundFileType
			)
			( case filetype of
					VFile -> yield (filepath, mempty) .| vfsWriteSink
					VDirectory -> return ()
			)
			( return () )
	{-# INLINEABLE vfsTouchSink #-}