{-# LANGUAGE CPP#-}
{-# LANGUAGE OverloadedStrings #-}

module SDL.Filesystem
  ( -- * Filesystem Paths
    getBasePath
  , getPrefPath
) where

import Control.Exception
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Text (Text)
import Foreign.Marshal.Alloc
import SDL.Internal.Exception
import qualified Data.ByteString as BS
import qualified Data.Text.Encoding as Text
import qualified SDL.Raw.Filesystem as Raw

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif

-- | An absolute path to the application data directory.
--
-- The path is guaranteed to end with a path separator.
--
-- Throws 'SDLException' on failure, or if the platform does not implement this
-- functionality.
getBasePath :: MonadIO m => m Text
getBasePath :: forall (m :: Type -> Type). MonadIO m => m Text
getBasePath = forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$ do
  Ptr CChar
cpath <- forall (m :: Type -> Type) a.
MonadIO m =>
Text -> Text -> m (Ptr a) -> m (Ptr a)
throwIfNull Text
"SDL.Filesystem.getBasePath" Text
"SDL_GetBasePath"
    forall (m :: Type -> Type). MonadIO m => m (Ptr CChar)
Raw.getBasePath
  forall a b. IO a -> IO b -> IO a
finally (ByteString -> Text
Text.decodeUtf8 forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CChar -> IO ByteString
BS.packCString Ptr CChar
cpath) (forall a. Ptr a -> IO ()
free Ptr CChar
cpath)

-- | A path to a unique per user and per application directory for the given
-- organization and application name, intended for writing preferences and
-- other personal files.
--
-- The path is guaranteed to end with a path separator.
--
-- You should assume the path returned by this function is the only safe place
-- to write files to.
--
-- Throws 'SDLException' on failure.
getPrefPath :: MonadIO m => Text -> Text -> m Text
getPrefPath :: forall (m :: Type -> Type). MonadIO m => Text -> Text -> m Text
getPrefPath Text
organization Text
application = forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$ do
  Ptr CChar
cpath <- forall (m :: Type -> Type) a.
MonadIO m =>
Text -> Text -> m (Ptr a) -> m (Ptr a)
throwIfNull Text
"SDL.Filesystem.getPrefPath" Text
"SDL_GetPrefPath" forall a b. (a -> b) -> a -> b
$
    forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString (Text -> ByteString
Text.encodeUtf8 Text
organization) forall a b. (a -> b) -> a -> b
$ \Ptr CChar
org ->
      forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString (Text -> ByteString
Text.encodeUtf8 Text
application) forall a b. (a -> b) -> a -> b
$ \Ptr CChar
app ->
        forall (m :: Type -> Type).
MonadIO m =>
Ptr CChar -> Ptr CChar -> m (Ptr CChar)
Raw.getPrefPath Ptr CChar
org Ptr CChar
app
  forall a b. IO a -> IO b -> IO a
finally (ByteString -> Text
Text.decodeUtf8 forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CChar -> IO ByteString
BS.packCString Ptr CChar
cpath) (forall a. Ptr a -> IO ()
free Ptr CChar
cpath)