    {-# LANGUAGE CPP               #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE TypeFamilies      #-}

    -------------------------------------------------------------------------------
    -- |
    -- Module      :  SVG.Core
    -- Copyright   :  (c) 2015 Jeffrey Rosenbluth
    -- License     :  BSD-style (see LICENSE)
    -- Maintainer  :  jeffrey.rosenbluth@gmail.com
    --
    -- svg-builder Core types and functions.
    --
    -------------------------------------------------------------------------------

    module Graphics.Svg.Core
    ( -- * Types
      Attribute
    , Element
    , ToElement(..)
    , Term(..)
      -- * Combinators
    , makeAttribute
    , makeElement
    , makeElementNoEnd
    , makeElementDoctype
    , with
      -- * Rendering
    , 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

    --------------------------------------------------------------------------------
    -- Types

    -- | Attribute name value.
    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 salt :: Int
    salt (Attribute a :: Text
    a b :: 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

    -- | Type of an SVG element.
    newtype Element = Element (HashMap Text Text -> Builder)

    instance Show Element where
      show :: Element -> String
    show e :: 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 e1 :: HashMap Text Text -> Builder
    e1 <> :: Element -> Element -> Element
    <> Element e2 :: 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

    -- | Things that can be converted to SVG elements.
    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

    -- | Used to make specific SVG element builders.
    class Term result where
      -- | Used for constructing elements e.g. @term "circle"@ yields 'circle_'.
      term :: Text -> [Attribute] -> result

    instance (e ~ Element) => Term (e -> Element) where
      term :: Text -> [Attribute] -> e -> Element
    term name :: Text
    name attrs :: [Attribute]
    attrs e :: 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 name :: Text
    name attrs :: [Attribute]
    attrs = Element -> [Attribute] -> Element
    with (Text -> Element
    makeElementNoEnd Text
    name) [Attribute]
    attrs

    --------------------------------------------------------------------------------
    -- Combinators

    -- | Make an attribute.
    makeAttribute :: Text -- ^ Attribute name.
                  -> Text -- ^ Attribute value.
                  -> Attribute
    makeAttribute :: Text -> Text -> Attribute
    makeAttribute = Text -> Text -> Attribute
    Attribute

    -- | Union two sets of attributes and append duplicate keys.
    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
    (<>)

    -- | Add a list of attributes to an element
    with :: Element -> [Attribute] -> Element
    with :: Element -> [Attribute] -> Element
    with (Element e :: HashMap Text Text -> Builder
    e) attrs :: [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
    $ \a :: 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 x :: Text
    x y :: Text
    y) = (Text
    x,Text
    y)

    -- | Make an SVG element builder
    makeElement :: Text -> Element -> Element
    makeElement :: Text -> Element -> Element
    makeElement name :: Text
    name (Element c :: 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
    $ \a :: 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 children :: HashMap Text Text -> Builder
    children attrs :: HashMap Text Text
    attrs =
             String -> Builder
    s2b "<" 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 ">"
          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 "</" 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 ">"

    -- | Make an SVG doctype element builder.
    makeElementDoctype :: Text -> Element
    makeElementDoctype :: Text -> Element
    makeElementDoctype name :: 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
    $ \a :: HashMap Text Text
    a -> HashMap Text Text -> Builder
    go HashMap Text Text
    a
      where
        go :: HashMap Text Text -> Builder
    go attrs :: HashMap Text Text
    attrs =
             String -> Builder
    s2b "<" 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 ">"

    -- | Make an SVG element with no end tag, contains only attributes.
    makeElementNoEnd :: Text -> Element
    makeElementNoEnd :: Text -> Element
    makeElementNoEnd name :: 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
    $ \a :: HashMap Text Text
    a -> HashMap Text Text -> Builder
    go HashMap Text Text
    a
      where
        go :: HashMap Text Text -> Builder
    go attrs :: HashMap Text Text
    attrs =
             String -> Builder
    s2b "<" 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 "/>"

    -- | Folding and monoidally appending attributes.
    foldlMapWithKey :: Monoid m => (k -> v -> m) -> HashMap k v -> m
    foldlMapWithKey :: (k -> v -> m) -> HashMap k v -> m
    foldlMapWithKey f :: 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
    m k :: k
    k v :: 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

    -- | Build and encode an attribute.
    buildAttr :: Text -> Text -> Builder
    buildAttr :: Text -> Text -> Builder
    buildAttr key :: Text
    key val :: Text
    val =
      String -> Builder
    s2b " " 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 "=\"" 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 "\""

    --------------------------------------------------------------------------------
    -- Rendering

    -- | Render a 'Element' to lazy bytestring.
    renderBS :: Element -> ByteString
    renderBS :: Element -> ByteString
    renderBS (Element e :: 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

    -- | Render a 'Element' to a file.
    renderToFile :: FilePath -> Element -> IO ()
    renderToFile :: String -> Element -> IO ()
    renderToFile fp :: 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

    -- | Reder an 'Element' to lazy text.
    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