{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
--  GIMP Toolkit (GTK) UTF aware string marshalling
--
--  Author : Axel Simon
--
--  Created: 22 June 2001
--
--  Copyright (c) 1999..2002 Axel Simon
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public
--  License as published by the Free Software Foundation; either
--  version 2.1 of the License, or (at your option) any later version.
--
--  This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  Lesser General Public License for more details.
--
-- |
-- Maintainer  : gtk2hs-users@lists.sourceforge.net
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
-- This module adds CString-like functions that handle UTF8 strings.
--

module System.Glib.UTFString (
  GlibString(..),
  readUTFString,
  readCString,
  withUTFStrings,
  withUTFStringArray,
  withUTFStringArray0,
  peekUTFStringArray,
  peekUTFStringArray0,
  readUTFStringArray0,
  UTFCorrection,
  ofsToUTF,
  ofsFromUTF,

  glibToString,
  stringToGlib,

  DefaultGlibString,

  GlibFilePath(..),
  withUTFFilePaths,
  withUTFFilePathArray,
  withUTFFilePathArray0,
  peekUTFFilePathArray0,
  readUTFFilePathArray0
  ) where

import Codec.Binary.UTF8.String
import Control.Applicative ((<$>))
import Control.Monad (liftM)
import Data.Char (ord, chr)
import Data.Maybe (maybe)
import Data.String (IsString)
import Data.Monoid (Monoid)
import System.Glib.FFI
import qualified Data.Text as T (replace, length, pack, unpack, Text)
import qualified Data.Text.Foreign as T
       (withCStringLen, peekCStringLen)
import Data.ByteString (useAsCString)
import Data.Text.Encoding (encodeUtf8)

class (IsString s, Monoid s, Show s) => GlibString s where
    -- | Like 'withCString' but using the UTF-8 encoding.
    --
    withUTFString :: s -> (CString -> IO a) -> IO a

    -- | Like 'withCStringLen' but using the UTF-8 encoding.
    --
    withUTFStringLen :: s -> (CStringLen -> IO a) -> IO a

    -- | Like 'peekCString' but using the UTF-8 encoding.
    --
    peekUTFString :: CString -> IO s

    -- | Like 'maybePeek' 'peekCString' but using the UTF-8 encoding to retrieve
    -- UTF-8 from a 'CString' which may be the 'nullPtr'.
    --
    maybePeekUTFString :: CString -> IO (Maybe s)

    -- | Like 'peekCStringLen' but using the UTF-8 encoding.
    --
    peekUTFStringLen :: CStringLen -> IO s

    -- | Like 'newCString' but using the UTF-8 encoding.
    --
    newUTFString :: s -> IO CString

    -- | Like  Define newUTFStringLen to emit UTF-8.
    --
    newUTFStringLen :: s -> IO CStringLen

    -- | Create a list of offset corrections.
    --
    genUTFOfs :: s -> UTFCorrection

    -- | Length of the string in characters
    --
    stringLength :: s -> Int

    -- Escape percent signs (used in MessageDialog)
    unPrintf :: s -> s

-- GTK+ has a lot of asserts that the ptr is not NULL even if the length is 0
-- Until they fix this we need to fudge pointer values to keep the noise level
-- in the logs.
noNullPtrs :: CStringLen -> CStringLen
noNullPtrs :: CStringLen -> CStringLen
noNullPtrs (Ptr CChar
p, Int
0) | Ptr CChar
p Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CChar
forall a. Ptr a
nullPtr = (Ptr CChar -> Int -> Ptr CChar
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr CChar
p Int
1, Int
0)
noNullPtrs CStringLen
s = CStringLen
s

instance GlibString [Char] where
    withUTFString :: forall a. [Char] -> (Ptr CChar -> IO a) -> IO a
withUTFString = [Char] -> (Ptr CChar -> IO a) -> IO a
forall a. [Char] -> (Ptr CChar -> IO a) -> IO a
withCAString ([Char] -> (Ptr CChar -> IO a) -> IO a)
-> ([Char] -> [Char]) -> [Char] -> (Ptr CChar -> IO a) -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
encodeString
    withUTFStringLen :: forall a. [Char] -> (CStringLen -> IO a) -> IO a
withUTFStringLen [Char]
s CStringLen -> IO a
f = [Char] -> (CStringLen -> IO a) -> IO a
forall a. [Char] -> (CStringLen -> IO a) -> IO a
withCAStringLen ([Char] -> [Char]
encodeString [Char]
s) (CStringLen -> IO a
f (CStringLen -> IO a)
-> (CStringLen -> CStringLen) -> CStringLen -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CStringLen -> CStringLen
noNullPtrs)
    peekUTFString :: Ptr CChar -> IO [Char]
peekUTFString = ([Char] -> [Char]) -> IO [Char] -> IO [Char]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Char] -> [Char]
decodeString (IO [Char] -> IO [Char])
-> (Ptr CChar -> IO [Char]) -> Ptr CChar -> IO [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr CChar -> IO [Char]
peekCAString
    maybePeekUTFString :: Ptr CChar -> IO (Maybe [Char])
maybePeekUTFString = (Maybe [Char] -> Maybe [Char])
-> IO (Maybe [Char]) -> IO (Maybe [Char])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Maybe [Char]
-> ([Char] -> Maybe [Char]) -> Maybe [Char] -> Maybe [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe [Char]
forall a. Maybe a
Nothing ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char])
-> ([Char] -> [Char]) -> [Char] -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
decodeString)) (IO (Maybe [Char]) -> IO (Maybe [Char]))
-> (Ptr CChar -> IO (Maybe [Char]))
-> Ptr CChar
-> IO (Maybe [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr CChar -> IO [Char]) -> Ptr CChar -> IO (Maybe [Char])
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr CChar -> IO [Char]
peekCAString
    peekUTFStringLen :: CStringLen -> IO [Char]
peekUTFStringLen = ([Char] -> [Char]) -> IO [Char] -> IO [Char]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Char] -> [Char]
decodeString (IO [Char] -> IO [Char])
-> (CStringLen -> IO [Char]) -> CStringLen -> IO [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CStringLen -> IO [Char]
peekCAStringLen
    newUTFString :: [Char] -> IO (Ptr CChar)
newUTFString = [Char] -> IO (Ptr CChar)
newCAString ([Char] -> IO (Ptr CChar))
-> ([Char] -> [Char]) -> [Char] -> IO (Ptr CChar)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
encodeString
    newUTFStringLen :: [Char] -> IO CStringLen
newUTFStringLen = [Char] -> IO CStringLen
newCAStringLen ([Char] -> IO CStringLen)
-> ([Char] -> [Char]) -> [Char] -> IO CStringLen
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
encodeString
    genUTFOfs :: [Char] -> UTFCorrection
genUTFOfs [Char]
str = [Int] -> UTFCorrection
UTFCorrection (Int -> [Char] -> [Int]
forall {a}. Num a => a -> [Char] -> [a]
gUO Int
0 [Char]
str)
      where
      gUO :: a -> [Char] -> [a]
gUO a
n [] = []
      gUO a
n (Char
x:[Char]
xs) | Char -> Int
ord Char
xInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
0x007F = a -> [Char] -> [a]
gUO (a
na -> a -> a
forall a. Num a => a -> a -> a
+a
1) [Char]
xs
                   | Char -> Int
ord Char
xInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
0x07FF = a
na -> [a] -> [a]
forall a. a -> [a] -> [a]
:a -> [Char] -> [a]
gUO (a
na -> a -> a
forall a. Num a => a -> a -> a
+a
1) [Char]
xs
                   | Char -> Int
ord Char
xInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
0xFFFF = a
na -> [a] -> [a]
forall a. a -> [a] -> [a]
:a
na -> [a] -> [a]
forall a. a -> [a] -> [a]
:a -> [Char] -> [a]
gUO (a
na -> a -> a
forall a. Num a => a -> a -> a
+a
1) [Char]
xs
                   | Bool
otherwise     = a
na -> [a] -> [a]
forall a. a -> [a] -> [a]
:a
na -> [a] -> [a]
forall a. a -> [a] -> [a]
:a
na -> [a] -> [a]
forall a. a -> [a] -> [a]
:a -> [Char] -> [a]
gUO (a
na -> a -> a
forall a. Num a => a -> a -> a
+a
1) [Char]
xs
    stringLength :: [Char] -> Int
stringLength = [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
    unPrintf :: [Char] -> [Char]
unPrintf [Char]
s = [Char]
s [Char] -> (Char -> [Char]) -> [Char]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> [Char]
forall {m :: * -> *}.
(IsString (m Char), Monad m) =>
Char -> m Char
replace
        where
            replace :: Char -> m Char
replace Char
'%' = m Char
"%%"
            replace Char
c = Char -> m Char
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c

foreign import ccall unsafe "string.h strlen" c_strlen
    :: CString -> IO CSize

instance GlibString T.Text where
    withUTFString :: forall a. Text -> (Ptr CChar -> IO a) -> IO a
withUTFString = ByteString -> (Ptr CChar -> IO a) -> IO a
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
useAsCString (ByteString -> (Ptr CChar -> IO a) -> IO a)
-> (Text -> ByteString) -> Text -> (Ptr CChar -> IO a) -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8
    withUTFStringLen :: forall a. Text -> (CStringLen -> IO a) -> IO a
withUTFStringLen Text
s CStringLen -> IO a
f = Text -> (CStringLen -> IO a) -> IO a
forall a. Text -> (CStringLen -> IO a) -> IO a
T.withCStringLen Text
s (CStringLen -> IO a
f (CStringLen -> IO a)
-> (CStringLen -> CStringLen) -> CStringLen -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CStringLen -> CStringLen
noNullPtrs)
    peekUTFString :: Ptr CChar -> IO Text
peekUTFString Ptr CChar
s = do
        CSize
len <- Ptr CChar -> IO CSize
c_strlen Ptr CChar
s
        CStringLen -> IO Text
T.peekCStringLen (Ptr CChar
s, CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
len)
    maybePeekUTFString :: Ptr CChar -> IO (Maybe Text)
maybePeekUTFString = (Ptr CChar -> IO Text) -> Ptr CChar -> IO (Maybe Text)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr CChar -> IO Text
forall s. GlibString s => Ptr CChar -> IO s
peekUTFString
    peekUTFStringLen :: CStringLen -> IO Text
peekUTFStringLen = CStringLen -> IO Text
T.peekCStringLen
    newUTFString :: Text -> IO (Ptr CChar)
newUTFString = [Char] -> IO (Ptr CChar)
forall s. GlibString s => s -> IO (Ptr CChar)
newUTFString ([Char] -> IO (Ptr CChar))
-> (Text -> [Char]) -> Text -> IO (Ptr CChar)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack -- TODO optimize
    newUTFStringLen :: Text -> IO CStringLen
newUTFStringLen = [Char] -> IO CStringLen
forall s. GlibString s => s -> IO CStringLen
newUTFStringLen ([Char] -> IO CStringLen)
-> (Text -> [Char]) -> Text -> IO CStringLen
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack -- TODO optimize
    genUTFOfs :: Text -> UTFCorrection
genUTFOfs = [Char] -> UTFCorrection
forall s. GlibString s => s -> UTFCorrection
genUTFOfs ([Char] -> UTFCorrection)
-> (Text -> [Char]) -> Text -> UTFCorrection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack -- TODO optimize
    stringLength :: Text -> Int
stringLength = Text -> Int
T.length
    unPrintf :: Text -> Text
unPrintf = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"%" Text
"%%"

glibToString :: T.Text -> String
glibToString :: Text -> [Char]
glibToString = Text -> [Char]
T.unpack

stringToGlib :: String -> T.Text
stringToGlib :: [Char] -> Text
stringToGlib = [Char] -> Text
T.pack

-- | Like like 'peekUTFString' but then frees the string using g_free
--
readUTFString :: GlibString s => CString -> IO s
readUTFString :: forall s. GlibString s => Ptr CChar -> IO s
readUTFString Ptr CChar
strPtr = do
  s
str <- Ptr CChar -> IO s
forall s. GlibString s => Ptr CChar -> IO s
peekUTFString Ptr CChar
strPtr
  Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
g_free Ptr CChar
strPtr
  s -> IO s
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return s
str

-- | Like 'peekCString' but then frees the string using @g_free@.
--
readCString :: CString -> IO String
readCString :: Ptr CChar -> IO [Char]
readCString Ptr CChar
strPtr = do
  [Char]
str <- Ptr CChar -> IO [Char]
peekCAString Ptr CChar
strPtr
  Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
g_free Ptr CChar
strPtr
  [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
str

foreign import ccall unsafe "g_free"
  g_free :: Ptr a -> IO ()

-- | Temporarily allocate a list of UTF-8 'CString's.
--
withUTFStrings :: GlibString s => [s] -> ([CString] -> IO a) -> IO a
withUTFStrings :: forall s a. GlibString s => [s] -> ([Ptr CChar] -> IO a) -> IO a
withUTFStrings [s]
hsStrs = [s] -> [Ptr CChar] -> ([Ptr CChar] -> IO a) -> IO a
forall s a.
GlibString s =>
[s] -> [Ptr CChar] -> ([Ptr CChar] -> IO a) -> IO a
withUTFStrings' [s]
hsStrs []
  where withUTFStrings' :: GlibString s => [s] -> [CString] -> ([CString] -> IO a) -> IO a
        withUTFStrings' :: forall s a.
GlibString s =>
[s] -> [Ptr CChar] -> ([Ptr CChar] -> IO a) -> IO a
withUTFStrings' []     [Ptr CChar]
cs [Ptr CChar] -> IO a
body = [Ptr CChar] -> IO a
body ([Ptr CChar] -> [Ptr CChar]
forall a. [a] -> [a]
reverse [Ptr CChar]
cs)
        withUTFStrings' (s
s:[s]
ss) [Ptr CChar]
cs [Ptr CChar] -> IO a
body = s -> (Ptr CChar -> IO a) -> IO a
forall a. s -> (Ptr CChar -> IO a) -> IO a
forall s a. GlibString s => s -> (Ptr CChar -> IO a) -> IO a
withUTFString s
s ((Ptr CChar -> IO a) -> IO a) -> (Ptr CChar -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
c ->
                                         [s] -> [Ptr CChar] -> ([Ptr CChar] -> IO a) -> IO a
forall s a.
GlibString s =>
[s] -> [Ptr CChar] -> ([Ptr CChar] -> IO a) -> IO a
withUTFStrings' [s]
ss (Ptr CChar
cPtr CChar -> [Ptr CChar] -> [Ptr CChar]
forall a. a -> [a] -> [a]
:[Ptr CChar]
cs) [Ptr CChar] -> IO a
body

-- | Temporarily allocate an array of UTF-8 encoded 'CString's.
--
withUTFStringArray :: GlibString s => [s] -> (Ptr CString -> IO a) -> IO a
withUTFStringArray :: forall s a.
GlibString s =>
[s] -> (Ptr (Ptr CChar) -> IO a) -> IO a
withUTFStringArray [s]
hsStr Ptr (Ptr CChar) -> IO a
body =
  [s] -> ([Ptr CChar] -> IO a) -> IO a
forall s a. GlibString s => [s] -> ([Ptr CChar] -> IO a) -> IO a
withUTFStrings [s]
hsStr (([Ptr CChar] -> IO a) -> IO a) -> ([Ptr CChar] -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \[Ptr CChar]
cStrs -> do
  [Ptr CChar] -> (Ptr (Ptr CChar) -> IO a) -> IO a
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Ptr CChar]
cStrs Ptr (Ptr CChar) -> IO a
body

-- | Temporarily allocate a null-terminated array of UTF-8 encoded 'CString's.
--
withUTFStringArray0 :: GlibString s => [s] -> (Ptr CString -> IO a) -> IO a
withUTFStringArray0 :: forall s a.
GlibString s =>
[s] -> (Ptr (Ptr CChar) -> IO a) -> IO a
withUTFStringArray0 [s]
hsStr Ptr (Ptr CChar) -> IO a
body =
  [s] -> ([Ptr CChar] -> IO a) -> IO a
forall s a. GlibString s => [s] -> ([Ptr CChar] -> IO a) -> IO a
withUTFStrings [s]
hsStr (([Ptr CChar] -> IO a) -> IO a) -> ([Ptr CChar] -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \[Ptr CChar]
cStrs -> do
  Ptr CChar -> [Ptr CChar] -> (Ptr (Ptr CChar) -> IO a) -> IO a
forall a b. Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b
withArray0 Ptr CChar
forall a. Ptr a
nullPtr [Ptr CChar]
cStrs Ptr (Ptr CChar) -> IO a
body

-- | Convert an array (of the given length) of UTF-8 encoded 'CString's to a
--   list of Haskell 'String's.
--
peekUTFStringArray :: GlibString s => Int -> Ptr CString -> IO [s]
peekUTFStringArray :: forall s. GlibString s => Int -> Ptr (Ptr CChar) -> IO [s]
peekUTFStringArray Int
len Ptr (Ptr CChar)
cStrArr = do
  [Ptr CChar]
cStrs <- Int -> Ptr (Ptr CChar) -> IO [Ptr CChar]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
len Ptr (Ptr CChar)
cStrArr
  (Ptr CChar -> IO s) -> [Ptr CChar] -> IO [s]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Ptr CChar -> IO s
forall s. GlibString s => Ptr CChar -> IO s
peekUTFString [Ptr CChar]
cStrs

-- | Convert a null-terminated array of UTF-8 encoded 'CString's to a list of
--   Haskell 'String's.
--
peekUTFStringArray0 :: GlibString s => Ptr CString -> IO [s]
peekUTFStringArray0 :: forall s. GlibString s => Ptr (Ptr CChar) -> IO [s]
peekUTFStringArray0 Ptr (Ptr CChar)
cStrArr = do
  [Ptr CChar]
cStrs <- Ptr CChar -> Ptr (Ptr CChar) -> IO [Ptr CChar]
forall a. (Storable a, Eq a) => a -> Ptr a -> IO [a]
peekArray0 Ptr CChar
forall a. Ptr a
nullPtr Ptr (Ptr CChar)
cStrArr
  (Ptr CChar -> IO s) -> [Ptr CChar] -> IO [s]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Ptr CChar -> IO s
forall s. GlibString s => Ptr CChar -> IO s
peekUTFString [Ptr CChar]
cStrs

-- | Like 'peekUTFStringArray0' but then free the string array including all
-- strings.
--
-- To be used when functions indicate that their return value should be freed
-- with @g_strfreev@.
--
readUTFStringArray0 :: GlibString s => Ptr CString -> IO [s]
readUTFStringArray0 :: forall s. GlibString s => Ptr (Ptr CChar) -> IO [s]
readUTFStringArray0 Ptr (Ptr CChar)
cStrArr | Ptr (Ptr CChar)
cStrArr Ptr (Ptr CChar) -> Ptr (Ptr CChar) -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr (Ptr CChar)
forall a. Ptr a
nullPtr = [s] -> IO [s]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
                            | Bool
otherwise = do
  [Ptr CChar]
cStrs <- Ptr CChar -> Ptr (Ptr CChar) -> IO [Ptr CChar]
forall a. (Storable a, Eq a) => a -> Ptr a -> IO [a]
peekArray0 Ptr CChar
forall a. Ptr a
nullPtr Ptr (Ptr CChar)
cStrArr
  [s]
strings <- (Ptr CChar -> IO s) -> [Ptr CChar] -> IO [s]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Ptr CChar -> IO s
forall s. GlibString s => Ptr CChar -> IO s
peekUTFString [Ptr CChar]
cStrs
  Ptr (Ptr CChar) -> IO ()
forall a. Ptr a -> IO ()
g_strfreev Ptr (Ptr CChar)
cStrArr
  [s] -> IO [s]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [s]
strings

foreign import ccall unsafe "g_strfreev"
  g_strfreev :: Ptr a -> IO ()

-- | Offset correction for String to UTF8 mapping.
--
newtype UTFCorrection = UTFCorrection [Int] deriving Int -> UTFCorrection -> [Char] -> [Char]
[UTFCorrection] -> [Char] -> [Char]
UTFCorrection -> [Char]
(Int -> UTFCorrection -> [Char] -> [Char])
-> (UTFCorrection -> [Char])
-> ([UTFCorrection] -> [Char] -> [Char])
-> Show UTFCorrection
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> UTFCorrection -> [Char] -> [Char]
showsPrec :: Int -> UTFCorrection -> [Char] -> [Char]
$cshow :: UTFCorrection -> [Char]
show :: UTFCorrection -> [Char]
$cshowList :: [UTFCorrection] -> [Char] -> [Char]
showList :: [UTFCorrection] -> [Char] -> [Char]
Show

ofsToUTF :: Int -> UTFCorrection -> Int
ofsToUTF :: Int -> UTFCorrection -> Int
ofsToUTF Int
n (UTFCorrection [Int]
oc) = [Int] -> Int
oTU [Int]
oc
  where
  oTU :: [Int] -> Int
oTU [] = Int
n
  oTU (Int
x:[Int]
xs) | Int
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
x = Int
n
             | Bool
otherwise = Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+[Int] -> Int
oTU [Int]
xs

ofsFromUTF :: Int -> UTFCorrection -> Int
ofsFromUTF :: Int -> UTFCorrection -> Int
ofsFromUTF Int
n (UTFCorrection [Int]
oc) = Int -> [Int] -> Int
forall {t}. (Ord t, Num t) => t -> [t] -> t
oFU Int
n [Int]
oc
  where
  oFU :: t -> [t] -> t
oFU t
n [] = t
n
  oFU t
n (t
x:[t]
xs) | t
nt -> t -> Bool
forall a. Ord a => a -> a -> Bool
<=t
x = t
n
               | Bool
otherwise = t -> [t] -> t
oFU (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1) [t]
xs

type DefaultGlibString = T.Text

class fp ~ FilePath => GlibFilePath fp where
    withUTFFilePath :: fp -> (CString -> IO a) -> IO a
    peekUTFFilePath :: CString -> IO fp

instance GlibFilePath FilePath where
    withUTFFilePath :: forall a. [Char] -> (Ptr CChar -> IO a) -> IO a
withUTFFilePath = Text -> (Ptr CChar -> IO a) -> IO a
forall a. Text -> (Ptr CChar -> IO a) -> IO a
forall s a. GlibString s => s -> (Ptr CChar -> IO a) -> IO a
withUTFString (Text -> (Ptr CChar -> IO a) -> IO a)
-> ([Char] -> Text) -> [Char] -> (Ptr CChar -> IO a) -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack
    peekUTFFilePath :: Ptr CChar -> IO [Char]
peekUTFFilePath Ptr CChar
f = Text -> [Char]
T.unpack (Text -> [Char]) -> IO Text -> IO [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CChar -> IO Text
forall s. GlibString s => Ptr CChar -> IO s
peekUTFString Ptr CChar
f

withUTFFilePaths :: GlibFilePath fp => [fp] -> ([CString] -> IO a) -> IO a
withUTFFilePaths :: forall fp a.
GlibFilePath fp =>
[fp] -> ([Ptr CChar] -> IO a) -> IO a
withUTFFilePaths [fp]
hsStrs = [fp] -> [Ptr CChar] -> ([Ptr CChar] -> IO a) -> IO a
forall fp a.
GlibFilePath fp =>
[fp] -> [Ptr CChar] -> ([Ptr CChar] -> IO a) -> IO a
withUTFFilePath' [fp]
hsStrs []
  where withUTFFilePath' :: GlibFilePath fp => [fp] -> [CString] -> ([CString] -> IO a) -> IO a
        withUTFFilePath' :: forall fp a.
GlibFilePath fp =>
[fp] -> [Ptr CChar] -> ([Ptr CChar] -> IO a) -> IO a
withUTFFilePath' []       [Ptr CChar]
cs [Ptr CChar] -> IO a
body = [Ptr CChar] -> IO a
body ([Ptr CChar] -> [Ptr CChar]
forall a. [a] -> [a]
reverse [Ptr CChar]
cs)
        withUTFFilePath' (fp
fp:[fp]
fps) [Ptr CChar]
cs [Ptr CChar] -> IO a
body = fp -> (Ptr CChar -> IO a) -> IO a
forall a. fp -> (Ptr CChar -> IO a) -> IO a
forall fp a. GlibFilePath fp => fp -> (Ptr CChar -> IO a) -> IO a
withUTFFilePath fp
fp ((Ptr CChar -> IO a) -> IO a) -> (Ptr CChar -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
c ->
                                            [fp] -> [Ptr CChar] -> ([Ptr CChar] -> IO a) -> IO a
forall fp a.
GlibFilePath fp =>
[fp] -> [Ptr CChar] -> ([Ptr CChar] -> IO a) -> IO a
withUTFFilePath' [fp]
fps (Ptr CChar
cPtr CChar -> [Ptr CChar] -> [Ptr CChar]
forall a. a -> [a] -> [a]
:[Ptr CChar]
cs) [Ptr CChar] -> IO a
body

withUTFFilePathArray :: GlibFilePath fp => [fp] -> (Ptr CString -> IO a) -> IO a
withUTFFilePathArray :: forall fp a.
GlibFilePath fp =>
[fp] -> (Ptr (Ptr CChar) -> IO a) -> IO a
withUTFFilePathArray [fp]
hsFP Ptr (Ptr CChar) -> IO a
body =
  [fp] -> ([Ptr CChar] -> IO a) -> IO a
forall fp a.
GlibFilePath fp =>
[fp] -> ([Ptr CChar] -> IO a) -> IO a
withUTFFilePaths [fp]
hsFP (([Ptr CChar] -> IO a) -> IO a) -> ([Ptr CChar] -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \[Ptr CChar]
cStrs -> do
  [Ptr CChar] -> (Ptr (Ptr CChar) -> IO a) -> IO a
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Ptr CChar]
cStrs Ptr (Ptr CChar) -> IO a
body

withUTFFilePathArray0 :: GlibFilePath fp => [fp] -> (Ptr CString -> IO a) -> IO a
withUTFFilePathArray0 :: forall fp a.
GlibFilePath fp =>
[fp] -> (Ptr (Ptr CChar) -> IO a) -> IO a
withUTFFilePathArray0 [fp]
hsFP Ptr (Ptr CChar) -> IO a
body =
  [fp] -> ([Ptr CChar] -> IO a) -> IO a
forall fp a.
GlibFilePath fp =>
[fp] -> ([Ptr CChar] -> IO a) -> IO a
withUTFFilePaths [fp]
hsFP (([Ptr CChar] -> IO a) -> IO a) -> ([Ptr CChar] -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \[Ptr CChar]
cStrs -> do
  Ptr CChar -> [Ptr CChar] -> (Ptr (Ptr CChar) -> IO a) -> IO a
forall a b. Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b
withArray0 Ptr CChar
forall a. Ptr a
nullPtr [Ptr CChar]
cStrs Ptr (Ptr CChar) -> IO a
body

peekUTFFilePathArray0 :: GlibFilePath fp => Ptr CString -> IO [fp]
peekUTFFilePathArray0 :: forall fp. GlibFilePath fp => Ptr (Ptr CChar) -> IO [fp]
peekUTFFilePathArray0 Ptr (Ptr CChar)
cStrArr = do
  [Ptr CChar]
cStrs <- Ptr CChar -> Ptr (Ptr CChar) -> IO [Ptr CChar]
forall a. (Storable a, Eq a) => a -> Ptr a -> IO [a]
peekArray0 Ptr CChar
forall a. Ptr a
nullPtr Ptr (Ptr CChar)
cStrArr
  (Ptr CChar -> IO fp) -> [Ptr CChar] -> IO [fp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Ptr CChar -> IO fp
forall fp. GlibFilePath fp => Ptr CChar -> IO fp
peekUTFFilePath [Ptr CChar]
cStrs

readUTFFilePathArray0 :: GlibFilePath fp => Ptr CString -> IO [fp]
readUTFFilePathArray0 :: forall fp. GlibFilePath fp => Ptr (Ptr CChar) -> IO [fp]
readUTFFilePathArray0 Ptr (Ptr CChar)
cStrArr | Ptr (Ptr CChar)
cStrArr Ptr (Ptr CChar) -> Ptr (Ptr CChar) -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr (Ptr CChar)
forall a. Ptr a
nullPtr = [fp] -> IO [fp]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
                              | Bool
otherwise = do
  [Ptr CChar]
cStrs <- Ptr CChar -> Ptr (Ptr CChar) -> IO [Ptr CChar]
forall a. (Storable a, Eq a) => a -> Ptr a -> IO [a]
peekArray0 Ptr CChar
forall a. Ptr a
nullPtr Ptr (Ptr CChar)
cStrArr
  [fp]
fps <- (Ptr CChar -> IO fp) -> [Ptr CChar] -> IO [fp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Ptr CChar -> IO fp
forall fp. GlibFilePath fp => Ptr CChar -> IO fp
peekUTFFilePath [Ptr CChar]
cStrs
  Ptr (Ptr CChar) -> IO ()
forall a. Ptr a -> IO ()
g_strfreev Ptr (Ptr CChar)
cStrArr
  [fp] -> IO [fp]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [fp]
fps