{-# LANGUAGE FlexibleInstances #-}
module Data.EDN.Types (
Value(..), Tagged(..), TaggedValue,
EDNList, EDNVec, EDNSet, EDNMap, Pair,
setTag, getTag, stripTag,
tag, notag,
nil,
bool, true, false,
char, string,
symbol, symbolNS, keyword,
integer, floating,
makeList, makeVec, makeSet, makeMap
) where
import Data.String (IsString(..))
import Control.DeepSeq (NFData(..))
import Data.Text (Text)
import qualified Data.Text as T
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import qualified Data.Vector as V
import qualified Data.Map as M
import qualified Data.Set as S
data Tagged a = NoTag !a
| Tagged !a !ByteString !ByteString
deriving (Eq, Ord, Show)
instance Functor Tagged where
fmap f (NoTag v) = NoTag (f v)
fmap f (Tagged v ns t) = Tagged (f v) ns t
instance NFData a => NFData (Tagged a) where
rnf (NoTag v) = rnf v
rnf (Tagged v ns t) = rnf v `seq` rnf ns `seq` rnf t
type TaggedValue = Tagged Value
type EDNList = [TaggedValue]
type EDNVec = V.Vector TaggedValue
type EDNMap = M.Map Value TaggedValue
type EDNSet = S.Set TaggedValue
data Value = Nil
| Boolean !Bool
| String !Text
| Character !Char
| Symbol !ByteString !ByteString
| Keyword !ByteString
| Integer !Integer
| Floating !Double
| List EDNList
| Vec !EDNVec
| Map !EDNMap
| Set !EDNSet
deriving (Eq, Ord, Show)
instance IsString Value where
fromString (':':s) = Keyword . BS.pack $ s
fromString s = String . T.pack $ s
{-# INLINE fromString #-}
instance IsString (Tagged Value) where
fromString = string . T.pack
{-# INLINE fromString #-}
instance NFData Value where
rnf (Map m) = rnf m
rnf (Set s) = rnf s
rnf (Vec v) = V.foldl' (\x y -> rnf y `seq` x) () v
rnf (List l) = rnf l
rnf (Floating f) = rnf f
rnf (Integer i) = rnf i
rnf (Symbol ns s) = rnf ns `seq` rnf s
rnf (Keyword kw) = rnf kw
rnf (String t) = rnf t
rnf (Character c) = rnf c
rnf (Boolean b) = rnf b
rnf Nil = ()
nil :: TaggedValue
nil = NoTag Nil
{-# INLINE nil #-}
bool :: Bool -> TaggedValue
bool = NoTag . Boolean
{-# INLINE bool #-}
true :: TaggedValue
true = bool True
{-# INLINE true #-}
false :: TaggedValue
false = bool False
{-# INLINE false #-}
char :: Char -> TaggedValue
char = NoTag . Character
{-# INLINE char #-}
string :: Text -> TaggedValue
string = NoTag . String
{-# INLINE string #-}
symbolNS :: ByteString -> ByteString -> TaggedValue
symbolNS ns value = NoTag $ Symbol ns value
{-# INLINE symbolNS #-}
symbol :: ByteString -> TaggedValue
symbol = symbolNS BS.empty
{-# INLINE symbol #-}
keyword :: ByteString -> TaggedValue
keyword = NoTag . Keyword
{-# INLINE keyword #-}
integer :: Integer -> TaggedValue
integer = NoTag . Integer
{-# INLINE integer #-}
floating :: Double -> TaggedValue
floating = NoTag . Floating
{-# INLINE floating #-}
tag :: ByteString -> ByteString -> a -> Tagged a
tag ns t value = Tagged value ns t
{-# INLINE tag #-}
notag :: a -> Tagged a
notag = NoTag
{-# INLINE notag #-}
setTag :: ByteString -> ByteString -> Tagged a -> Tagged a
setTag ns t (NoTag v) = tag ns t v
setTag ns t (Tagged v _ _) = tag ns t v
{-# INLINE setTag #-}
getTag :: TaggedValue -> (ByteString, ByteString)
getTag (NoTag _) = (BS.empty, BS.empty)
getTag (Tagged _ ns t) = (ns, t)
stripTag :: Tagged a -> a
stripTag (NoTag v) = v
stripTag (Tagged v _ _) = v
{-# INLINE stripTag #-}
makeList :: [TaggedValue] -> Value
makeList = List
{-# INLINE makeList #-}
makeVec :: [TaggedValue] -> Value
makeVec = Vec . V.fromList
{-# INLINE makeVec #-}
makeSet :: [TaggedValue] -> Value
makeSet = Set . S.fromList
{-# INLINE makeSet #-}
type Pair = (Value, TaggedValue)
makeMap :: [Pair] -> Value
makeMap = Map . M.fromList
{-# INLINE makeMap #-}