{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE PatternSynonyms #-}

module Data.UCL
( UCL(..)
, parseString
, parseByteString
, parseFile
) where

import Foreign.C
  ( CUInt(..), CInt(..), CSize(..), CDouble(..), CString, CStringLen
  , withCString, withCStringLen, peekCString )
import Foreign.Ptr (Ptr, FunPtr, nullPtr)
import Foreign.ForeignPtr
import qualified Data.Text.Foreign as TF
import Data.Text (Text)
import qualified Data.Map as Map
import Data.Map (Map)
import Data.Time.Clock (DiffTime)
import Data.ByteString (ByteString, useAsCStringLen)
import Control.Monad ((>=>))


-- Low-level bindings
---------------------

data Parser
data UCLObject
data UCLIter

type UCL_TYPE = CUInt
pattern UCL_OBJECT :: UCL_TYPE
pattern $bUCL_OBJECT :: UCL_TYPE
$mUCL_OBJECT :: forall {r}. UCL_TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
UCL_OBJECT = 0
pattern UCL_ARRAY :: UCL_TYPE
pattern $bUCL_ARRAY :: UCL_TYPE
$mUCL_ARRAY :: forall {r}. UCL_TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
UCL_ARRAY = 1
pattern UCL_INT :: UCL_TYPE
pattern $bUCL_INT :: UCL_TYPE
$mUCL_INT :: forall {r}. UCL_TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
UCL_INT = 2
pattern UCL_FLOAT :: UCL_TYPE
pattern $bUCL_FLOAT :: UCL_TYPE
$mUCL_FLOAT :: forall {r}. UCL_TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
UCL_FLOAT = 3
pattern UCL_STRING :: UCL_TYPE
pattern $bUCL_STRING :: UCL_TYPE
$mUCL_STRING :: forall {r}. UCL_TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
UCL_STRING = 4
pattern UCL_BOOLEAN :: UCL_TYPE
pattern $bUCL_BOOLEAN :: UCL_TYPE
$mUCL_BOOLEAN :: forall {r}. UCL_TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
UCL_BOOLEAN = 5
pattern UCL_TIME :: UCL_TYPE
pattern $bUCL_TIME :: UCL_TYPE
$mUCL_TIME :: forall {r}. UCL_TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
UCL_TIME = 6
pattern UCL_USERDATA :: UCL_TYPE
pattern $bUCL_USERDATA :: UCL_TYPE
$mUCL_USERDATA :: forall {r}. UCL_TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
UCL_USERDATA = 7
pattern UCL_NULL :: UCL_TYPE
pattern $bUCL_NULL :: UCL_TYPE
$mUCL_NULL :: forall {r}. UCL_TYPE -> ((# #) -> r) -> ((# #) -> r) -> r
UCL_NULL = 8

foreign import ccall "ucl_parser_new" ucl_parser_new :: CInt -> IO (Ptr Parser)
foreign import ccall "ucl_parser_add_string" ucl_parser_add_string :: Ptr Parser -> CString -> CSize -> IO Bool
foreign import ccall "ucl_parser_add_file" ucl_parser_add_file :: Ptr Parser -> CString -> IO Bool
foreign import ccall "ucl_parser_get_object" ucl_parser_get_object :: Ptr Parser -> IO (Ptr UCLObject)
foreign import ccall "ucl_parser_get_error" ucl_parser_get_error :: Ptr Parser -> IO CString
foreign import ccall "&ucl_parser_free" p_ucl_parser_free :: FunPtr (Ptr Parser -> IO ())

foreign import ccall "ucl_object_iterate_new" ucl_object_iterate_new :: Ptr UCLObject -> IO (Ptr UCLIter)
foreign import ccall "ucl_object_iterate_safe" ucl_object_iterate_safe :: Ptr UCLIter -> Bool -> IO (Ptr UCLObject)
foreign import ccall "&ucl_object_iterate_free" p_ucl_object_iterate_free :: FunPtr (Ptr UCLIter -> IO ())
foreign import ccall "ucl_object_type" ucl_object_type :: Ptr UCLObject -> IO UCL_TYPE
foreign import ccall "ucl_object_key" ucl_object_key :: Ptr UCLObject -> IO CString
foreign import ccall "ucl_object_toint" ucl_object_toint :: Ptr UCLObject -> IO CInt
foreign import ccall "ucl_object_todouble" ucl_object_todouble :: Ptr UCLObject -> IO CDouble
foreign import ccall "ucl_object_tostring" ucl_object_tostring :: Ptr UCLObject -> IO CString
foreign import ccall "ucl_object_toboolean" ucl_object_toboolean :: Ptr UCLObject -> IO Bool
foreign import ccall "&ucl_object_unref" p_ucl_object_unref :: FunPtr (Ptr UCLObject -> IO ())

foreign import ccall "strlen" c_strlen :: CString -> IO CSize


-- Mid level interface with ForeignPtr
--------------------------------------

newParser :: IO (ForeignPtr Parser)
newParser :: IO (ForeignPtr Parser)
newParser = CInt -> IO (Ptr Parser)
ucl_parser_new CInt
0x0 IO (Ptr Parser)
-> (Ptr Parser -> IO (ForeignPtr Parser)) -> IO (ForeignPtr Parser)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FinalizerPtr Parser -> Ptr Parser -> IO (ForeignPtr Parser)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Parser
p_ucl_parser_free

addString :: ForeignPtr Parser -> CStringLen -> IO Bool
addString :: ForeignPtr Parser -> CStringLen -> IO Bool
addString ForeignPtr Parser
fp (Ptr CChar
cs, Int
len) = ForeignPtr Parser -> (Ptr Parser -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Parser
fp ((Ptr Parser -> IO Bool) -> IO Bool)
-> (Ptr Parser -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Parser
p ->
  Ptr Parser -> Ptr CChar -> CSize -> IO Bool
ucl_parser_add_string Ptr Parser
p Ptr CChar
cs (CSize -> IO Bool) -> CSize -> IO Bool
forall a b. (a -> b) -> a -> b
$ Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len

addFile :: ForeignPtr Parser -> FilePath -> IO Bool
addFile :: ForeignPtr Parser -> FilePath -> IO Bool
addFile ForeignPtr Parser
fp FilePath
s = FilePath -> (Ptr CChar -> IO Bool) -> IO Bool
forall a. FilePath -> (Ptr CChar -> IO a) -> IO a
withCString FilePath
s ((Ptr CChar -> IO Bool) -> IO Bool)
-> (Ptr CChar -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
cs ->
  ForeignPtr Parser -> (Ptr Parser -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Parser
fp ((Ptr Parser -> IO Bool) -> IO Bool)
-> (Ptr Parser -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Parser
p -> Ptr Parser -> Ptr CChar -> IO Bool
ucl_parser_add_file Ptr Parser
p Ptr CChar
cs

getObject :: ForeignPtr Parser -> IO (ForeignPtr UCLObject)
getObject :: ForeignPtr Parser -> IO (ForeignPtr UCLObject)
getObject = (ForeignPtr Parser
-> (Ptr Parser -> IO (Ptr UCLObject)) -> IO (Ptr UCLObject)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
`withForeignPtr` Ptr Parser -> IO (Ptr UCLObject)
ucl_parser_get_object) (ForeignPtr Parser -> IO (Ptr UCLObject))
-> (Ptr UCLObject -> IO (ForeignPtr UCLObject))
-> ForeignPtr Parser
-> IO (ForeignPtr UCLObject)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> FinalizerPtr UCLObject
-> Ptr UCLObject -> IO (ForeignPtr UCLObject)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr UCLObject
p_ucl_object_unref

getError :: ForeignPtr Parser -> IO String
getError :: ForeignPtr Parser -> IO FilePath
getError = (ForeignPtr Parser -> (Ptr Parser -> IO FilePath) -> IO FilePath
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
`withForeignPtr` (Ptr Parser -> IO (Ptr CChar)
ucl_parser_get_error (Ptr Parser -> IO (Ptr CChar))
-> (Ptr CChar -> IO FilePath) -> Ptr Parser -> IO FilePath
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Ptr CChar -> IO FilePath
peekCString))

newIterator :: Ptr UCLObject -> IO (ForeignPtr UCLIter)
newIterator :: Ptr UCLObject -> IO (ForeignPtr UCLIter)
newIterator = Ptr UCLObject -> IO (Ptr UCLIter)
ucl_object_iterate_new (Ptr UCLObject -> IO (Ptr UCLIter))
-> (Ptr UCLIter -> IO (ForeignPtr UCLIter))
-> Ptr UCLObject
-> IO (ForeignPtr UCLIter)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> FinalizerPtr UCLIter -> Ptr UCLIter -> IO (ForeignPtr UCLIter)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr UCLIter
p_ucl_object_iterate_free


peekCStringText :: CString -> IO Text
peekCStringText :: Ptr CChar -> IO Text
peekCStringText Ptr CChar
cstr = do
  CSize
len <- Ptr CChar -> IO CSize
c_strlen Ptr CChar
cstr
  CStringLen -> IO Text
TF.peekCStringLen (Ptr CChar
cstr, CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
len)

-- | Parse a 'ByteString' into a 'UCL', resolving includes, macros, variables...
-- Note that unicode does not get converted when using 'fromString'.
-- Prefer 'parseString' when working on 'String's or literals.
--
-- >>> parseByteString $ fromString "{a: [1,2], b: 3min, a: [4]}"
-- Right (UCLMap (fromList
--   [ ("a", UCLArray [UCLInt 1, UCLInt 2, UCLInt 4])
--   , ("b", UCLTime 180s                           )
--   ]))
--
-- This function is __not__ safe to call on untrusted input: configurations can
-- read files, make http requests, do "billion laughs" attacks, and possibly
-- crash the parser.
parseByteString :: ByteString -> IO (Either String UCL)
parseByteString :: ByteString -> IO (Either FilePath UCL)
parseByteString ByteString
bs = ByteString
-> (CStringLen -> IO (Either FilePath UCL))
-> IO (Either FilePath UCL)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
useAsCStringLen ByteString
bs CStringLen -> IO (Either FilePath UCL)
parseCStringLen

-- | Parse a 'String' into a 'UCL', resolving includes, macros, variables...
--
-- >>> parseString "{a: [1,2], 🌅: 3min, a: [4]}"
-- Right (UCLMap (fromList
--   [ ("a"      , UCLArray [UCLInt 1, UCLInt 2, UCLInt 4])
--   , ("\127749", UCLTime 180s                           )
--   ]))
--
-- This function is __not__ safe to call on untrusted input: configurations can
-- read files, make http requests, do "billion laughs" attacks, and possibly
-- crash the parser.
parseString :: String -> IO (Either String UCL)
parseString :: FilePath -> IO (Either FilePath UCL)
parseString = (FilePath
-> (CStringLen -> IO (Either FilePath UCL))
-> IO (Either FilePath UCL)
forall a. FilePath -> (CStringLen -> IO a) -> IO a
`withCStringLen` CStringLen -> IO (Either FilePath UCL)
parseCStringLen)

parseCStringLen :: CStringLen -> IO (Either String UCL)
parseCStringLen :: CStringLen -> IO (Either FilePath UCL)
parseCStringLen = (ForeignPtr Parser -> CStringLen -> IO Bool)
-> CStringLen -> IO (Either FilePath UCL)
forall a.
(ForeignPtr Parser -> a -> IO Bool)
-> a -> IO (Either FilePath UCL)
parseWith ForeignPtr Parser -> CStringLen -> IO Bool
addString

-- | Parse the contents of a file into a 'UCL', resolving includes, macros,
-- variables...
--
-- This function is __not__ safe to call on untrusted input: configurations can
-- read files, make http requests, do "billion laughs" attacks, and possibly
-- crash the parser.
parseFile :: FilePath -> IO (Either String UCL)
parseFile :: FilePath -> IO (Either FilePath UCL)
parseFile = (ForeignPtr Parser -> FilePath -> IO Bool)
-> FilePath -> IO (Either FilePath UCL)
forall a.
(ForeignPtr Parser -> a -> IO Bool)
-> a -> IO (Either FilePath UCL)
parseWith ForeignPtr Parser -> FilePath -> IO Bool
addFile

parseWith :: (ForeignPtr Parser -> a -> IO Bool) -> a -> IO (Either String UCL)
parseWith :: forall a.
(ForeignPtr Parser -> a -> IO Bool)
-> a -> IO (Either FilePath UCL)
parseWith ForeignPtr Parser -> a -> IO Bool
addX a
x = do
  ForeignPtr Parser
p <- IO (ForeignPtr Parser)
newParser
  Bool
didParse <- ForeignPtr Parser -> a -> IO Bool
addX ForeignPtr Parser
p a
x
  if Bool
didParse
  then UCL -> Either FilePath UCL
forall a b. b -> Either a b
Right (UCL -> Either FilePath UCL) -> IO UCL -> IO (Either FilePath UCL)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ForeignPtr Parser -> IO (ForeignPtr UCLObject)
getObject ForeignPtr Parser
p IO (ForeignPtr UCLObject)
-> (ForeignPtr UCLObject -> IO UCL) -> IO UCL
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ForeignPtr UCLObject -> (Ptr UCLObject -> IO UCL) -> IO UCL)
-> (Ptr UCLObject -> IO UCL) -> ForeignPtr UCLObject -> IO UCL
forall a b c. (a -> b -> c) -> b -> a -> c
flip ForeignPtr UCLObject -> (Ptr UCLObject -> IO UCL) -> IO UCL
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Ptr UCLObject -> IO UCL
foreignToUCL)
  else FilePath -> Either FilePath UCL
forall a b. a -> Either a b
Left (FilePath -> Either FilePath UCL)
-> IO FilePath -> IO (Either FilePath UCL)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ForeignPtr Parser -> IO FilePath
getError ForeignPtr Parser
p

-- | An UCL object
data UCL = UCLMap (Map Text UCL)
         | UCLArray [UCL]
         | UCLInt Int
         | UCLDouble Double
         | UCLText Text
         | UCLBool Bool
         | UCLTime DiffTime
  deriving (Int -> UCL -> ShowS
[UCL] -> ShowS
UCL -> FilePath
(Int -> UCL -> ShowS)
-> (UCL -> FilePath) -> ([UCL] -> ShowS) -> Show UCL
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [UCL] -> ShowS
$cshowList :: [UCL] -> ShowS
show :: UCL -> FilePath
$cshow :: UCL -> FilePath
showsPrec :: Int -> UCL -> ShowS
$cshowsPrec :: Int -> UCL -> ShowS
Show, UCL -> UCL -> Bool
(UCL -> UCL -> Bool) -> (UCL -> UCL -> Bool) -> Eq UCL
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UCL -> UCL -> Bool
$c/= :: UCL -> UCL -> Bool
== :: UCL -> UCL -> Bool
$c== :: UCL -> UCL -> Bool
Eq, Eq UCL
Eq UCL
-> (UCL -> UCL -> Ordering)
-> (UCL -> UCL -> Bool)
-> (UCL -> UCL -> Bool)
-> (UCL -> UCL -> Bool)
-> (UCL -> UCL -> Bool)
-> (UCL -> UCL -> UCL)
-> (UCL -> UCL -> UCL)
-> Ord UCL
UCL -> UCL -> Bool
UCL -> UCL -> Ordering
UCL -> UCL -> UCL
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UCL -> UCL -> UCL
$cmin :: UCL -> UCL -> UCL
max :: UCL -> UCL -> UCL
$cmax :: UCL -> UCL -> UCL
>= :: UCL -> UCL -> Bool
$c>= :: UCL -> UCL -> Bool
> :: UCL -> UCL -> Bool
$c> :: UCL -> UCL -> Bool
<= :: UCL -> UCL -> Bool
$c<= :: UCL -> UCL -> Bool
< :: UCL -> UCL -> Bool
$c< :: UCL -> UCL -> Bool
compare :: UCL -> UCL -> Ordering
$ccompare :: UCL -> UCL -> Ordering
Ord)

foreignToUCL :: Ptr UCLObject -> IO UCL
foreignToUCL :: Ptr UCLObject -> IO UCL
foreignToUCL Ptr UCLObject
obj = do
  UCL_TYPE
ty <- Ptr UCLObject -> IO UCL_TYPE
ucl_object_type Ptr UCLObject
obj
  case UCL_TYPE
ty of
    UCL_TYPE
UCL_OBJECT   -> Map Text UCL -> UCL
UCLMap (Map Text UCL -> UCL) -> IO (Map Text UCL) -> IO UCL
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr UCLObject -> IO (Map Text UCL)
uclObjectToMap Ptr UCLObject
obj
    UCL_TYPE
UCL_ARRAY    -> [UCL] -> UCL
UCLArray ([UCL] -> UCL) -> IO [UCL] -> IO UCL
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr UCLObject -> IO [UCL]
uclArrayToList Ptr UCLObject
obj
    UCL_TYPE
UCL_INT      -> Int -> UCL
UCLInt (Int -> UCL) -> (CInt -> Int) -> CInt -> UCL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> UCL) -> IO CInt -> IO UCL
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr UCLObject -> IO CInt
ucl_object_toint Ptr UCLObject
obj
    UCL_TYPE
UCL_FLOAT    -> Double -> UCL
UCLDouble (Double -> UCL) -> (CDouble -> Double) -> CDouble -> UCL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> UCL) -> IO CDouble -> IO UCL
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr UCLObject -> IO CDouble
ucl_object_todouble Ptr UCLObject
obj
    UCL_TYPE
UCL_STRING   -> Text -> UCL
UCLText (Text -> UCL) -> IO Text -> IO UCL
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr UCLObject -> IO (Ptr CChar)
ucl_object_tostring Ptr UCLObject
obj IO (Ptr CChar) -> (Ptr CChar -> IO Text) -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr CChar -> IO Text
peekCStringText)
    UCL_TYPE
UCL_BOOLEAN  -> Bool -> UCL
UCLBool (Bool -> UCL) -> IO Bool -> IO UCL
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr UCLObject -> IO Bool
ucl_object_toboolean Ptr UCLObject
obj
    UCL_TYPE
UCL_TIME     -> DiffTime -> UCL
UCLTime (DiffTime -> UCL) -> (CDouble -> DiffTime) -> CDouble -> UCL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> UCL) -> IO CDouble -> IO UCL
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr UCLObject -> IO CDouble
ucl_object_todouble Ptr UCLObject
obj
    -- TODO use Left instead of error
    UCL_TYPE
UCL_USERDATA -> FilePath -> IO UCL
forall a. HasCallStack => FilePath -> a
error FilePath
"Userdata object"
    -- TODO add UCLNull
    UCL_TYPE
UCL_NULL     -> FilePath -> IO UCL
forall a. HasCallStack => FilePath -> a
error FilePath
"Null object"
    UCL_TYPE
_            -> FilePath -> IO UCL
forall a. HasCallStack => FilePath -> a
error FilePath
"Unknown Type"

uclObjectToMap :: Ptr UCLObject -> IO (Map Text UCL)
uclObjectToMap :: Ptr UCLObject -> IO (Map Text UCL)
uclObjectToMap Ptr UCLObject
o = do
  ForeignPtr UCLIter
iter <- Ptr UCLObject -> IO (ForeignPtr UCLIter)
newIterator Ptr UCLObject
o
  ForeignPtr UCLIter -> Map Text UCL -> IO (Map Text UCL)
go ForeignPtr UCLIter
iter Map Text UCL
forall k a. Map k a
Map.empty
  where 
    go :: ForeignPtr UCLIter -> Map Text UCL -> IO (Map Text UCL)
go ForeignPtr UCLIter
it Map Text UCL
m = do
      -- NOTE: the reference count of the returned object is not increased,
      -- so we don't use ForeignPtr
      Ptr UCLObject
obj <- ForeignPtr UCLIter
-> (Ptr UCLIter -> IO (Ptr UCLObject)) -> IO (Ptr UCLObject)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr UCLIter
it (Ptr UCLIter -> Bool -> IO (Ptr UCLObject)
`ucl_object_iterate_safe` Bool
True)
      if Ptr UCLObject
obj Ptr UCLObject -> Ptr UCLObject -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr UCLObject
forall a. Ptr a
nullPtr
      then Map Text UCL -> IO (Map Text UCL)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Text UCL
m
      else do
        Text
k <- Ptr UCLObject -> IO (Ptr CChar)
ucl_object_key Ptr UCLObject
obj IO (Ptr CChar) -> (Ptr CChar -> IO Text) -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr CChar -> IO Text
peekCStringText
        UCL
v <- Ptr UCLObject -> IO UCL
foreignToUCL Ptr UCLObject
obj
        ForeignPtr UCLIter -> Map Text UCL -> IO (Map Text UCL)
go ForeignPtr UCLIter
it (Map Text UCL -> IO (Map Text UCL))
-> Map Text UCL -> IO (Map Text UCL)
forall a b. (a -> b) -> a -> b
$ Text -> UCL -> Map Text UCL -> Map Text UCL
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
k UCL
v Map Text UCL
m

uclArrayToList :: Ptr UCLObject -> IO [UCL]
uclArrayToList :: Ptr UCLObject -> IO [UCL]
uclArrayToList Ptr UCLObject
o = do
  ForeignPtr UCLIter
iter <- Ptr UCLObject -> IO (ForeignPtr UCLIter)
newIterator Ptr UCLObject
o
  ForeignPtr UCLIter -> IO [UCL]
go ForeignPtr UCLIter
iter
  where 
    go :: ForeignPtr UCLIter -> IO [UCL]
go ForeignPtr UCLIter
it = do
      -- NOTE: the reference count of the returned object is not increased
      -- so we don't use ForeignPtr
      Ptr UCLObject
obj <- ForeignPtr UCLIter
-> (Ptr UCLIter -> IO (Ptr UCLObject)) -> IO (Ptr UCLObject)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr UCLIter
it (Ptr UCLIter -> Bool -> IO (Ptr UCLObject)
`ucl_object_iterate_safe` Bool
True)
      if Ptr UCLObject
obj Ptr UCLObject -> Ptr UCLObject -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr UCLObject
forall a. Ptr a
nullPtr
      then [UCL] -> IO [UCL]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      else (:) (UCL -> [UCL] -> [UCL]) -> IO UCL -> IO ([UCL] -> [UCL])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr UCLObject -> IO UCL
foreignToUCL Ptr UCLObject
obj IO ([UCL] -> [UCL]) -> IO [UCL] -> IO [UCL]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ForeignPtr UCLIter -> IO [UCL]
go ForeignPtr UCLIter
it