{-# LANGUAGE     OverloadedStrings       #-}


module Core.Render 
  ( renderSvgFiles
  , renderSvgReact
  , svgToReact
  ) where

import           GHC.IO.Encoding
import qualified Data.Text as T
import           Text.Blaze.Svg11 ((!))
import           Text.Blaze.Svg11 as S
import           Text.Blaze.Svg11.Attributes as A
import           Text.Blaze.Svg.Renderer.Pretty

import Core.Utils



{- |
`renderSvgFiles` renders svg code to .svg files.

Takes a folder path in your computer and a list
of pairs `(String, Svg)` and renders the svg code of every
second element into a svg file named as the first element.
You should not write the .svg file extension in the first element.
This function also adds the correct DOCTYPE and xml:ns

Example use:
>renderSvgFiles
>  "./assets/img/"
>  [ (,) "sun"      (sun 14)
>  , (,) "moon"      moon
>  , (,) "crescent"  crescent
>  ]
This will create 3 files inside the ./assets/svg/ folder,
namely sun.svg, moon.svg and crescent.svg
-}
renderSvgFiles :: FilePath -> [ (FilePath , Svg) ] -> IO ()
renderSvgFiles :: [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
folder [([Char], Svg)]
svgs = 
  do
    TextEncoding -> IO ()
setLocaleEncoding TextEncoding
utf8
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Char], Svg) -> IO ()
f [([Char], Svg)]
svgs
  where
    f :: ([Char], Svg) -> IO ()
f ([Char]
name , Svg
svgCode) =
      [Char] -> [Char] -> IO ()
writeFile 
        ([Char]
folder forall a. [a] -> [a] -> [a]
++ [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
".svg") 
        (Svg -> [Char]
renderSvg forall a b. (a -> b) -> a -> b
$ Svg
S.docType forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Svg -> Svg
addXmlns Svg
svgCode)



{- |
`renderSvgReact` renders svg code to .jsx files

Works as the previous function but creates .jsx files
instead of .svg files. This function does not prepend
the svg DOCTYPE but it does prepend the React import and
an export line.

Example use:
>myCancelIcon :: Svg
>myCancelIcon =
>  svg
>    ! viewbox "-1 -1 2 2"
>    $ cancel
>      ! fill "deeppink"
>
>renderSvgReact
>  "./assets/svg/"
>  [ (,) "cancel" myCancelIcon
>  ]
This call will create a cancel.jsx file inside the ./assets/svg/ folder
with the following code inside:
>import React from 'react';
>
>export const cancel =
><svg viewBox="-1 -1 2 2" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">
>    <g fill="deeppink">
>        <path d="M 0.1,-0.1 L 0.1,-0.8 A 0.1,0.1 0.0 1,0 -0.1,-0.8 L -0.1,-0.1 L -0.8,-0.1 A 0.1,0.1 0.0 1,0 -0.8,0.1 L -0.1,0.1 L -0.1,0.8 A 0.1,0.1 0.0 1,0 0.1,0.8 L 0.1,0.1 L 0.8,0.1 A 0.1,0.1 0.0 1,0 0.8,-0.1 Z" transform="rotate(45,0,0)" />
>    </g>
></svg>
-}
renderSvgReact :: FilePath -> [ (FilePath , Svg) ] -> IO ()
renderSvgReact :: [Char] -> [([Char], Svg)] -> IO ()
renderSvgReact [Char]
folder [([Char], Svg)]
svgs =
  do
    TextEncoding -> IO ()
setLocaleEncoding TextEncoding
utf8
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Char], Svg) -> IO ()
f [([Char], Svg)]
svgs
  where
    f :: ([Char], Svg) -> IO ()
f ([Char]
name , Svg
svgCode) =
      [Char] -> [Char] -> IO ()
writeFile 
        ([Char]
folder forall a. [a] -> [a] -> [a]
++ [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
".jsx") 
        ([Char] -> Svg -> [Char]
svgToReact [Char]
name forall a b. (a -> b) -> a -> b
$ Svg -> Svg
addXmlns Svg
svgCode)



{- |
`svgToReact` is internally used in the previous function
so you don't have to call it manually.

This function writes the "import React from 'react';" line
and the export line; and more importantly, changes all hyphen-joined
attributes to camelCase, because React will complain otherwise.
For example, "stroke-width" changes to "strokeWidth" and "text-anchor"
changes to "textAnchor".

IMPORTANT: This function does not currently aim to be exhaustive, 
which means that you may encounter some hyphen-joined attribute which
is not converted to camelCase and raises a React error. You can ask
for an update in this function if you have such problem.
-}
svgToReact :: String -> Svg -> String
svgToReact :: [Char] -> Svg -> [Char]
svgToReact [Char]
name Svg
svgCode =
    [Char]
"import React from 'react';"
    forall a. [a] -> [a] -> [a]
++ [Char]
"\n\n" forall a. [a] -> [a] -> [a]
++
    [Char]
"export const " forall a. [a] -> [a] -> [a]
++ [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
" = \n" forall a. [a] -> [a] -> [a]
++ Svg -> [Char]
render Svg
svgCode
  where
    render :: Svg -> [Char]
render = Text -> [Char]
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
adaptToReact forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Svg -> [Char]
renderSvg 
    adaptToReact :: Text -> Text
adaptToReact =
        (HasCallStack => Text -> Text -> Text -> Text
T.replace Text
"xmlns:xlink"       Text
"xmlnsXlink")
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HasCallStack => Text -> Text -> Text -> Text
T.replace Text
"stroke-width"      Text
"strokeWidth")
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HasCallStack => Text -> Text -> Text -> Text
T.replace Text
"stroke-dasharray"  Text
"strokeDasharray")
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HasCallStack => Text -> Text -> Text -> Text
T.replace Text
"stroke-dashoffset" Text
"strokeDashoffset")
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HasCallStack => Text -> Text -> Text -> Text
T.replace Text
"stroke-linejoin"   Text
"strokeLinejoin")
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HasCallStack => Text -> Text -> Text -> Text
T.replace Text
"stroke-linecap"    Text
"strokeLinecap")
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HasCallStack => Text -> Text -> Text -> Text
T.replace Text
"font-family"       Text
"fontFamily")
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HasCallStack => Text -> Text -> Text -> Text
T.replace Text
"font-size"         Text
"fontSize")
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HasCallStack => Text -> Text -> Text -> Text
T.replace Text
"text-anchor"       Text
"textAnchor")
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HasCallStack => Text -> Text -> Text -> Text
T.replace Text
"letter-spacing"    Text
"letterSpacing")
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HasCallStack => Text -> Text -> Text -> Text
T.replace Text
"dominant-baseline" Text
"dominantBaseline")
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HasCallStack => Text -> Text -> Text -> Text
T.replace Text
"stroke-miterlimit" Text
"strokeMiterlimit")