-- | Rules that generate the favicons from the logo
module MathiasSM.Rules.Favicon (faviconRules) where

import Hakyll (
    Pattern,
    Rules,
    compile,
    customRoute,
    getResourceLBS,
    match,
    route,
    unixFilterLBS,
    version,
    withItemBody,
 )

-- | An icon generated from the logo SVG
data Favicon
    = -- | The SVG itself, served from the site root
      Svg
    | -- | Single-size .ico
      Ico
    | -- | PNG written to @file@, scaled to @size@ with @padding@ pixels on each side
      Png {Favicon -> [Char]
file :: FilePath, Favicon -> Int
size :: Int, Favicon -> Int
padding :: Int}

favicons :: [Favicon]
favicons :: [Favicon]
favicons =
    [ Favicon
Svg
    , Favicon
Ico
    , [Char] -> Int -> Int -> Favicon
Png [Char]
"apple-touch-icon.png" Int
180 Int
20
    , [Char] -> Int -> Int -> Favicon
Png [Char]
"favicon-192.png" Int
192 Int
20
    , [Char] -> Int -> Int -> Favicon
Png [Char]
"favicon-512.png" Int
512 Int
40
    ]

faviconPath :: Favicon -> FilePath
faviconPath :: Favicon -> [Char]
faviconPath Favicon
Svg = [Char]
"favicon.svg"
faviconPath Favicon
Ico = [Char]
"favicon.ico"
faviconPath Png{[Char]
file :: Favicon -> [Char]
file :: [Char]
file} = [Char]
file

-- | Generates every favicon from the given logo
faviconRules :: Pattern -> Rules ()
faviconRules :: Pattern -> Rules ()
faviconRules Pattern
ptn = Pattern -> Rules () -> Rules ()
match Pattern
ptn (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ (Favicon -> Rules ()) -> [Favicon] -> Rules ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Favicon -> Rules ()
processFavicon [Favicon]
favicons

processFavicon :: Favicon -> Rules ()
processFavicon :: Favicon -> Rules ()
processFavicon Favicon
favicon = [Char] -> Rules () -> Rules ()
version (Favicon -> [Char]
faviconVersion Favicon
favicon) (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
    Routes -> Rules ()
route (Routes -> Rules ()) -> Routes -> Rules ()
forall a b. (a -> b) -> a -> b
$ (Identifier -> [Char]) -> Routes
customRoute ((Identifier -> [Char]) -> Routes)
-> (Identifier -> [Char]) -> Routes
forall a b. (a -> b) -> a -> b
$ [Char] -> Identifier -> [Char]
forall a b. a -> b -> a
const ([Char] -> Identifier -> [Char]) -> [Char] -> Identifier -> [Char]
forall a b. (a -> b) -> a -> b
$ Favicon -> [Char]
faviconPath Favicon
favicon
    Compiler (Item ByteString) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile (Compiler (Item ByteString) -> Rules ())
-> Compiler (Item ByteString) -> Rules ()
forall a b. (a -> b) -> a -> b
$ case Favicon -> Maybe ([Char], [[Char]])
faviconCommand Favicon
favicon of
        Maybe ([Char], [[Char]])
Nothing -> Compiler (Item ByteString)
getResourceLBS
        Just ([Char]
cmd, [[Char]]
args) -> Compiler (Item ByteString)
getResourceLBS Compiler (Item ByteString)
-> (Item ByteString -> Compiler (Item ByteString))
-> Compiler (Item ByteString)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ByteString -> Compiler ByteString)
-> Item ByteString -> Compiler (Item ByteString)
forall a b. (a -> Compiler b) -> Item a -> Compiler (Item b)
withItemBody ([Char] -> [[Char]] -> ByteString -> Compiler ByteString
unixFilterLBS [Char]
cmd [[Char]]
args)

-- | Distinguishes the versions of the logo item; one per generated file
faviconVersion :: Favicon -> String
faviconVersion :: Favicon -> [Char]
faviconVersion = Favicon -> [Char]
faviconPath

-- | ImageMagick invocation converting the SVG on stdin, if the favicon needs one
faviconCommand :: Favicon -> Maybe (String, [String])
faviconCommand :: Favicon -> Maybe ([Char], [[Char]])
faviconCommand Favicon
Svg = Maybe ([Char], [[Char]])
forall a. Maybe a
Nothing
faviconCommand Favicon
Ico =
    ([Char], [[Char]]) -> Maybe ([Char], [[Char]])
forall a. a -> Maybe a
Just
        ( [Char]
"convert"
        , [[Char]
"-background", [Char]
"none", [Char]
"svg:-", [Char]
"-define", [Char]
"icon:auto-resize=32", [Char]
"+repage", [Char]
"ico:-"]
        )
faviconCommand Png{Int
size :: Favicon -> Int
size :: Int
size, Int
padding :: Favicon -> Int
padding :: Int
padding} =
    ([Char], [[Char]]) -> Maybe ([Char], [[Char]])
forall a. a -> Maybe a
Just
        ( [Char]
"convert"
        ,
            [ [Char]
"-background"
            , [Char]
"none"
            , [Char]
"svg:-"
            , [Char]
"-gravity"
            , [Char]
"center"
            , [Char]
"-scale"
            , Int -> [Char]
forall a. Show a => a -> [Char]
show Int
inner [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"x" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
inner
            , [Char]
"-extent"
            , Int -> [Char]
forall a. Show a => a -> [Char]
show Int
size [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"x" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
size
            , [Char]
"+repage"
            , [Char]
"png:-"
            ]
        )
  where
    inner :: Int
inner = Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
padding Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2