UserID.hs

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

module Control.Process.UserID
  ( UserID,
    GetUserID (..),
    HasUserID (..),
    ReviewUserID (..),
    AsUserID (..),
  )
where

import Control.Category (id, (.))
import Control.Lens (Getter, Lens', Prism', Review, iso, unto)
import Data.Word (Word32)
import System.Posix.Types (CUid (CUid))
import System.Process.Internals (UserID)

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

-- | Type class for values that can be viewed as a @UserID@.
--
-- >>> view getUserID (CUid 1000)
-- 1000
class GetUserID a where
  getUserID ::
    Getter a UserID
  {-# INLINE getUserIDWord32 #-}
  getUserIDWord32 ::
    Getter a Word32
  getUserIDWord32 =
    getUserID
      . iso
        (\(CUid x) -> x)
        CUid

-- |
--
-- >>> view getUserID (CUid 1000)
-- 1000
-- >>> view getUserIDWord32 (CUid 1000)
-- 1000
instance GetUserID UserID where
  getUserID = id
  {-# INLINE getUserID #-}

-- | Type class for values with a lens into a @UserID@.
--
-- >>> view userID (CUid 1000)
-- 1000
class (GetUserID a) => HasUserID a where
  userID ::
    Lens' a UserID
  {-# INLINE userIDWord32 #-}
  userIDWord32 ::
    Lens' a Word32
  userIDWord32 =
    userID
      . iso
        (\(CUid x) -> x)
        CUid

-- |
--
-- >>> view userID (CUid 1000)
-- 1000
-- >>> view userIDWord32 (CUid 1000)
-- 1000
-- >>> set userIDWord32 0 (CUid 1000)
-- 0
instance HasUserID UserID where
  userID =
    id

-- | Type class for values that can be constructed from a @UserID@.
--
-- >>> review reviewUserID (CUid 1000) :: UserID
-- 1000
class ReviewUserID a where
  reviewUserID ::
    Review a UserID
  {-# INLINE reviewUserIDWord32 #-}
  reviewUserIDWord32 ::
    Review a Word32
  reviewUserIDWord32 =
    reviewUserID
      . iso
        (\(CUid x) -> x)
        CUid

-- |
--
-- >>> review reviewUserID (CUid 1000) :: UserID
-- 1000
-- >>> review reviewUserIDWord32 42 :: UserID
-- 42
instance ReviewUserID UserID where
  reviewUserID = unto id
  {-# INLINE reviewUserID #-}

-- | Type class for values with a prism into a @UserID@.
--
-- >>> preview _UserID (CUid 1000)
-- Just 1000
class (ReviewUserID a) => AsUserID a where
  _UserID ::
    Prism' a UserID
  {-# INLINE _UserIDWord32 #-}
  _UserIDWord32 ::
    Prism' a Word32
  _UserIDWord32 =
    _UserID
      . iso
        (\(CUid x) -> x)
        CUid

-- |
--
-- >>> preview _UserID (CUid 1000)
-- Just 1000
-- >>> preview _UserIDWord32 (CUid 1000)
-- Just 1000
-- >>> review _UserIDWord32 42 :: UserID
-- 42
instance AsUserID UserID where
  _UserID =
    id