{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
module Graphics.Svg.Core
(
Attribute
, Element
, ToElement(..)
, Term(..)
, makeAttribute
, makeElement
, makeElementNoEnd
, makeElementDoctype
, with
, renderBS
, renderToFile
, renderText
) where
import Blaze.ByteString.Builder (Builder)
import qualified Blaze.ByteString.Builder as BB
import qualified Blaze.ByteString.Builder.Html.Utf8 as BB
import qualified Data.ByteString.Lazy as LB
import Data.ByteString.Lazy (ByteString)
import Data.Hashable (Hashable(..))
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as M
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (Monoid(..))
#endif
import Data.Semigroup (Semigroup(..))
import Data.String
import Data.Text (Text)
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Encoding as LT
data Attribute = Attribute !Text !Text
deriving (Int -> Attribute -> ShowS
[Attribute] -> ShowS
Attribute -> String
(Int -> Attribute -> ShowS)
-> (Attribute -> String)
-> ([Attribute] -> ShowS)
-> Show Attribute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Attribute] -> ShowS
$cshowList :: [Attribute] -> ShowS
show :: Attribute -> String
$cshow :: Attribute -> String
showsPrec :: Int -> Attribute -> ShowS
$cshowsPrec :: Int -> Attribute -> ShowS
Show,Attribute -> Attribute -> Bool
(Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool) -> Eq Attribute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attribute -> Attribute -> Bool
$c/= :: Attribute -> Attribute -> Bool
== :: Attribute -> Attribute -> Bool
$c== :: Attribute -> Attribute -> Bool
Eq)
instance Hashable Attribute where
hashWithSalt :: Int -> Attribute -> Int
hashWithSalt Int
salt (Attribute Text
a Text
b) = Int
salt Int -> Text -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Text
a Int -> Text -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Text
b
newtype Element = Element (HashMap Text Text -> Builder)
instance Show Element where
show :: Element -> String
show Element
e = Text -> String
LT.unpack (Text -> String) -> (Element -> Text) -> Element -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
renderText (Element -> String) -> Element -> String
forall a b. (a -> b) -> a -> b
$ Element
e
instance Semigroup Element where
Element HashMap Text Text -> Builder
e1 <> :: Element -> Element -> Element
<> Element HashMap Text Text -> Builder
e2 = (HashMap Text Text -> Builder) -> Element
Element (HashMap Text Text -> Builder
e1 (HashMap Text Text -> Builder)
-> (HashMap Text Text -> Builder) -> HashMap Text Text -> Builder
forall a. Semigroup a => a -> a -> a
<> HashMap Text Text -> Builder
e2)
instance Monoid Element where
mempty :: Element
mempty = (HashMap Text Text -> Builder) -> Element
Element HashMap Text Text -> Builder
forall a. Monoid a => a
mempty
#if !(MIN_VERSION_base(4,11,0))
mappend = (<>)
#endif
instance IsString Element where
fromString :: String -> Element
fromString = String -> Element
forall a. ToElement a => a -> Element
toElement
class ToElement a where
toElement :: a -> Element
instance ToElement String where
toElement :: String -> Element
toElement = (HashMap Text Text -> Builder) -> Element
Element ((HashMap Text Text -> Builder) -> Element)
-> (String -> HashMap Text Text -> Builder) -> String -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> HashMap Text Text -> Builder
forall a b. a -> b -> a
const (Builder -> HashMap Text Text -> Builder)
-> (String -> Builder) -> String -> HashMap Text Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
BB.fromHtmlEscapedString
instance ToElement Text where
toElement :: Text -> Element
toElement = (HashMap Text Text -> Builder) -> Element
Element ((HashMap Text Text -> Builder) -> Element)
-> (Text -> HashMap Text Text -> Builder) -> Text -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> HashMap Text Text -> Builder
forall a b. a -> b -> a
const (Builder -> HashMap Text Text -> Builder)
-> (Text -> Builder) -> Text -> HashMap Text Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
BB.fromHtmlEscapedText
instance ToElement LT.Text where
toElement :: Text -> Element
toElement = (HashMap Text Text -> Builder) -> Element
Element ((HashMap Text Text -> Builder) -> Element)
-> (Text -> HashMap Text Text -> Builder) -> Text -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> HashMap Text Text -> Builder
forall a b. a -> b -> a
const (Builder -> HashMap Text Text -> Builder)
-> (Text -> Builder) -> Text -> HashMap Text Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
BB.fromHtmlEscapedLazyText
class Term result where
term :: Text -> [Attribute] -> result
instance (e ~ Element) => Term (e -> Element) where
term :: Text -> [Attribute] -> e -> Element
term Text
name [Attribute]
attrs e
e = Element -> [Attribute] -> Element
with (Text -> Element -> Element
makeElement Text
name e
Element
e) [Attribute]
attrs
instance Term Element where
term :: Text -> [Attribute] -> Element
term Text
name [Attribute]
attrs = Element -> [Attribute] -> Element
with (Text -> Element
makeElementNoEnd Text
name) [Attribute]
attrs
makeAttribute :: Text
-> Text
-> Attribute
makeAttribute :: Text -> Text -> Attribute
makeAttribute = Text -> Text -> Attribute
Attribute
unionAttrs :: HashMap Text Text -> HashMap Text Text -> HashMap Text Text
unionAttrs :: HashMap Text Text -> HashMap Text Text -> HashMap Text Text
unionAttrs = (Text -> Text -> Text)
-> HashMap Text Text -> HashMap Text Text -> HashMap Text Text
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
M.unionWith Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>)
with :: Element -> [Attribute] -> Element
with :: Element -> [Attribute] -> Element
with (Element HashMap Text Text -> Builder
e) [Attribute]
attrs = (HashMap Text Text -> Builder) -> Element
Element ((HashMap Text Text -> Builder) -> Element)
-> (HashMap Text Text -> Builder) -> Element
forall a b. (a -> b) -> a -> b
$ \HashMap Text Text
a ->
HashMap Text Text -> Builder
e (HashMap Text Text -> HashMap Text Text -> HashMap Text Text
unionAttrs ((Text -> Text -> Text) -> [(Text, Text)] -> HashMap Text Text
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
M.fromListWith Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) ((Attribute -> (Text, Text)) -> [Attribute] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map Attribute -> (Text, Text)
toPair [Attribute]
attrs)) HashMap Text Text
a)
where
toPair :: Attribute -> (Text, Text)
toPair (Attribute Text
x Text
y) = (Text
x,Text
y)
makeElement :: Text -> Element -> Element
makeElement :: Text -> Element -> Element
makeElement Text
name (Element HashMap Text Text -> Builder
c) = (HashMap Text Text -> Builder) -> Element
Element ((HashMap Text Text -> Builder) -> Element)
-> (HashMap Text Text -> Builder) -> Element
forall a b. (a -> b) -> a -> b
$ \HashMap Text Text
a -> (HashMap Text Text -> Builder) -> HashMap Text Text -> Builder
go HashMap Text Text -> Builder
c HashMap Text Text
a
where
go :: (HashMap Text Text -> Builder) -> HashMap Text Text -> Builder
go HashMap Text Text -> Builder
children HashMap Text Text
attrs =
String -> Builder
s2b String
"<" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
BB.fromText Text
name
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text -> Text -> Builder) -> HashMap Text Text -> Builder
forall m k v. Monoid m => (k -> v -> m) -> HashMap k v -> m
foldlMapWithKey Text -> Text -> Builder
buildAttr HashMap Text Text
attrs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
s2b String
">"
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> HashMap Text Text -> Builder
children HashMap Text Text
forall a. Monoid a => a
mempty
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
s2b String
"</" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
BB.fromText Text
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
s2b String
">"
makeElementDoctype :: Text -> Element
makeElementDoctype :: Text -> Element
makeElementDoctype Text
name = (HashMap Text Text -> Builder) -> Element
Element ((HashMap Text Text -> Builder) -> Element)
-> (HashMap Text Text -> Builder) -> Element
forall a b. (a -> b) -> a -> b
$ \HashMap Text Text
a -> HashMap Text Text -> Builder
go HashMap Text Text
a
where
go :: HashMap Text Text -> Builder
go HashMap Text Text
attrs =
String -> Builder
s2b String
"<" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
BB.fromText Text
name
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text -> Text -> Builder) -> HashMap Text Text -> Builder
forall m k v. Monoid m => (k -> v -> m) -> HashMap k v -> m
foldlMapWithKey Text -> Text -> Builder
buildAttr HashMap Text Text
attrs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
s2b String
">"
makeElementNoEnd :: Text -> Element
makeElementNoEnd :: Text -> Element
makeElementNoEnd Text
name = (HashMap Text Text -> Builder) -> Element
Element ((HashMap Text Text -> Builder) -> Element)
-> (HashMap Text Text -> Builder) -> Element
forall a b. (a -> b) -> a -> b
$ \HashMap Text Text
a -> HashMap Text Text -> Builder
go HashMap Text Text
a
where
go :: HashMap Text Text -> Builder
go HashMap Text Text
attrs =
String -> Builder
s2b String
"<" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
BB.fromText Text
name
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text -> Text -> Builder) -> HashMap Text Text -> Builder
forall m k v. Monoid m => (k -> v -> m) -> HashMap k v -> m
foldlMapWithKey Text -> Text -> Builder
buildAttr HashMap Text Text
attrs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
s2b String
"/>"
foldlMapWithKey :: Monoid m => (k -> v -> m) -> HashMap k v -> m
foldlMapWithKey :: forall m k v. Monoid m => (k -> v -> m) -> HashMap k v -> m
foldlMapWithKey k -> v -> m
f = (m -> k -> v -> m) -> m -> HashMap k v -> m
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
M.foldlWithKey' (\m
m k
k v
v -> m
m m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` k -> v -> m
f k
k v
v) m
forall a. Monoid a => a
mempty
s2b :: String -> Builder
s2b :: String -> Builder
s2b = String -> Builder
BB.fromString
buildAttr :: Text -> Text -> Builder
buildAttr :: Text -> Text -> Builder
buildAttr Text
key Text
val =
String -> Builder
s2b String
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
Text -> Builder
BB.fromText Text
key Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
if Text
val Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
forall a. Monoid a => a
mempty
then Builder
forall a. Monoid a => a
mempty
else String -> Builder
s2b String
"=\"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
BB.fromHtmlEscapedText Text
val Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
s2b String
"\""
renderBS :: Element -> ByteString
renderBS :: Element -> ByteString
renderBS (Element HashMap Text Text -> Builder
e) = Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ HashMap Text Text -> Builder
e HashMap Text Text
forall a. Monoid a => a
mempty
renderToFile :: FilePath -> Element -> IO ()
renderToFile :: String -> Element -> IO ()
renderToFile String
fp = String -> ByteString -> IO ()
LB.writeFile String
fp (ByteString -> IO ())
-> (Element -> ByteString) -> Element -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> ByteString
renderBS
renderText :: Element -> LT.Text
renderText :: Element -> Text
renderText = ByteString -> Text
LT.decodeUtf8 (ByteString -> Text) -> (Element -> ByteString) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> ByteString
renderBS