{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE PatternSynonyms #-}
module Data.UCL
( UCL(..)
, parseString
, parseByteString
, parseFile
) where
import Foreign.C
import Foreign.Ptr
import System.IO.Unsafe (unsafePerformIO)
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)
newtype ParserHandle = ParserHandle (Ptr ())
newtype UCLObjectHandle = UCLObjectHandle (Ptr ())
newtype UCLIterHandle = UCLIterHandle (Ptr ())
type UCL_TYPE = CUInt
pattern UCL_OBJECT :: UCL_TYPE
pattern $bUCL_OBJECT :: UCL_TYPE
$mUCL_OBJECT :: forall r. UCL_TYPE -> (Void# -> r) -> (Void# -> r) -> r
UCL_OBJECT = 0
pattern UCL_ARRAY :: UCL_TYPE
pattern $bUCL_ARRAY :: UCL_TYPE
$mUCL_ARRAY :: forall r. UCL_TYPE -> (Void# -> r) -> (Void# -> r) -> r
UCL_ARRAY = 1
pattern UCL_INT :: UCL_TYPE
pattern $bUCL_INT :: UCL_TYPE
$mUCL_INT :: forall r. UCL_TYPE -> (Void# -> r) -> (Void# -> r) -> r
UCL_INT = 2
pattern UCL_FLOAT :: UCL_TYPE
pattern $bUCL_FLOAT :: UCL_TYPE
$mUCL_FLOAT :: forall r. UCL_TYPE -> (Void# -> r) -> (Void# -> r) -> r
UCL_FLOAT = 3
pattern UCL_STRING :: UCL_TYPE
pattern $bUCL_STRING :: UCL_TYPE
$mUCL_STRING :: forall r. UCL_TYPE -> (Void# -> r) -> (Void# -> r) -> r
UCL_STRING = 4
pattern UCL_BOOLEAN :: UCL_TYPE
pattern $bUCL_BOOLEAN :: UCL_TYPE
$mUCL_BOOLEAN :: forall r. UCL_TYPE -> (Void# -> r) -> (Void# -> r) -> r
UCL_BOOLEAN = 5
pattern UCL_TIME :: UCL_TYPE
pattern $bUCL_TIME :: UCL_TYPE
$mUCL_TIME :: forall r. UCL_TYPE -> (Void# -> r) -> (Void# -> r) -> r
UCL_TIME = 6
pattern UCL_USERDATA :: UCL_TYPE
pattern $bUCL_USERDATA :: UCL_TYPE
$mUCL_USERDATA :: forall r. UCL_TYPE -> (Void# -> r) -> (Void# -> r) -> r
UCL_USERDATA = 7
pattern UCL_NULL :: UCL_TYPE
pattern $bUCL_NULL :: UCL_TYPE
$mUCL_NULL :: forall r. UCL_TYPE -> (Void# -> r) -> (Void# -> r) -> r
UCL_NULL = 8
foreign import ccall "ucl_parser_new" ucl_parser_new :: CInt -> IO ParserHandle
foreign import ccall "ucl_parser_add_string" ucl_parser_add_string :: ParserHandle -> CString -> CUInt -> IO Bool
foreign import ccall "ucl_parser_add_file" ucl_parser_add_file :: ParserHandle -> CString -> IO Bool
foreign import ccall "ucl_parser_get_object" ucl_parser_get_object :: ParserHandle -> IO UCLObjectHandle
foreign import ccall "ucl_parser_get_error" ucl_parser_get_error :: ParserHandle -> IO CString
foreign import ccall "ucl_object_iterate_new" ucl_object_iterate_new :: UCLObjectHandle -> IO UCLIterHandle
foreign import ccall "ucl_object_iterate_safe" ucl_object_iterate_safe :: UCLIterHandle -> Bool -> IO UCLObjectHandle
foreign import ccall "ucl_object_type" ucl_object_type :: UCLObjectHandle -> UCL_TYPE
foreign import ccall "ucl_object_key" ucl_object_key :: UCLObjectHandle -> CString
foreign import ccall "ucl_object_toint" ucl_object_toint :: UCLObjectHandle -> CInt
foreign import ccall "ucl_object_todouble" ucl_object_todouble :: UCLObjectHandle -> CDouble
foreign import ccall "ucl_object_tostring" ucl_object_tostring :: UCLObjectHandle -> CString
foreign import ccall "ucl_object_toboolean" ucl_object_toboolean :: UCLObjectHandle -> Bool
foreign import ccall "strlen" c_strlen :: CString -> IO CSize
peekCStringText :: CString -> IO Text
peekCStringText :: CString -> IO Text
peekCStringText CString
cstr = do
CSize
len <- CString -> IO CSize
c_strlen CString
cstr
CStringLen -> IO Text
TF.peekCStringLen (CString
cstr, CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
len)
parseByteString :: ByteString -> IO (Either String UCL)
parseByteString :: ByteString -> IO (Either String UCL)
parseByteString ByteString
bs = ByteString
-> (CStringLen -> IO (Either String UCL)) -> IO (Either String UCL)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
useAsCStringLen ByteString
bs CStringLen -> IO (Either String UCL)
parseCStringLen
parseString :: String -> IO (Either String UCL)
parseString :: String -> IO (Either String UCL)
parseString String
s = do
CString
cs <- String -> IO CString
newCString String
s
CStringLen -> IO (Either String UCL)
parseCStringLen (CString
cs, String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s)
parseCStringLen :: CStringLen -> IO (Either String UCL)
parseCStringLen :: CStringLen -> IO (Either String UCL)
parseCStringLen (CString
cs, Int
len) = do
ParserHandle
p <- CInt -> IO ParserHandle
ucl_parser_new CInt
0x0
Bool
didParse <- ParserHandle -> CString -> UCL_TYPE -> IO Bool
ucl_parser_add_string ParserHandle
p CString
cs (UCL_TYPE -> IO Bool) -> UCL_TYPE -> IO Bool
forall a b. (a -> b) -> a -> b
$ Int -> UCL_TYPE
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
if Bool
didParse
then UCL -> Either String UCL
forall a b. b -> Either a b
Right (UCL -> Either String UCL)
-> (UCLObjectHandle -> UCL) -> UCLObjectHandle -> Either String UCL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UCLObjectHandle -> UCL
handleToUCL (UCLObjectHandle -> Either String UCL)
-> IO UCLObjectHandle -> IO (Either String UCL)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserHandle -> IO UCLObjectHandle
ucl_parser_get_object ParserHandle
p
else String -> Either String UCL
forall a b. a -> Either a b
Left (String -> Either String UCL)
-> IO String -> IO (Either String UCL)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParserHandle -> IO CString
ucl_parser_get_error ParserHandle
p IO CString -> (CString -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString)
parseFile :: FilePath -> IO (Either String UCL)
parseFile :: String -> IO (Either String UCL)
parseFile String
s = do
CString
cs <- String -> IO CString
newCString String
s
ParserHandle
p <- CInt -> IO ParserHandle
ucl_parser_new CInt
0x0
Bool
didParse <- ParserHandle -> CString -> IO Bool
ucl_parser_add_file ParserHandle
p CString
cs
if Bool
didParse
then UCL -> Either String UCL
forall a b. b -> Either a b
Right (UCL -> Either String UCL)
-> (UCLObjectHandle -> UCL) -> UCLObjectHandle -> Either String UCL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UCLObjectHandle -> UCL
handleToUCL (UCLObjectHandle -> Either String UCL)
-> IO UCLObjectHandle -> IO (Either String UCL)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserHandle -> IO UCLObjectHandle
ucl_parser_get_object ParserHandle
p
else String -> Either String UCL
forall a b. a -> Either a b
Left (String -> Either String UCL)
-> IO String -> IO (Either String UCL)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParserHandle -> IO CString
ucl_parser_get_error ParserHandle
p IO CString -> (CString -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString)
data UCL = UCLMap (Map UCL UCL)
| UCLArray [UCL]
| UCLInt Int
| UCLDouble Double
| UCLText Text
| UCLBool Bool
| UCLTime DiffTime
deriving (Int -> UCL -> ShowS
[UCL] -> ShowS
UCL -> String
(Int -> UCL -> ShowS)
-> (UCL -> String) -> ([UCL] -> ShowS) -> Show UCL
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UCL] -> ShowS
$cshowList :: [UCL] -> ShowS
show :: UCL -> String
$cshow :: UCL -> String
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
$cp1Ord :: Eq UCL
Ord)
handleToUCL :: UCLObjectHandle -> UCL
handleToUCL :: UCLObjectHandle -> UCL
handleToUCL UCLObjectHandle
o = UCL_TYPE -> UCLObjectHandle -> UCL
typedHandleToUCL (UCLObjectHandle -> UCL_TYPE
ucl_object_type UCLObjectHandle
o) UCLObjectHandle
o
typedHandleToUCL :: UCL_TYPE -> UCLObjectHandle -> UCL
typedHandleToUCL :: UCL_TYPE -> UCLObjectHandle -> UCL
typedHandleToUCL UCL_TYPE
UCL_OBJECT UCLObjectHandle
obj = Map UCL UCL -> UCL
UCLMap (Map UCL UCL -> UCL) -> Map UCL UCL -> UCL
forall a b. (a -> b) -> a -> b
$ UCLObjectHandle -> Map UCL UCL
uclObjectToMap UCLObjectHandle
obj
typedHandleToUCL UCL_TYPE
UCL_ARRAY UCLObjectHandle
obj = [UCL] -> UCL
UCLArray ([UCL] -> UCL) -> [UCL] -> UCL
forall a b. (a -> b) -> a -> b
$ UCLObjectHandle -> [UCL]
uclArrayToList UCLObjectHandle
obj
typedHandleToUCL UCL_TYPE
UCL_INT UCLObjectHandle
obj = Int -> UCL
UCLInt (Int -> UCL) -> Int -> UCL
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> CInt -> Int
forall a b. (a -> b) -> a -> b
$ UCLObjectHandle -> CInt
ucl_object_toint UCLObjectHandle
obj
typedHandleToUCL UCL_TYPE
UCL_FLOAT UCLObjectHandle
obj = Double -> UCL
UCLDouble (Double -> UCL) -> Double -> UCL
forall a b. (a -> b) -> a -> b
$ CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> Double) -> CDouble -> Double
forall a b. (a -> b) -> a -> b
$ UCLObjectHandle -> CDouble
ucl_object_todouble UCLObjectHandle
obj
typedHandleToUCL UCL_TYPE
UCL_STRING UCLObjectHandle
obj = Text -> UCL
UCLText (Text -> UCL) -> Text -> UCL
forall a b. (a -> b) -> a -> b
$ IO Text -> Text
forall a. IO a -> a
unsafePerformIO (IO Text -> Text) -> IO Text -> Text
forall a b. (a -> b) -> a -> b
$ CString -> IO Text
peekCStringText (CString -> IO Text) -> CString -> IO Text
forall a b. (a -> b) -> a -> b
$ UCLObjectHandle -> CString
ucl_object_tostring UCLObjectHandle
obj
typedHandleToUCL UCL_TYPE
UCL_BOOLEAN UCLObjectHandle
obj = Bool -> UCL
UCLBool (Bool -> UCL) -> Bool -> UCL
forall a b. (a -> b) -> a -> b
$ UCLObjectHandle -> Bool
ucl_object_toboolean UCLObjectHandle
obj
typedHandleToUCL UCL_TYPE
UCL_TIME UCLObjectHandle
obj = DiffTime -> UCL
UCLTime (DiffTime -> UCL) -> DiffTime -> UCL
forall a b. (a -> b) -> a -> b
$ CDouble -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> DiffTime) -> CDouble -> DiffTime
forall a b. (a -> b) -> a -> b
$ UCLObjectHandle -> CDouble
ucl_object_todouble UCLObjectHandle
obj
typedHandleToUCL UCL_TYPE
UCL_USERDATA UCLObjectHandle
_ = String -> UCL
forall a. HasCallStack => String -> a
error String
"Userdata object"
typedHandleToUCL UCL_TYPE
UCL_NULL UCLObjectHandle
_ = String -> UCL
forall a. HasCallStack => String -> a
error String
"Null object"
typedHandleToUCL UCL_TYPE
_ UCLObjectHandle
_ = String -> UCL
forall a. HasCallStack => String -> a
error String
"Unknown Type"
uclObjectToMap :: UCLObjectHandle -> Map UCL UCL
uclObjectToMap :: UCLObjectHandle -> Map UCL UCL
uclObjectToMap UCLObjectHandle
o = IO (Map UCL UCL) -> Map UCL UCL
forall a. IO a -> a
unsafePerformIO (IO (Map UCL UCL) -> Map UCL UCL)
-> IO (Map UCL UCL) -> Map UCL UCL
forall a b. (a -> b) -> a -> b
$ do
UCLIterHandle
iter <- UCLObjectHandle -> IO UCLIterHandle
ucl_object_iterate_new UCLObjectHandle
o
UCLIterHandle -> Map UCL UCL -> IO (Map UCL UCL)
go UCLIterHandle
iter Map UCL UCL
forall k a. Map k a
Map.empty
where
go :: UCLIterHandle -> Map UCL UCL -> IO (Map UCL UCL)
go UCLIterHandle
it Map UCL UCL
m = do
UCLObjectHandle
obj <- UCLIterHandle -> Bool -> IO UCLObjectHandle
ucl_object_iterate_safe UCLIterHandle
it Bool
True
case UCLObjectHandle -> UCL_TYPE
ucl_object_type UCLObjectHandle
obj of
UCL_TYPE
UCL_NULL -> Map UCL UCL -> IO (Map UCL UCL)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map UCL UCL
m
UCL_TYPE
_ -> UCLIterHandle -> Map UCL UCL -> IO (Map UCL UCL)
go UCLIterHandle
it (Map UCL UCL -> IO (Map UCL UCL))
-> Map UCL UCL -> IO (Map UCL UCL)
forall a b. (a -> b) -> a -> b
$ UCL -> UCL -> Map UCL UCL -> Map UCL UCL
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (UCLObjectHandle -> UCL
getUclKey UCLObjectHandle
obj) (UCLObjectHandle -> UCL
handleToUCL UCLObjectHandle
obj) Map UCL UCL
m
getUclKey :: UCLObjectHandle -> UCL
getUclKey UCLObjectHandle
obj = Text -> UCL
UCLText (Text -> UCL) -> Text -> UCL
forall a b. (a -> b) -> a -> b
$ IO Text -> Text
forall a. IO a -> a
unsafePerformIO (IO Text -> Text) -> IO Text -> Text
forall a b. (a -> b) -> a -> b
$ CString -> IO Text
peekCStringText (CString -> IO Text) -> CString -> IO Text
forall a b. (a -> b) -> a -> b
$ UCLObjectHandle -> CString
ucl_object_key UCLObjectHandle
obj
uclArrayToList :: UCLObjectHandle -> [UCL]
uclArrayToList :: UCLObjectHandle -> [UCL]
uclArrayToList UCLObjectHandle
o = IO [UCL] -> [UCL]
forall a. IO a -> a
unsafePerformIO (IO [UCL] -> [UCL]) -> IO [UCL] -> [UCL]
forall a b. (a -> b) -> a -> b
$ do
UCLIterHandle
iter <- UCLObjectHandle -> IO UCLIterHandle
ucl_object_iterate_new UCLObjectHandle
o
UCLIterHandle -> IO [UCL]
go UCLIterHandle
iter
where
go :: UCLIterHandle -> IO [UCL]
go UCLIterHandle
it = do
UCLObjectHandle
obj <- UCLIterHandle -> Bool -> IO UCLObjectHandle
ucl_object_iterate_safe UCLIterHandle
it Bool
True
case UCLObjectHandle -> UCL_TYPE
ucl_object_type UCLObjectHandle
obj of
UCL_TYPE
UCL_NULL -> [UCL] -> IO [UCL]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
UCL_TYPE
_ -> (UCLObjectHandle -> UCL
handleToUCL UCLObjectHandle
obj UCL -> [UCL] -> [UCL]
forall a. a -> [a] -> [a]
:) ([UCL] -> [UCL]) -> IO [UCL] -> IO [UCL]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UCLIterHandle -> IO [UCL]
go UCLIterHandle
it