{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.SageMaker.Types.TargetPlatform
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.SageMaker.Types.TargetPlatform where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import Amazonka.SageMaker.Types.TargetPlatformAccelerator
import Amazonka.SageMaker.Types.TargetPlatformArch
import Amazonka.SageMaker.Types.TargetPlatformOs

-- | Contains information about a target platform that you want your model to
-- run on, such as OS, architecture, and accelerators. It is an alternative
-- of @TargetDevice@.
--
-- /See:/ 'newTargetPlatform' smart constructor.
data TargetPlatform = TargetPlatform'
  { -- | Specifies a target platform accelerator (optional).
    --
    -- -   @NVIDIA@: Nvidia graphics processing unit. It also requires
    --     @gpu-code@, @trt-ver@, @cuda-ver@ compiler options
    --
    -- -   @MALI@: ARM Mali graphics processor
    --
    -- -   @INTEL_GRAPHICS@: Integrated Intel graphics
    TargetPlatform -> Maybe TargetPlatformAccelerator
accelerator :: Prelude.Maybe TargetPlatformAccelerator,
    -- | Specifies a target platform OS.
    --
    -- -   @LINUX@: Linux-based operating systems.
    --
    -- -   @ANDROID@: Android operating systems. Android API level can be
    --     specified using the @ANDROID_PLATFORM@ compiler option. For example,
    --     @\"CompilerOptions\": {\'ANDROID_PLATFORM\': 28}@
    TargetPlatform -> TargetPlatformOs
os :: TargetPlatformOs,
    -- | Specifies a target platform architecture.
    --
    -- -   @X86_64@: 64-bit version of the x86 instruction set.
    --
    -- -   @X86@: 32-bit version of the x86 instruction set.
    --
    -- -   @ARM64@: ARMv8 64-bit CPU.
    --
    -- -   @ARM_EABIHF@: ARMv7 32-bit, Hard Float.
    --
    -- -   @ARM_EABI@: ARMv7 32-bit, Soft Float. Used by Android 32-bit ARM
    --     platform.
    TargetPlatform -> TargetPlatformArch
arch :: TargetPlatformArch
  }
  deriving (TargetPlatform -> TargetPlatform -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetPlatform -> TargetPlatform -> Bool
$c/= :: TargetPlatform -> TargetPlatform -> Bool
== :: TargetPlatform -> TargetPlatform -> Bool
$c== :: TargetPlatform -> TargetPlatform -> Bool
Prelude.Eq, ReadPrec [TargetPlatform]
ReadPrec TargetPlatform
Int -> ReadS TargetPlatform
ReadS [TargetPlatform]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TargetPlatform]
$creadListPrec :: ReadPrec [TargetPlatform]
readPrec :: ReadPrec TargetPlatform
$creadPrec :: ReadPrec TargetPlatform
readList :: ReadS [TargetPlatform]
$creadList :: ReadS [TargetPlatform]
readsPrec :: Int -> ReadS TargetPlatform
$creadsPrec :: Int -> ReadS TargetPlatform
Prelude.Read, Int -> TargetPlatform -> ShowS
[TargetPlatform] -> ShowS
TargetPlatform -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TargetPlatform] -> ShowS
$cshowList :: [TargetPlatform] -> ShowS
show :: TargetPlatform -> String
$cshow :: TargetPlatform -> String
showsPrec :: Int -> TargetPlatform -> ShowS
$cshowsPrec :: Int -> TargetPlatform -> ShowS
Prelude.Show, forall x. Rep TargetPlatform x -> TargetPlatform
forall x. TargetPlatform -> Rep TargetPlatform x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TargetPlatform x -> TargetPlatform
$cfrom :: forall x. TargetPlatform -> Rep TargetPlatform x
Prelude.Generic)

-- |
-- Create a value of 'TargetPlatform' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'accelerator', 'targetPlatform_accelerator' - Specifies a target platform accelerator (optional).
--
-- -   @NVIDIA@: Nvidia graphics processing unit. It also requires
--     @gpu-code@, @trt-ver@, @cuda-ver@ compiler options
--
-- -   @MALI@: ARM Mali graphics processor
--
-- -   @INTEL_GRAPHICS@: Integrated Intel graphics
--
-- 'os', 'targetPlatform_os' - Specifies a target platform OS.
--
-- -   @LINUX@: Linux-based operating systems.
--
-- -   @ANDROID@: Android operating systems. Android API level can be
--     specified using the @ANDROID_PLATFORM@ compiler option. For example,
--     @\"CompilerOptions\": {\'ANDROID_PLATFORM\': 28}@
--
-- 'arch', 'targetPlatform_arch' - Specifies a target platform architecture.
--
-- -   @X86_64@: 64-bit version of the x86 instruction set.
--
-- -   @X86@: 32-bit version of the x86 instruction set.
--
-- -   @ARM64@: ARMv8 64-bit CPU.
--
-- -   @ARM_EABIHF@: ARMv7 32-bit, Hard Float.
--
-- -   @ARM_EABI@: ARMv7 32-bit, Soft Float. Used by Android 32-bit ARM
--     platform.
newTargetPlatform ::
  -- | 'os'
  TargetPlatformOs ->
  -- | 'arch'
  TargetPlatformArch ->
  TargetPlatform
newTargetPlatform :: TargetPlatformOs -> TargetPlatformArch -> TargetPlatform
newTargetPlatform TargetPlatformOs
pOs_ TargetPlatformArch
pArch_ =
  TargetPlatform'
    { $sel:accelerator:TargetPlatform' :: Maybe TargetPlatformAccelerator
accelerator = forall a. Maybe a
Prelude.Nothing,
      $sel:os:TargetPlatform' :: TargetPlatformOs
os = TargetPlatformOs
pOs_,
      $sel:arch:TargetPlatform' :: TargetPlatformArch
arch = TargetPlatformArch
pArch_
    }

-- | Specifies a target platform accelerator (optional).
--
-- -   @NVIDIA@: Nvidia graphics processing unit. It also requires
--     @gpu-code@, @trt-ver@, @cuda-ver@ compiler options
--
-- -   @MALI@: ARM Mali graphics processor
--
-- -   @INTEL_GRAPHICS@: Integrated Intel graphics
targetPlatform_accelerator :: Lens.Lens' TargetPlatform (Prelude.Maybe TargetPlatformAccelerator)
targetPlatform_accelerator :: Lens' TargetPlatform (Maybe TargetPlatformAccelerator)
targetPlatform_accelerator = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TargetPlatform' {Maybe TargetPlatformAccelerator
accelerator :: Maybe TargetPlatformAccelerator
$sel:accelerator:TargetPlatform' :: TargetPlatform -> Maybe TargetPlatformAccelerator
accelerator} -> Maybe TargetPlatformAccelerator
accelerator) (\s :: TargetPlatform
s@TargetPlatform' {} Maybe TargetPlatformAccelerator
a -> TargetPlatform
s {$sel:accelerator:TargetPlatform' :: Maybe TargetPlatformAccelerator
accelerator = Maybe TargetPlatformAccelerator
a} :: TargetPlatform)

-- | Specifies a target platform OS.
--
-- -   @LINUX@: Linux-based operating systems.
--
-- -   @ANDROID@: Android operating systems. Android API level can be
--     specified using the @ANDROID_PLATFORM@ compiler option. For example,
--     @\"CompilerOptions\": {\'ANDROID_PLATFORM\': 28}@
targetPlatform_os :: Lens.Lens' TargetPlatform TargetPlatformOs
targetPlatform_os :: Lens' TargetPlatform TargetPlatformOs
targetPlatform_os = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TargetPlatform' {TargetPlatformOs
os :: TargetPlatformOs
$sel:os:TargetPlatform' :: TargetPlatform -> TargetPlatformOs
os} -> TargetPlatformOs
os) (\s :: TargetPlatform
s@TargetPlatform' {} TargetPlatformOs
a -> TargetPlatform
s {$sel:os:TargetPlatform' :: TargetPlatformOs
os = TargetPlatformOs
a} :: TargetPlatform)

-- | Specifies a target platform architecture.
--
-- -   @X86_64@: 64-bit version of the x86 instruction set.
--
-- -   @X86@: 32-bit version of the x86 instruction set.
--
-- -   @ARM64@: ARMv8 64-bit CPU.
--
-- -   @ARM_EABIHF@: ARMv7 32-bit, Hard Float.
--
-- -   @ARM_EABI@: ARMv7 32-bit, Soft Float. Used by Android 32-bit ARM
--     platform.
targetPlatform_arch :: Lens.Lens' TargetPlatform TargetPlatformArch
targetPlatform_arch :: Lens' TargetPlatform TargetPlatformArch
targetPlatform_arch = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TargetPlatform' {TargetPlatformArch
arch :: TargetPlatformArch
$sel:arch:TargetPlatform' :: TargetPlatform -> TargetPlatformArch
arch} -> TargetPlatformArch
arch) (\s :: TargetPlatform
s@TargetPlatform' {} TargetPlatformArch
a -> TargetPlatform
s {$sel:arch:TargetPlatform' :: TargetPlatformArch
arch = TargetPlatformArch
a} :: TargetPlatform)

instance Data.FromJSON TargetPlatform where
  parseJSON :: Value -> Parser TargetPlatform
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"TargetPlatform"
      ( \Object
x ->
          Maybe TargetPlatformAccelerator
-> TargetPlatformOs -> TargetPlatformArch -> TargetPlatform
TargetPlatform'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Accelerator")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"Os")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"Arch")
      )

instance Prelude.Hashable TargetPlatform where
  hashWithSalt :: Int -> TargetPlatform -> Int
hashWithSalt Int
_salt TargetPlatform' {Maybe TargetPlatformAccelerator
TargetPlatformArch
TargetPlatformOs
arch :: TargetPlatformArch
os :: TargetPlatformOs
accelerator :: Maybe TargetPlatformAccelerator
$sel:arch:TargetPlatform' :: TargetPlatform -> TargetPlatformArch
$sel:os:TargetPlatform' :: TargetPlatform -> TargetPlatformOs
$sel:accelerator:TargetPlatform' :: TargetPlatform -> Maybe TargetPlatformAccelerator
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TargetPlatformAccelerator
accelerator
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` TargetPlatformOs
os
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` TargetPlatformArch
arch

instance Prelude.NFData TargetPlatform where
  rnf :: TargetPlatform -> ()
rnf TargetPlatform' {Maybe TargetPlatformAccelerator
TargetPlatformArch
TargetPlatformOs
arch :: TargetPlatformArch
os :: TargetPlatformOs
accelerator :: Maybe TargetPlatformAccelerator
$sel:arch:TargetPlatform' :: TargetPlatform -> TargetPlatformArch
$sel:os:TargetPlatform' :: TargetPlatform -> TargetPlatformOs
$sel:accelerator:TargetPlatform' :: TargetPlatform -> Maybe TargetPlatformAccelerator
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe TargetPlatformAccelerator
accelerator
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf TargetPlatformOs
os
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf TargetPlatformArch
arch

instance Data.ToJSON TargetPlatform where
  toJSON :: TargetPlatform -> Value
toJSON TargetPlatform' {Maybe TargetPlatformAccelerator
TargetPlatformArch
TargetPlatformOs
arch :: TargetPlatformArch
os :: TargetPlatformOs
accelerator :: Maybe TargetPlatformAccelerator
$sel:arch:TargetPlatform' :: TargetPlatform -> TargetPlatformArch
$sel:os:TargetPlatform' :: TargetPlatform -> TargetPlatformOs
$sel:accelerator:TargetPlatform' :: TargetPlatform -> Maybe TargetPlatformAccelerator
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Accelerator" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe TargetPlatformAccelerator
accelerator,
            forall a. a -> Maybe a
Prelude.Just (Key
"Os" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= TargetPlatformOs
os),
            forall a. a -> Maybe a
Prelude.Just (Key
"Arch" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= TargetPlatformArch
arch)
          ]
      )