{-# LANGUAGE     OverloadedStrings       #-}

{- |
The main purpose of this module is 
generating the images found within the haddock documentation
of this package.
-}
module Main where

import           System.Directory
import           Text.Blaze.Svg11 ((!))
import           Text.Blaze.Svg11 as S
import           Text.Blaze.Svg11.Attributes as A

import SvgIcons.Core.Geometry
import SvgIcons.Core.Render
import SvgIcons.Core.Style
import SvgIcons.Core.Utils
import SvgIcons.Icons (exampleIcons)
import SvgIcons.Icons.Business (svgBusiness)
import SvgIcons.Icons.Coding   (svgCoding)
import SvgIcons.Icons.Computer (svgComputer)
import SvgIcons.Icons.Cosmos   (svgCosmos)
import SvgIcons.Icons.Human    (svgHuman)
import SvgIcons.Icons.Math     (svgMath)
import SvgIcons.Icons.Office   (svgOffice)
import SvgIcons.Icons.Religion (svgReligion)
import SvgIcons.Icons.Textarea (svgTextarea)
import SvgIcons.Icons.Tools    (svgTools)
import SvgIcons.Images.CountryFlags (countryFlags)
import SvgIcons.Images.Mosaics      (mosaicSample)





{- |
prop> main = renderAll "./svg"
-}
main :: IO ()
IO ()
main = [Char] -> IO ()
renderAll [Char]
"./svg"


{- |
Renders all icons and images from this package into 
the target directory. This is used to generate the 
example SVGs found in this documentation.

The directory is created if it does not exist, and
some subdirectories are created to distinguish between
icons or images.

__WARNING:__ this function __deletes the target directory__
and then creates it again. Be careful.
-}
renderAll :: FilePath -> IO ()
renderAll :: [Char] -> IO ()
renderAll [Char]
svgFolder = do
  Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
False [Char]
svgFolder
  [Char] -> IO ()
removeDirectoryRecursive       [Char]
svgFolder
  [Char] -> IO ()
createDirectory                [Char]
svgFolder
  [Char] -> IO ()
renderExamples ([Char]
svgFolder forall a. [a] -> [a] -> [a]
++ [Char]
"/examples/")
  [Char] -> IO ()
renderIcons    ([Char]
svgFolder forall a. [a] -> [a] -> [a]
++ [Char]
"/icons/")
  [Char] -> IO ()
renderImages   ([Char]
svgFolder forall a. [a] -> [a] -> [a]
++ [Char]
"/images/")
  [Char] -> Svg -> IO ()
renderTest     ([Char]
svgFolder forall a. [a] -> [a] -> [a]
++ [Char]
"/test/") (Int -> Float -> Float -> (Float, Float) -> Svg
starPolygonOverlap Int
7 Float
900 Float
50 (Float
0,Float
0))
  [Char] -> IO ()
putStrLn [Char]
"Svg files compiled correctly"


{- |
Renders the examples from `Icons` module
into the targeted directory.
-}
renderExamples :: FilePath -> IO ()
renderExamples :: [Char] -> IO ()
renderExamples [Char]
path = do
  [Char] -> IO ()
createDirectory [Char]
path
  [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
path [([Char], Svg)]
exampleIcons
  [Char] -> IO ()
renderGeometryExamples [Char]
path


{- |
Renders the examples from `Core.Geometry` module
into the targeted directory.
-}
renderGeometryExamples :: FilePath -> IO ()
renderGeometryExamples :: [Char] -> IO ()
renderGeometryExamples [Char]
path = do
    [Char] -> IO ()
createDirectory [Char]
p
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
p [([Char]
"anglesHelp", Svg
anglesHelp)]
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
p (forall a b. (a -> b) -> [a] -> [b]
map ([Char], Svg) -> ([Char], Svg)
fillIcons [([Char], Svg)]
geometryExamples)
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
p (forall a b. (a -> b) -> [a] -> [b]
map ([Char], Svg) -> ([Char], Svg)
fullIcons [([Char], Svg)]
geometryExamples)
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
p (forall a b. (a -> b) -> [a] -> [b]
map ([Char], Svg) -> ([Char], Svg)
strkIcons [([Char], Svg)]
geometryExamples)
  where
    p :: [Char]
p = [Char]
path forall a. [a] -> [a] -> [a]
++ [Char]
"/geometry/"
    fillIcons :: ([Char], Svg) -> ([Char], Svg)
fillIcons ([Char]
a,Svg
b) = ([Char]
a forall a. [a] -> [a] -> [a]
++ [Char]
"_fill" , Svg -> Svg
stdDims forall a b. (a -> b) -> a -> b
$ Svg -> Svg
fillStyle Svg
b)
    fullIcons :: ([Char], Svg) -> ([Char], Svg)
fullIcons ([Char]
a,Svg
b) = ([Char]
a forall a. [a] -> [a] -> [a]
++ [Char]
"_full" , Svg -> Svg
stdDims forall a b. (a -> b) -> a -> b
$ Svg -> Svg
fullStyle Svg
b)
    strkIcons :: ([Char], Svg) -> ([Char], Svg)
strkIcons ([Char]
a,Svg
b) = ([Char]
a forall a. [a] -> [a] -> [a]
++ [Char]
"_strk" , Svg -> Svg
stdDims forall a b. (a -> b) -> a -> b
$ Svg -> Svg
strkStyle Svg
b)


{- |
Renders all icons into the 
targeted directory.

All icons are rendered in a @viewbox "-1 -1 2 2"@ and
with 3 style variants:

  * Black fill and no stroke
  * Black stroke and no fill
  * Silver fill and black stroke
-}
renderIcons :: FilePath -> IO ()
renderIcons :: [Char] -> IO ()
renderIcons [Char]
path = 
  do
    [Char] -> IO ()
createDirectory [Char]
path
    [Char] -> IO ()
createDirectory [Char]
businessPath
    [Char] -> IO ()
createDirectory [Char]
codingPath
    [Char] -> IO ()
createDirectory [Char]
computerPath
    [Char] -> IO ()
createDirectory [Char]
cosmosPath
    [Char] -> IO ()
createDirectory [Char]
humanPath
    [Char] -> IO ()
createDirectory [Char]
mathPath
    [Char] -> IO ()
createDirectory [Char]
officePath
    [Char] -> IO ()
createDirectory [Char]
religionPath
    [Char] -> IO ()
createDirectory [Char]
textareaPath
    [Char] -> IO ()
createDirectory [Char]
toolsPath
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
businessPath (forall a b. (a -> b) -> [a] -> [b]
map ([Char], Svg) -> ([Char], Svg)
fillIcons [([Char], Svg)]
svgBusiness)
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
businessPath (forall a b. (a -> b) -> [a] -> [b]
map ([Char], Svg) -> ([Char], Svg)
fullIcons [([Char], Svg)]
svgBusiness)
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
businessPath (forall a b. (a -> b) -> [a] -> [b]
map ([Char], Svg) -> ([Char], Svg)
strkIcons [([Char], Svg)]
svgBusiness)
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
codingPath (forall a b. (a -> b) -> [a] -> [b]
map ([Char], Svg) -> ([Char], Svg)
fillIcons [([Char], Svg)]
svgCoding)
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
codingPath (forall a b. (a -> b) -> [a] -> [b]
map ([Char], Svg) -> ([Char], Svg)
fullIcons [([Char], Svg)]
svgCoding)
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
codingPath (forall a b. (a -> b) -> [a] -> [b]
map ([Char], Svg) -> ([Char], Svg)
strkIcons [([Char], Svg)]
svgCoding)
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
computerPath (forall a b. (a -> b) -> [a] -> [b]
map ([Char], Svg) -> ([Char], Svg)
fillIcons [([Char], Svg)]
svgComputer)
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
computerPath (forall a b. (a -> b) -> [a] -> [b]
map ([Char], Svg) -> ([Char], Svg)
fullIcons [([Char], Svg)]
svgComputer)
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
computerPath (forall a b. (a -> b) -> [a] -> [b]
map ([Char], Svg) -> ([Char], Svg)
strkIcons [([Char], Svg)]
svgComputer)
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
cosmosPath (forall a b. (a -> b) -> [a] -> [b]
map ([Char], Svg) -> ([Char], Svg)
fillIcons [([Char], Svg)]
svgCosmos)
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
cosmosPath (forall a b. (a -> b) -> [a] -> [b]
map ([Char], Svg) -> ([Char], Svg)
fullIcons [([Char], Svg)]
svgCosmos)
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
cosmosPath (forall a b. (a -> b) -> [a] -> [b]
map ([Char], Svg) -> ([Char], Svg)
strkIcons [([Char], Svg)]
svgCosmos)
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
humanPath (forall a b. (a -> b) -> [a] -> [b]
map ([Char], Svg) -> ([Char], Svg)
fillIcons [([Char], Svg)]
svgHuman)
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
humanPath (forall a b. (a -> b) -> [a] -> [b]
map ([Char], Svg) -> ([Char], Svg)
fullIcons [([Char], Svg)]
svgHuman)
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
humanPath (forall a b. (a -> b) -> [a] -> [b]
map ([Char], Svg) -> ([Char], Svg)
strkIcons [([Char], Svg)]
svgHuman)
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
mathPath (forall a b. (a -> b) -> [a] -> [b]
map ([Char], Svg) -> ([Char], Svg)
fillIcons [([Char], Svg)]
svgMath)
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
mathPath (forall a b. (a -> b) -> [a] -> [b]
map ([Char], Svg) -> ([Char], Svg)
fullIcons [([Char], Svg)]
svgMath)
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
mathPath (forall a b. (a -> b) -> [a] -> [b]
map ([Char], Svg) -> ([Char], Svg)
strkIcons [([Char], Svg)]
svgMath)
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
officePath (forall a b. (a -> b) -> [a] -> [b]
map ([Char], Svg) -> ([Char], Svg)
fillIcons [([Char], Svg)]
svgOffice)
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
officePath (forall a b. (a -> b) -> [a] -> [b]
map ([Char], Svg) -> ([Char], Svg)
fullIcons [([Char], Svg)]
svgOffice)
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
officePath (forall a b. (a -> b) -> [a] -> [b]
map ([Char], Svg) -> ([Char], Svg)
strkIcons [([Char], Svg)]
svgOffice)
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
religionPath (forall a b. (a -> b) -> [a] -> [b]
map ([Char], Svg) -> ([Char], Svg)
fillIcons [([Char], Svg)]
svgReligion)
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
religionPath (forall a b. (a -> b) -> [a] -> [b]
map ([Char], Svg) -> ([Char], Svg)
fullIcons [([Char], Svg)]
svgReligion)
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
religionPath (forall a b. (a -> b) -> [a] -> [b]
map ([Char], Svg) -> ([Char], Svg)
strkIcons [([Char], Svg)]
svgReligion)
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
textareaPath (forall a b. (a -> b) -> [a] -> [b]
map ([Char], Svg) -> ([Char], Svg)
fillIcons [([Char], Svg)]
svgTextarea)
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
textareaPath (forall a b. (a -> b) -> [a] -> [b]
map ([Char], Svg) -> ([Char], Svg)
fullIcons [([Char], Svg)]
svgTextarea)
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
textareaPath (forall a b. (a -> b) -> [a] -> [b]
map ([Char], Svg) -> ([Char], Svg)
strkIcons [([Char], Svg)]
svgTextarea)
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
toolsPath (forall a b. (a -> b) -> [a] -> [b]
map ([Char], Svg) -> ([Char], Svg)
fillIcons [([Char], Svg)]
svgTools)
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
toolsPath (forall a b. (a -> b) -> [a] -> [b]
map ([Char], Svg) -> ([Char], Svg)
fullIcons [([Char], Svg)]
svgTools)
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
toolsPath (forall a b. (a -> b) -> [a] -> [b]
map ([Char], Svg) -> ([Char], Svg)
strkIcons [([Char], Svg)]
svgTools)
  where
    fillIcons :: ([Char], Svg) -> ([Char], Svg)
fillIcons ([Char]
a,Svg
b) = ([Char]
a forall a. [a] -> [a] -> [a]
++ [Char]
"_fill" , Svg -> Svg
stdDims forall a b. (a -> b) -> a -> b
$ Svg -> Svg
fillStyle Svg
b)
    fullIcons :: ([Char], Svg) -> ([Char], Svg)
fullIcons ([Char]
a,Svg
b) = ([Char]
a forall a. [a] -> [a] -> [a]
++ [Char]
"_full" , Svg -> Svg
stdDims forall a b. (a -> b) -> a -> b
$ Svg -> Svg
fullStyle Svg
b)
    strkIcons :: ([Char], Svg) -> ([Char], Svg)
strkIcons ([Char]
a,Svg
b) = ([Char]
a forall a. [a] -> [a] -> [a]
++ [Char]
"_strk" , Svg -> Svg
stdDims forall a b. (a -> b) -> a -> b
$ Svg -> Svg
strkStyle Svg
b)
    -- test (a,b) = (a, coreSvg def $ b >> frame (-1) (-1) 2 2)

    businessPath :: [Char]
businessPath = [Char]
path forall a. [a] -> [a] -> [a]
++ [Char]
"business/"
    codingPath :: [Char]
codingPath   = [Char]
path forall a. [a] -> [a] -> [a]
++ [Char]
"coding/"
    computerPath :: [Char]
computerPath = [Char]
path forall a. [a] -> [a] -> [a]
++ [Char]
"computer/"
    cosmosPath :: [Char]
cosmosPath   = [Char]
path forall a. [a] -> [a] -> [a]
++ [Char]
"cosmos/"
    humanPath :: [Char]
humanPath    = [Char]
path forall a. [a] -> [a] -> [a]
++ [Char]
"human/"
    mathPath :: [Char]
mathPath     = [Char]
path forall a. [a] -> [a] -> [a]
++ [Char]
"math/"
    officePath :: [Char]
officePath   = [Char]
path forall a. [a] -> [a] -> [a]
++ [Char]
"office/"
    religionPath :: [Char]
religionPath = [Char]
path forall a. [a] -> [a] -> [a]
++ [Char]
"religion/"
    textareaPath :: [Char]
textareaPath = [Char]
path forall a. [a] -> [a] -> [a]
++ [Char]
"textarea/"
    toolsPath :: [Char]
toolsPath    = [Char]
path forall a. [a] -> [a] -> [a]
++ [Char]
"tools/"



{- |
Renders all images into the targeted directory.
-}
renderImages :: FilePath -> IO ()
renderImages :: [Char] -> IO ()
renderImages [Char]
path = do
    [Char] -> IO ()
createDirectory [Char]
path
    [Char] -> IO ()
createDirectory [Char]
countryFlagsPath
    [Char] -> IO ()
createDirectory [Char]
mosaicsPath
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
countryFlagsPath [([Char], Svg)]
countryFlags
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
mosaicsPath      [([Char], Svg)]
mosaicSample
  where
    countryFlagsPath :: [Char]
countryFlagsPath = [Char]
path forall a. [a] -> [a] -> [a]
++ [Char]
"countryFlags/"
    mosaicsPath :: [Char]
mosaicsPath      = [Char]
path forall a. [a] -> [a] -> [a]
++ [Char]
"mosaics/"



{- |
Takes an icon as second argument and renders it with all
3 styles (fill, full and stroke) into the targeted directory.

The `frame` function is used for testing purposes.
-}
renderTest :: FilePath -> Svg -> IO ()
renderTest :: [Char] -> Svg -> IO ()
renderTest [Char]
path Svg
svgTest = do
    [Char] -> IO ()
createDirectory [Char]
path
    [Char] -> [([Char], Svg)] -> IO ()
renderSvgFiles [Char]
path [([Char], Svg)]
test
  where
    -- test = 

    --   [ (,) "test_fill" (stdDims $ fillStyle svgFramed)

    --   , (,) "test_full" (stdDims $ fullStyle svgFramed)

    --   , (,) "test_strk" (stdDims $ strkStyle svgFramed)

    --   ]

    test :: [([Char], Svg)]
test =
      [ ([Char]
"test", Svg
svgFramed)]
    svgFramed :: Svg
svgFramed =
      Svg -> Svg
S.svg
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.viewbox AttributeValue
"-1000 -1000 2000 2000"
        forall a b. (a -> b) -> a -> b
$ do 
          Svg -> Svg
S.g (Svg
svgTest forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Float -> [Char] -> Float -> Float -> Float -> Float -> Svg
frame Float
0.1 [Char]
"black" (-Float
1) (-Float
1) Float
2 Float
2)
            forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.stroke AttributeValue
"black"
            forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.strokeWidth AttributeValue
"10"
            forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.fill AttributeValue
"white"