{-# Language BlockArguments #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  System.OS
-- Copyright   :  (c) ChaosGroup, 2020
-- License     :  MIT
--
-- Maintainer  :  daniel.taskoff@gmail.com
-- Stability   :  experimental
--
-- Get the name of the current operating system.
-----------------------------------------------------------------------------

module System.OS
  (
  -- * 'OS'
    OS(..), os
  ) where

import Foreign.C.String (CWString, peekCWString)
import Foreign.Marshal.Alloc (free)
import Foreign.Ptr (nullPtr)
import System.IO.Unsafe (unsafePerformIO)


-- | The name of the current operating system.
newtype OS = OS { OS -> String
unOS :: String }

-- | Try to get the name of the current operating system.
os :: Maybe OS
os :: Maybe OS
os = IO (Maybe OS) -> Maybe OS
forall a. IO a -> a
unsafePerformIO do
  -- unsafePerformIO and NOINLINE guarantee that c_getOS won't be called more than once
  CWString
osptr <- IO CWString
c_getOS
  if CWString
osptr CWString -> CWString -> Bool
forall a. Eq a => a -> a -> Bool
== CWString
forall a. Ptr a
nullPtr
  then Maybe OS -> IO (Maybe OS)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe OS
forall a. Maybe a
Nothing
  else do
    String
res <- CWString -> IO String
peekCWString CWString
osptr
    CWString -> IO ()
forall a. Ptr a -> IO ()
free CWString
osptr
    Maybe OS -> IO (Maybe OS)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe OS -> IO (Maybe OS)) -> Maybe OS -> IO (Maybe OS)
forall a b. (a -> b) -> a -> b
$ OS -> Maybe OS
forall a. a -> Maybe a
Just (OS -> Maybe OS) -> OS -> Maybe OS
forall a b. (a -> b) -> a -> b
$ String -> OS
OS String
res
{-# NOINLINE os #-}

foreign import ccall safe "getOS"
  c_getOS :: IO CWString