{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{- arch-tag: HVFS instance helpers
Copyright (c) 2004-2011 John Goerzen <jgoerzen@complete.org>

All rights reserved.

For license and copyright information, see the file LICENSE
-}

{- |
   Module     : System.IO.HVFS.InstanceHelpers
   Copyright  : Copyright (C) 2004-2011 John Goerzen
   SPDX-License-Identifier: BSD-3-Clause

   Stability  : stable
   Portability: portable

Utilities for creating instances of the items defined in
"System.IO.HVFS".

-}

module System.IO.HVFS.InstanceHelpers(-- * HVFSStat objects
                                        SimpleStat(..),
                                        -- * HVFS objects & types
                                        -- ** MemoryVFS
                                        MemoryVFS,
                                        newMemoryVFS, newMemoryVFSRef,
                                        MemoryNode,
                                        MemoryEntry(..),
                                        -- * Utilities
                                        nice_slice, getFullPath,
                                        getFullSlice)
    where

import           Data.IORef            (IORef, newIORef, readIORef, writeIORef)
import           Data.List             (genericLength)
import           System.FilePath       (isPathSeparator, pathSeparator, (</>))
import           System.IO             ( IOMode(ReadMode) )
import           System.IO.Error       (doesNotExistErrorType,
                                        illegalOperationErrorType,
                                        permissionErrorType)
import System.IO.HVFS
    ( FileOffset,
      HVFSOpenable(vOpen),
      HVFS(vGetDirectoryContents, vGetFileStatus, vSetCurrentDirectory,
           vRaiseError, vGetCurrentDirectory),
      HVFSStat(vIsRegularFile, vFileSize, vIsDirectory),
      HVFSOpenEncap(HVFSOpenEncap),
      HVFSStatEncap(HVFSStatEncap) )
import           System.IO.HVIO        (newStreamReader)
import           System.Path           (absNormPath)
import           System.Path.NameManip (slice_path)

{- | A simple "System.IO.HVFS.HVFSStat"
class that assumes that everything is either a file
or a directory. -}
data SimpleStat = SimpleStat {
                              SimpleStat -> Bool
isFile   :: Bool, -- ^ True if file, False if directory
                              SimpleStat -> FileOffset
fileSize :: FileOffset -- ^ Set to 0 if unknown or a directory
                             } deriving (Int -> SimpleStat -> ShowS
[SimpleStat] -> ShowS
SimpleStat -> [Char]
(Int -> SimpleStat -> ShowS)
-> (SimpleStat -> [Char])
-> ([SimpleStat] -> ShowS)
-> Show SimpleStat
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SimpleStat -> ShowS
showsPrec :: Int -> SimpleStat -> ShowS
$cshow :: SimpleStat -> [Char]
show :: SimpleStat -> [Char]
$cshowList :: [SimpleStat] -> ShowS
showList :: [SimpleStat] -> ShowS
Show, SimpleStat -> SimpleStat -> Bool
(SimpleStat -> SimpleStat -> Bool)
-> (SimpleStat -> SimpleStat -> Bool) -> Eq SimpleStat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SimpleStat -> SimpleStat -> Bool
== :: SimpleStat -> SimpleStat -> Bool
$c/= :: SimpleStat -> SimpleStat -> Bool
/= :: SimpleStat -> SimpleStat -> Bool
Eq)
instance HVFSStat SimpleStat where
    vIsRegularFile :: SimpleStat -> Bool
vIsRegularFile SimpleStat
x = SimpleStat -> Bool
isFile SimpleStat
x
    vIsDirectory :: SimpleStat -> Bool
vIsDirectory SimpleStat
x = Bool -> Bool
not (SimpleStat -> Bool
isFile SimpleStat
x)
    vFileSize :: SimpleStat -> FileOffset
vFileSize SimpleStat
x = SimpleStat -> FileOffset
fileSize SimpleStat
x

----------------------------------------------------------------------
-- In-Memory Tree Types
----------------------------------------------------------------------
{- | The basic node of a 'MemoryVFS'.  The String corresponds to the filename,
and the entry to the contents. -}
type MemoryNode = (String, MemoryEntry)

{- | The content of a file or directory in a 'MemoryVFS'. -}
data MemoryEntry = MemoryDirectory [MemoryNode]
                 | MemoryFile String
                   deriving (MemoryEntry -> MemoryEntry -> Bool
(MemoryEntry -> MemoryEntry -> Bool)
-> (MemoryEntry -> MemoryEntry -> Bool) -> Eq MemoryEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MemoryEntry -> MemoryEntry -> Bool
== :: MemoryEntry -> MemoryEntry -> Bool
$c/= :: MemoryEntry -> MemoryEntry -> Bool
/= :: MemoryEntry -> MemoryEntry -> Bool
Eq, Int -> MemoryEntry -> ShowS
[MemoryEntry] -> ShowS
MemoryEntry -> [Char]
(Int -> MemoryEntry -> ShowS)
-> (MemoryEntry -> [Char])
-> ([MemoryEntry] -> ShowS)
-> Show MemoryEntry
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MemoryEntry -> ShowS
showsPrec :: Int -> MemoryEntry -> ShowS
$cshow :: MemoryEntry -> [Char]
show :: MemoryEntry -> [Char]
$cshowList :: [MemoryEntry] -> ShowS
showList :: [MemoryEntry] -> ShowS
Show)

{- | An in-memory read\/write filesystem.  Think of it as a dynamically
resizable ramdisk written in Haskell. -}
data MemoryVFS = MemoryVFS
               { MemoryVFS -> IORef [MemoryNode]
content :: IORef [MemoryNode],
                 MemoryVFS -> IORef [Char]
cwd     :: IORef FilePath
               }

instance Show MemoryVFS where
    show :: MemoryVFS -> [Char]
show MemoryVFS
_ = [Char]
"<MemoryVFS>"

-- | Create a new 'MemoryVFS' object from an existing tree.
-- An empty filesystem may be created by using @[]@ for the parameter.
newMemoryVFS :: [MemoryNode] -> IO MemoryVFS
newMemoryVFS :: [MemoryNode] -> IO MemoryVFS
newMemoryVFS [MemoryNode]
s = do r <- [MemoryNode] -> IO (IORef [MemoryNode])
forall a. a -> IO (IORef a)
newIORef [MemoryNode]
s
                    newMemoryVFSRef r

-- | Create a new 'MemoryVFS' object using an IORef to an
-- existing tree.
newMemoryVFSRef :: IORef [MemoryNode] -> IO MemoryVFS
newMemoryVFSRef :: IORef [MemoryNode] -> IO MemoryVFS
newMemoryVFSRef IORef [MemoryNode]
r = do
                    c <- [Char] -> IO (IORef [Char])
forall a. a -> IO (IORef a)
newIORef [Char
pathSeparator]
                    return (MemoryVFS {content = r, cwd = c})

{- | Similar to 'System.Path.NameManip' but the first element
won't be @\/@.

>nice_slice "/" -> []
>nice_slice "/foo/bar" -> ["foo", "bar"]
-}
nice_slice :: String -> [String]
nice_slice :: [Char] -> [[Char]]
nice_slice [Char]
path
  | [Char]
path [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char
pathSeparator] = []
  | Bool
otherwise =
      let sliced1 :: [[Char]]
sliced1 = [Char] -> [[Char]]
slice_path [Char]
path
          h :: [Char]
h = [[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
head [[Char]]
sliced1
          t :: [[Char]]
t = [[Char]] -> [[Char]]
forall a. HasCallStack => [a] -> [a]
tail [[Char]]
sliced1
          newh :: [Char]
newh =  if Char -> Bool
isPathSeparator ([Char] -> Char
forall a. HasCallStack => [a] -> a
head [Char]
h) then ShowS
forall a. HasCallStack => [a] -> [a]
tail [Char]
h else [Char]
h
          sliced2 :: [[Char]]
sliced2 = [Char]
newh [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
t
      in [[Char]]
sliced2

{- | Gets a full path, after investigating the cwd.
-}
getFullPath :: HVFS a => a -> String -> IO String
getFullPath :: forall a. HVFS a => a -> [Char] -> IO [Char]
getFullPath a
fs [Char]
path =
    do dir <- a -> IO [Char]
forall a. HVFS a => a -> IO [Char]
vGetCurrentDirectory a
fs
       case (absNormPath dir path) of
           Maybe [Char]
Nothing -> a -> IOErrorType -> [Char] -> Maybe [Char] -> IO [Char]
forall c. a -> IOErrorType -> [Char] -> Maybe [Char] -> IO c
forall a c.
HVFS a =>
a -> IOErrorType -> [Char] -> Maybe [Char] -> IO c
vRaiseError a
fs IOErrorType
doesNotExistErrorType
                        ([Char]
"Trouble normalizing path " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
path) ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char]
dir [Char] -> ShowS
</> [Char]
path))
           Just [Char]
newpath -> [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
newpath

{- | Gets the full path via 'getFullPath', then splits it via 'nice_slice'.
-}
getFullSlice :: HVFS a => a -> String -> IO [String]
getFullSlice :: forall a. HVFS a => a -> [Char] -> IO [[Char]]
getFullSlice a
fs [Char]
fp =
    do newpath <- a -> [Char] -> IO [Char]
forall a. HVFS a => a -> [Char] -> IO [Char]
getFullPath a
fs [Char]
fp
       return (nice_slice newpath)

-- | Find an element on the tree, assuming a normalized path
findMelem :: MemoryVFS -> String -> IO MemoryEntry
findMelem :: MemoryVFS -> [Char] -> IO MemoryEntry
findMelem MemoryVFS
x [Char]
path
  | [Char]
path [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char
pathSeparator] = IORef [MemoryNode] -> IO [MemoryNode]
forall a. IORef a -> IO a
readIORef (MemoryVFS -> IORef [MemoryNode]
content MemoryVFS
x) IO [MemoryNode]
-> ([MemoryNode] -> IO MemoryEntry) -> IO MemoryEntry
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MemoryEntry -> IO MemoryEntry
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (MemoryEntry -> IO MemoryEntry)
-> ([MemoryNode] -> MemoryEntry) -> [MemoryNode] -> IO MemoryEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MemoryNode] -> MemoryEntry
MemoryDirectory
  | Bool
otherwise =
    let sliced1 :: [[Char]]
sliced1 = [Char] -> [[Char]]
slice_path [Char]
path
        h :: [Char]
h = [[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
head [[Char]]
sliced1
        t :: [[Char]]
t = [[Char]] -> [[Char]]
forall a. HasCallStack => [a] -> [a]
tail [[Char]]
sliced1
        newh :: [Char]
newh = if ([Char]
h [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char
pathSeparator]) Bool -> Bool -> Bool
&& Char -> Bool
isPathSeparator ([Char] -> Char
forall a. HasCallStack => [a] -> a
head [Char]
h) then ShowS
forall a. HasCallStack => [a] -> [a]
tail [Char]
h else [Char]
h
        sliced2 :: [[Char]]
sliced2 = [Char]
newh [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
t

        -- Walk the tree
        walk :: MemoryEntry -> [String] -> Either String MemoryEntry
        -- Empty list -- return the item we have
        walk :: MemoryEntry -> [[Char]] -> Either [Char] MemoryEntry
walk MemoryEntry
y [[Char]]
zs
          | [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
zs = MemoryEntry -> Either [Char] MemoryEntry
forall a b. b -> Either a b
Right MemoryEntry
y
          | [[Char]]
zs [[Char]] -> [[Char]] -> Bool
forall a. Eq a => a -> a -> Bool
== [[Char
pathSeparator]] = MemoryEntry -> Either [Char] MemoryEntry
forall a b. b -> Either a b
Right MemoryEntry
y
          | Bool
otherwise = case MemoryEntry
y of
              MemoryFile [Char]
_ -> [Char] -> Either [Char] MemoryEntry
forall a b. a -> Either a b
Left ([Char] -> Either [Char] MemoryEntry)
-> [Char] -> Either [Char] MemoryEntry
forall a b. (a -> b) -> a -> b
$ [Char]
"Attempt to look up name " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
head [[Char]]
zs [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" in file"
              MemoryDirectory [MemoryNode]
y ->
                let newentry :: Either [Char] MemoryEntry
newentry = case [Char] -> [MemoryNode] -> Maybe MemoryEntry
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ([[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
head [[Char]]
zs) [MemoryNode]
y of
                                  Maybe MemoryEntry
Nothing -> [Char] -> Either [Char] MemoryEntry
forall a b. a -> Either a b
Left ([Char] -> Either [Char] MemoryEntry)
-> [Char] -> Either [Char] MemoryEntry
forall a b. (a -> b) -> a -> b
$ [Char]
"Couldn't find entry " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
head [[Char]]
zs
                                  Just MemoryEntry
a -> MemoryEntry -> Either [Char] MemoryEntry
forall a b. b -> Either a b
Right MemoryEntry
a
                in do newobj <- Either [Char] MemoryEntry
newentry
                      walk newobj (tail zs)
    in do
       c <- IORef [MemoryNode] -> IO [MemoryNode]
forall a. IORef a -> IO a
readIORef (IORef [MemoryNode] -> IO [MemoryNode])
-> IORef [MemoryNode] -> IO [MemoryNode]
forall a b. (a -> b) -> a -> b
$ MemoryVFS -> IORef [MemoryNode]
content MemoryVFS
x
       case walk (MemoryDirectory c) (sliced2) of
         Left [Char]
err     -> MemoryVFS
-> IOErrorType -> [Char] -> Maybe [Char] -> IO MemoryEntry
forall a c.
HVFS a =>
a -> IOErrorType -> [Char] -> Maybe [Char] -> IO c
forall c.
MemoryVFS -> IOErrorType -> [Char] -> Maybe [Char] -> IO c
vRaiseError MemoryVFS
x IOErrorType
doesNotExistErrorType [Char]
err Maybe [Char]
forall a. Maybe a
Nothing
         Right MemoryEntry
result -> MemoryEntry -> IO MemoryEntry
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MemoryEntry
result

-- | Find an element on the tree, normalizing the path first
getMelem :: MemoryVFS -> String -> IO MemoryEntry
getMelem :: MemoryVFS -> [Char] -> IO MemoryEntry
getMelem MemoryVFS
x [Char]
s =
    do base <- IORef [Char] -> IO [Char]
forall a. IORef a -> IO a
readIORef (IORef [Char] -> IO [Char]) -> IORef [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ MemoryVFS -> IORef [Char]
cwd MemoryVFS
x
       case absNormPath base s of
           Maybe [Char]
Nothing -> MemoryVFS
-> IOErrorType -> [Char] -> Maybe [Char] -> IO MemoryEntry
forall a c.
HVFS a =>
a -> IOErrorType -> [Char] -> Maybe [Char] -> IO c
forall c.
MemoryVFS -> IOErrorType -> [Char] -> Maybe [Char] -> IO c
vRaiseError MemoryVFS
x IOErrorType
doesNotExistErrorType
                        ([Char]
"Trouble normalizing path " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
s) ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
s)
           Just [Char]
newpath -> MemoryVFS -> [Char] -> IO MemoryEntry
findMelem MemoryVFS
x [Char]
newpath

instance HVFS MemoryVFS where
    vGetCurrentDirectory :: MemoryVFS -> IO [Char]
vGetCurrentDirectory MemoryVFS
x = IORef [Char] -> IO [Char]
forall a. IORef a -> IO a
readIORef (IORef [Char] -> IO [Char]) -> IORef [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ MemoryVFS -> IORef [Char]
cwd MemoryVFS
x
    vSetCurrentDirectory :: MemoryVFS -> [Char] -> IO ()
vSetCurrentDirectory MemoryVFS
x [Char]
fp =
        do curpath <- MemoryVFS -> IO [Char]
forall a. HVFS a => a -> IO [Char]
vGetCurrentDirectory MemoryVFS
x
           -- Make sure new dir is valid
           newdir <- getMelem x fp
           case newdir of
               (MemoryFile [Char]
_) -> MemoryVFS -> IOErrorType -> [Char] -> Maybe [Char] -> IO ()
forall a c.
HVFS a =>
a -> IOErrorType -> [Char] -> Maybe [Char] -> IO c
forall c.
MemoryVFS -> IOErrorType -> [Char] -> Maybe [Char] -> IO c
vRaiseError MemoryVFS
x IOErrorType
doesNotExistErrorType
                                 ([Char]
"Attempt to cwd to non-directory " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
fp)
                                 ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
fp)
               (MemoryDirectory [MemoryNode]
_) ->
                   case [Char] -> [Char] -> Maybe [Char]
absNormPath [Char]
curpath [Char]
fp of
                       Maybe [Char]
Nothing -> -- should never happen due to above getMelem call
                                  MemoryVFS -> IOErrorType -> [Char] -> Maybe [Char] -> IO ()
forall a c.
HVFS a =>
a -> IOErrorType -> [Char] -> Maybe [Char] -> IO c
forall c.
MemoryVFS -> IOErrorType -> [Char] -> Maybe [Char] -> IO c
vRaiseError MemoryVFS
x IOErrorType
illegalOperationErrorType
                                              [Char]
"Bad internal error" ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
fp)
                       Just [Char]
y -> IORef [Char] -> [Char] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (MemoryVFS -> IORef [Char]
cwd MemoryVFS
x) [Char]
y
    vGetFileStatus :: MemoryVFS -> [Char] -> IO HVFSStatEncap
vGetFileStatus MemoryVFS
x [Char]
fp =
        MemoryVFS -> [Char] -> IO MemoryEntry
getMelem MemoryVFS
x [Char]
fp IO MemoryEntry
-> (MemoryEntry -> IO HVFSStatEncap) -> IO HVFSStatEncap
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                     (MemoryFile [Char]
y) -> HVFSStatEncap -> IO HVFSStatEncap
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (HVFSStatEncap -> IO HVFSStatEncap)
-> HVFSStatEncap -> IO HVFSStatEncap
forall a b. (a -> b) -> a -> b
$ SimpleStat -> HVFSStatEncap
forall a. HVFSStat a => a -> HVFSStatEncap
HVFSStatEncap (SimpleStat -> HVFSStatEncap) -> SimpleStat -> HVFSStatEncap
forall a b. (a -> b) -> a -> b
$
                                             SimpleStat {isFile :: Bool
isFile = Bool
True,
                                                        fileSize :: FileOffset
fileSize = ([Char] -> FileOffset
forall i a. Num i => [a] -> i
genericLength [Char]
y)}
                     (MemoryDirectory [MemoryNode]
_) -> HVFSStatEncap -> IO HVFSStatEncap
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (HVFSStatEncap -> IO HVFSStatEncap)
-> HVFSStatEncap -> IO HVFSStatEncap
forall a b. (a -> b) -> a -> b
$ SimpleStat -> HVFSStatEncap
forall a. HVFSStat a => a -> HVFSStatEncap
HVFSStatEncap (SimpleStat -> HVFSStatEncap) -> SimpleStat -> HVFSStatEncap
forall a b. (a -> b) -> a -> b
$
                                             SimpleStat {isFile :: Bool
isFile = Bool
False,
                                                        fileSize :: FileOffset
fileSize = FileOffset
0}
    vGetDirectoryContents :: MemoryVFS -> [Char] -> IO [[Char]]
vGetDirectoryContents MemoryVFS
x [Char]
fp =
        MemoryVFS -> [Char] -> IO MemoryEntry
getMelem MemoryVFS
x [Char]
fp IO MemoryEntry -> (MemoryEntry -> IO [[Char]]) -> IO [[Char]]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                MemoryFile [Char]
_ -> MemoryVFS -> IOErrorType -> [Char] -> Maybe [Char] -> IO [[Char]]
forall a c.
HVFS a =>
a -> IOErrorType -> [Char] -> Maybe [Char] -> IO c
forall c.
MemoryVFS -> IOErrorType -> [Char] -> Maybe [Char] -> IO c
vRaiseError MemoryVFS
x IOErrorType
doesNotExistErrorType
                                  [Char]
"Can't list contents of a file"
                                  ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
fp)
                MemoryDirectory [MemoryNode]
c -> [[Char]] -> IO [[Char]]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Char]] -> IO [[Char]]) -> [[Char]] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$ (MemoryNode -> [Char]) -> [MemoryNode] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map MemoryNode -> [Char]
forall a b. (a, b) -> a
fst [MemoryNode]
c

instance HVFSOpenable MemoryVFS where
    vOpen :: MemoryVFS -> [Char] -> IOMode -> IO HVFSOpenEncap
vOpen MemoryVFS
x [Char]
fp (IOMode
ReadMode) =
        MemoryVFS -> [Char] -> IO MemoryEntry
getMelem MemoryVFS
x [Char]
fp IO MemoryEntry
-> (MemoryEntry -> IO HVFSOpenEncap) -> IO HVFSOpenEncap
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                MemoryDirectory [MemoryNode]
_ -> MemoryVFS
-> IOErrorType -> [Char] -> Maybe [Char] -> IO HVFSOpenEncap
forall a c.
HVFS a =>
a -> IOErrorType -> [Char] -> Maybe [Char] -> IO c
forall c.
MemoryVFS -> IOErrorType -> [Char] -> Maybe [Char] -> IO c
vRaiseError MemoryVFS
x IOErrorType
doesNotExistErrorType
                                      [Char]
"Can't open a directory"
                                      ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
fp)
                MemoryFile [Char]
y -> [Char] -> IO StreamReader
newStreamReader [Char]
y IO StreamReader
-> (StreamReader -> IO HVFSOpenEncap) -> IO HVFSOpenEncap
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HVFSOpenEncap -> IO HVFSOpenEncap
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (HVFSOpenEncap -> IO HVFSOpenEncap)
-> (StreamReader -> HVFSOpenEncap)
-> StreamReader
-> IO HVFSOpenEncap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamReader -> HVFSOpenEncap
forall a. HVIO a => a -> HVFSOpenEncap
HVFSOpenEncap
    vOpen MemoryVFS
x [Char]
fp IOMode
_ = MemoryVFS
-> IOErrorType -> [Char] -> Maybe [Char] -> IO HVFSOpenEncap
forall a c.
HVFS a =>
a -> IOErrorType -> [Char] -> Maybe [Char] -> IO c
forall c.
MemoryVFS -> IOErrorType -> [Char] -> Maybe [Char] -> IO c
vRaiseError MemoryVFS
x IOErrorType
permissionErrorType
                     [Char]
"Only ReadMode is supported with MemoryVFS files"
                     ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
fp)