{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE PatternSynonyms #-}
module Data.UCL
( UCL(..)
, parseString
, parseByteString
, parseFile
) where
import Foreign.C
( CUInt(..), CInt(..), CSize(..), CDouble(..), CString, CStringLen
, newCString, peekCString )
import Foreign.Ptr (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 cstr :: 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 bs :: 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 s :: 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 (cs :: CString
cs, len :: Int
len) = do
ParserHandle
p <- CInt -> IO ParserHandle
ucl_parser_new 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 s :: String
s = do
CString
cs <- String -> IO CString
newCString String
s
ParserHandle
p <- CInt -> IO ParserHandle
ucl_parser_new 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 Text 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 o :: 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_OBJECT obj :: UCLObjectHandle
obj = Map Text UCL -> UCL
UCLMap (Map Text UCL -> UCL) -> Map Text UCL -> UCL
forall a b. (a -> b) -> a -> b
$ UCLObjectHandle -> Map Text UCL
uclObjectToMap UCLObjectHandle
obj
typedHandleToUCL UCL_ARRAY obj :: UCLObjectHandle
obj = [UCL] -> UCL
UCLArray ([UCL] -> UCL) -> [UCL] -> UCL
forall a b. (a -> b) -> a -> b
$ UCLObjectHandle -> [UCL]
uclArrayToList UCLObjectHandle
obj
typedHandleToUCL UCL_INT obj :: 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_FLOAT obj :: 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_STRING obj :: 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_BOOLEAN obj :: 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_TIME obj :: 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_USERDATA _ = String -> UCL
forall a. HasCallStack => String -> a
error "Userdata object"
typedHandleToUCL UCL_NULL _ = String -> UCL
forall a. HasCallStack => String -> a
error "Null object"
typedHandleToUCL _ _ = String -> UCL
forall a. HasCallStack => String -> a
error "Unknown Type"
uclObjectToMap :: UCLObjectHandle -> Map Text UCL
uclObjectToMap :: UCLObjectHandle -> Map Text UCL
uclObjectToMap o :: UCLObjectHandle
o = IO (Map Text UCL) -> Map Text UCL
forall a. IO a -> a
unsafePerformIO (IO (Map Text UCL) -> Map Text UCL)
-> IO (Map Text UCL) -> Map Text UCL
forall a b. (a -> b) -> a -> b
$ do
UCLIterHandle
iter <- UCLObjectHandle -> IO UCLIterHandle
ucl_object_iterate_new UCLObjectHandle
o
UCLIterHandle -> Map Text UCL -> IO (Map Text UCL)
go UCLIterHandle
iter Map Text UCL
forall k a. Map k a
Map.empty
where
go :: UCLIterHandle -> Map Text UCL -> IO (Map Text UCL)
go it :: UCLIterHandle
it m :: Map Text 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_NULL -> Map Text UCL -> IO (Map Text UCL)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Text UCL
m
_ -> UCLIterHandle -> Map Text UCL -> IO (Map Text UCL)
go UCLIterHandle
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 (UCLObjectHandle -> Text
getUclKey UCLObjectHandle
obj) (UCLObjectHandle -> UCL
handleToUCL UCLObjectHandle
obj) Map Text UCL
m
getUclKey :: UCLObjectHandle -> Text
getUclKey obj :: UCLObjectHandle
obj = 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 o :: 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 it :: 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_NULL -> [UCL] -> IO [UCL]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
_ -> (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