{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  System.IO.Error.Lens
-- Copyright   :  (C) 2012-2016 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  experimental
-- Portability :  Rank2Types
--
----------------------------------------------------------------------------
module System.IO.Error.Lens where

import Control.Lens
import GHC.IO.Exception
import System.IO
import Foreign.C.Types

-- * IOException Lenses

-- | Where the error happened.
location :: Lens' IOException String
location :: (String -> f String) -> IOException -> f IOException
location String -> f String
f IOException
s = String -> f String
f (IOException -> String
ioe_location IOException
s) f String -> (String -> IOException) -> f IOException
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \String
e -> IOException
s { ioe_location :: String
ioe_location = String
e }
{-# INLINE location #-}

-- | Error type specific information.
description :: Lens' IOException String
description :: (String -> f String) -> IOException -> f IOException
description String -> f String
f IOException
s = String -> f String
f (IOException -> String
ioe_description IOException
s) f String -> (String -> IOException) -> f IOException
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \String
e -> IOException
s { ioe_description :: String
ioe_description = String
e }
{-# INLINE description #-}

-- | The handle used by the action flagging this error.
handle :: Lens' IOException (Maybe Handle)
handle :: (Maybe Handle -> f (Maybe Handle)) -> IOException -> f IOException
handle Maybe Handle -> f (Maybe Handle)
f IOException
s = Maybe Handle -> f (Maybe Handle)
f (IOException -> Maybe Handle
ioe_handle IOException
s) f (Maybe Handle) -> (Maybe Handle -> IOException) -> f IOException
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Maybe Handle
e -> IOException
s { ioe_handle :: Maybe Handle
ioe_handle = Maybe Handle
e }
{-# INLINE handle #-}

-- | 'fileName' the error is related to.
--
fileName :: Lens' IOException (Maybe FilePath)
fileName :: (Maybe String -> f (Maybe String)) -> IOException -> f IOException
fileName Maybe String -> f (Maybe String)
f IOException
s = Maybe String -> f (Maybe String)
f (IOException -> Maybe String
ioe_filename IOException
s) f (Maybe String) -> (Maybe String -> IOException) -> f IOException
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Maybe String
e -> IOException
s { ioe_filename :: Maybe String
ioe_filename = Maybe String
e }
{-# INLINE fileName #-}

-- | 'errno' leading to this error, if any.
--
errno :: Lens' IOException (Maybe CInt)
errno :: (Maybe CInt -> f (Maybe CInt)) -> IOException -> f IOException
errno Maybe CInt -> f (Maybe CInt)
f IOException
s = Maybe CInt -> f (Maybe CInt)
f (IOException -> Maybe CInt
ioe_errno IOException
s) f (Maybe CInt) -> (Maybe CInt -> IOException) -> f IOException
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Maybe CInt
e -> IOException
s { ioe_errno :: Maybe CInt
ioe_errno = Maybe CInt
e }
{-# INLINE errno #-}

------------------------------------------------------------------------------
-- Error Types
------------------------------------------------------------------------------

-- | What type of error it is

errorType :: Lens' IOException IOErrorType
errorType :: (IOErrorType -> f IOErrorType) -> IOException -> f IOException
errorType IOErrorType -> f IOErrorType
f IOException
s = IOErrorType -> f IOErrorType
f (IOException -> IOErrorType
ioe_type IOException
s) f IOErrorType -> (IOErrorType -> IOException) -> f IOException
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \IOErrorType
e -> IOException
s { ioe_type :: IOErrorType
ioe_type = IOErrorType
e }
{-# INLINE errorType #-}

-- * IOErrorType Prisms
--

_AlreadyExists :: Prism' IOErrorType ()
_AlreadyExists :: p () (f ()) -> p IOErrorType (f IOErrorType)
_AlreadyExists = IOErrorType -> Prism' IOErrorType ()
forall a. Eq a => a -> Prism' a ()
only IOErrorType
AlreadyExists

_NoSuchThing :: Prism' IOErrorType ()
_NoSuchThing :: p () (f ()) -> p IOErrorType (f IOErrorType)
_NoSuchThing = IOErrorType -> Prism' IOErrorType ()
forall a. Eq a => a -> Prism' a ()
only IOErrorType
NoSuchThing

_ResourceBusy :: Prism' IOErrorType ()
_ResourceBusy :: p () (f ()) -> p IOErrorType (f IOErrorType)
_ResourceBusy = IOErrorType -> Prism' IOErrorType ()
forall a. Eq a => a -> Prism' a ()
only IOErrorType
ResourceBusy

_ResourceExhausted :: Prism' IOErrorType ()
_ResourceExhausted :: p () (f ()) -> p IOErrorType (f IOErrorType)
_ResourceExhausted = IOErrorType -> Prism' IOErrorType ()
forall a. Eq a => a -> Prism' a ()
only IOErrorType
ResourceExhausted

_EOF :: Prism' IOErrorType ()
_EOF :: p () (f ()) -> p IOErrorType (f IOErrorType)
_EOF = IOErrorType -> Prism' IOErrorType ()
forall a. Eq a => a -> Prism' a ()
only IOErrorType
EOF

_IllegalOperation :: Prism' IOErrorType ()
_IllegalOperation :: p () (f ()) -> p IOErrorType (f IOErrorType)
_IllegalOperation = IOErrorType -> Prism' IOErrorType ()
forall a. Eq a => a -> Prism' a ()
only IOErrorType
IllegalOperation

_PermissionDenied :: Prism' IOErrorType ()
_PermissionDenied :: p () (f ()) -> p IOErrorType (f IOErrorType)
_PermissionDenied = IOErrorType -> Prism' IOErrorType ()
forall a. Eq a => a -> Prism' a ()
only IOErrorType
PermissionDenied

_UserError :: Prism' IOErrorType ()
_UserError :: p () (f ()) -> p IOErrorType (f IOErrorType)
_UserError = IOErrorType -> Prism' IOErrorType ()
forall a. Eq a => a -> Prism' a ()
only IOErrorType
UserError

_UnsatisfiedConstraints :: Prism' IOErrorType ()
_UnsatisfiedConstraints :: p () (f ()) -> p IOErrorType (f IOErrorType)
_UnsatisfiedConstraints = IOErrorType -> Prism' IOErrorType ()
forall a. Eq a => a -> Prism' a ()
only IOErrorType
UnsatisfiedConstraints

_SystemError :: Prism' IOErrorType ()
_SystemError :: p () (f ()) -> p IOErrorType (f IOErrorType)
_SystemError = IOErrorType -> Prism' IOErrorType ()
forall a. Eq a => a -> Prism' a ()
only IOErrorType
SystemError

_ProtocolError :: Prism' IOErrorType ()
_ProtocolError :: p () (f ()) -> p IOErrorType (f IOErrorType)
_ProtocolError = IOErrorType -> Prism' IOErrorType ()
forall a. Eq a => a -> Prism' a ()
only IOErrorType
ProtocolError

_OtherError :: Prism' IOErrorType ()
_OtherError :: p () (f ()) -> p IOErrorType (f IOErrorType)
_OtherError = IOErrorType -> Prism' IOErrorType ()
forall a. Eq a => a -> Prism' a ()
only IOErrorType
OtherError

_InvalidArgument :: Prism' IOErrorType ()
_InvalidArgument :: p () (f ()) -> p IOErrorType (f IOErrorType)
_InvalidArgument = IOErrorType -> Prism' IOErrorType ()
forall a. Eq a => a -> Prism' a ()
only IOErrorType
InvalidArgument

_InappropriateType :: Prism' IOErrorType ()
_InappropriateType :: p () (f ()) -> p IOErrorType (f IOErrorType)
_InappropriateType = IOErrorType -> Prism' IOErrorType ()
forall a. Eq a => a -> Prism' a ()
only IOErrorType
InappropriateType

_HardwareFault :: Prism' IOErrorType ()
_HardwareFault :: p () (f ()) -> p IOErrorType (f IOErrorType)
_HardwareFault = IOErrorType -> Prism' IOErrorType ()
forall a. Eq a => a -> Prism' a ()
only IOErrorType
HardwareFault

_UnsupportedOperation :: Prism' IOErrorType ()
_UnsupportedOperation :: p () (f ()) -> p IOErrorType (f IOErrorType)
_UnsupportedOperation = IOErrorType -> Prism' IOErrorType ()
forall a. Eq a => a -> Prism' a ()
only IOErrorType
UnsupportedOperation

_TimeExpired :: Prism' IOErrorType ()
_TimeExpired :: p () (f ()) -> p IOErrorType (f IOErrorType)
_TimeExpired = IOErrorType -> Prism' IOErrorType ()
forall a. Eq a => a -> Prism' a ()
only IOErrorType
TimeExpired

_ResourceVanished :: Prism' IOErrorType ()
_ResourceVanished :: p () (f ()) -> p IOErrorType (f IOErrorType)
_ResourceVanished = IOErrorType -> Prism' IOErrorType ()
forall a. Eq a => a -> Prism' a ()
only IOErrorType
ResourceVanished

_Interrupted :: Prism' IOErrorType ()
_Interrupted :: p () (f ()) -> p IOErrorType (f IOErrorType)
_Interrupted = IOErrorType -> Prism' IOErrorType ()
forall a. Eq a => a -> Prism' a ()
only IOErrorType
Interrupted