FD.hs

{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wall #-}

module Control.Process.FD
  ( FD,
    GetFD (..),
    HasFD (..),
    ReviewFD (..),
    AsFD (..),
  )
where

import Control.Category (id, (.))
import Control.Lens (Getter, Lens', Prism', Review, iso, unto)
import Data.Int (Int32)
import Foreign.C.Types (CInt (CInt))
import System.Posix.Internals (FD)

-- $setup
-- >>> import Prelude
-- >>> import Control.Lens

-- | Type class for values that can be viewed as an @FD@.
--
-- >>> view getFD (3 :: FD)
-- 3
class GetFD a where
  getFD ::
    Getter a FD
  {-# INLINE getFDInt32 #-}
  getFDInt32 ::
    Getter a Int32
  getFDInt32 =
    getFD
      . iso
        (\(CInt x) -> x)
        CInt

-- |
--
-- >>> view getFD (3 :: FD)
-- 3
-- >>> view getFDInt32 (3 :: FD)
-- 3
instance GetFD FD where
  getFD = id
  {-# INLINE getFD #-}

-- | Type class for values with a lens into an @FD@.
--
-- >>> view fd (3 :: FD)
-- 3
class (GetFD a) => HasFD a where
  fd ::
    Lens' a FD
  {-# INLINE fdInt32 #-}
  fdInt32 ::
    Lens' a Int32
  fdInt32 =
    fd
      . iso
        (\(CInt x) -> x)
        CInt

-- |
--
-- >>> view fd (3 :: FD)
-- 3
-- >>> view fdInt32 (3 :: FD)
-- 3
-- >>> set fdInt32 7 (3 :: FD)
-- 7
instance HasFD FD where
  fd =
    id

-- | Type class for values that can be constructed from an @FD@.
--
-- >>> review reviewFD (3 :: FD) :: FD
-- 3
class ReviewFD a where
  reviewFD ::
    Review a FD
  {-# INLINE reviewFDInt32 #-}
  reviewFDInt32 ::
    Review a Int32
  reviewFDInt32 =
    reviewFD
      . iso
        (\(CInt x) -> x)
        CInt

-- |
--
-- >>> review reviewFD (3 :: FD) :: FD
-- 3
-- >>> review reviewFDInt32 7 :: FD
-- 7
instance ReviewFD FD where
  reviewFD = unto id
  {-# INLINE reviewFD #-}

-- | Type class for values with a prism into an @FD@.
--
-- >>> preview _FD (3 :: FD)
-- Just 3
class (ReviewFD a) => AsFD a where
  _FD ::
    Prism' a FD
  {-# INLINE _FDInt32 #-}
  _FDInt32 ::
    Prism' a Int32
  _FDInt32 =
    _FD
      . iso
        (\(CInt x) -> x)
        CInt

-- |
--
-- >>> preview _FD (3 :: FD)
-- Just 3
-- >>> preview _FDInt32 (3 :: FD)
-- Just 3
-- >>> review _FDInt32 7 :: FD
-- 7
instance AsFD FD where
  _FD =
    id