{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  OpenTelemetry.Resource.OperatingSystem.Detector
-- Copyright   :  (c) Ian Duncan, 2021
-- License     :  BSD-3
-- Maintainer  :  Ian Duncan
-- Stability   :  experimental
-- Portability :  non-portable (GHC extensions)
--
-- Detect information about the current system's OS.
--
-----------------------------------------------------------------------------
module OpenTelemetry.Resource.OperatingSystem.Detector 
  ( detectOperatingSystem
  ) where
import OpenTelemetry.Resource.OperatingSystem
import qualified Data.Text as T
import System.Info ( os )

-- | Retrieve any infomration able to be detected about the current operation system.
--
-- Currently only supports 'osType' detection, but PRs are welcome to support additional
-- details.
--
-- @since 0.0.1.0
detectOperatingSystem :: IO OperatingSystem 
detectOperatingSystem :: IO OperatingSystem
detectOperatingSystem = OperatingSystem -> IO OperatingSystem
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OperatingSystem -> IO OperatingSystem)
-> OperatingSystem -> IO OperatingSystem
forall a b. (a -> b) -> a -> b
$ OperatingSystem :: Text -> Maybe Text -> Maybe Text -> Maybe Text -> OperatingSystem
OperatingSystem
  { osType :: Text
osType = if String
os String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"mingw32"
      then Text
"windows"
      else String -> Text
T.pack String
os
  , osDescription :: Maybe Text
osDescription = Maybe Text
forall a. Maybe a
Nothing
  , osName :: Maybe Text
osName = Maybe Text
forall a. Maybe a
Nothing
  , osVersion :: Maybe Text
osVersion = Maybe Text
forall a. Maybe a
Nothing
  }