{-# 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 =
    (UserID -> f UserID) -> a -> f a
forall a. GetUserID a => Getter a UserID
Getter a UserID
getUserID
      ((UserID -> f UserID) -> a -> f a)
-> ((Word32 -> f Word32) -> UserID -> f UserID)
-> (Word32 -> f Word32)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (UserID -> Word32)
-> (Word32 -> UserID) -> Iso UserID UserID Word32 Word32
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
        (\(CUid Word32
x) -> Word32
x)
        Word32 -> UserID
CUid

-- |
--
-- >>> view getUserID (CUid 1000)
-- 1000
-- >>> view getUserIDWord32 (CUid 1000)
-- 1000
instance GetUserID UserID where
  getUserID :: Getter UserID UserID
getUserID = (UserID -> f UserID) -> UserID -> f UserID
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
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 -> f UserID) -> a -> f a
forall a. HasUserID a => Lens' a UserID
Lens' a UserID
userID
      ((UserID -> f UserID) -> a -> f a)
-> ((Word32 -> f Word32) -> UserID -> f UserID)
-> (Word32 -> f Word32)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (UserID -> Word32)
-> (Word32 -> UserID) -> Iso UserID UserID Word32 Word32
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
        (\(CUid Word32
x) -> Word32
x)
        Word32 -> UserID
CUid

-- |
--
-- >>> view userID (CUid 1000)
-- 1000
-- >>> view userIDWord32 (CUid 1000)
-- 1000
-- >>> set userIDWord32 0 (CUid 1000)
-- 0
instance HasUserID UserID where
  userID :: Lens' UserID UserID
userID =
    (UserID -> f UserID) -> UserID -> f UserID
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
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 =
    Optic' p f a UserID
forall a. ReviewUserID a => Review a UserID
Review a UserID
reviewUserID
      Optic' p f a UserID
-> (p Word32 (f Word32) -> p UserID (f UserID))
-> p Word32 (f Word32)
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (UserID -> Word32)
-> (Word32 -> UserID) -> Iso UserID UserID Word32 Word32
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
        (\(CUid Word32
x) -> Word32
x)
        Word32 -> UserID
CUid

-- |
--
-- >>> review reviewUserID (CUid 1000) :: UserID
-- 1000
-- >>> review reviewUserIDWord32 42 :: UserID
-- 42
instance ReviewUserID UserID where
  reviewUserID :: Review UserID UserID
reviewUserID = (UserID -> UserID) -> Optic p f UserID UserID UserID UserID
forall (p :: * -> * -> *) (f :: * -> *) b t s a.
(Profunctor p, Bifunctor p, Functor f) =>
(b -> t) -> Optic p f s t a b
unto UserID -> UserID
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
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 =
    p UserID (f UserID) -> p a (f a)
forall a. AsUserID a => Prism' a UserID
Prism' a UserID
_UserID
      (p UserID (f UserID) -> p a (f a))
-> (p Word32 (f Word32) -> p UserID (f UserID))
-> p Word32 (f Word32)
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (UserID -> Word32)
-> (Word32 -> UserID) -> Iso UserID UserID Word32 Word32
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
        (\(CUid Word32
x) -> Word32
x)
        Word32 -> UserID
CUid

-- |
--
-- >>> preview _UserID (CUid 1000)
-- Just 1000
-- >>> preview _UserIDWord32 (CUid 1000)
-- Just 1000
-- >>> review _UserIDWord32 42 :: UserID
-- 42
instance AsUserID UserID where
  _UserID :: Prism' UserID UserID
_UserID =
    p UserID (f UserID) -> p UserID (f UserID)
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id