module Reanimate.External
  ( URL,
    SHA256,
    zipArchive,
    tarball,

    -- * External Icon Datasets
    simpleIcon,
    simpleIconColor,
    simpleIcons,
    svgLogo,
    svgLogos,
  )
where

import           Codec.Picture          (PixelRGB8 (..))
import           Control.Monad          (unless)
import           Crypto.Hash.SHA256     (hash)
import           Data.Aeson             (decodeFileStrict)
import qualified Data.ByteString        as B (readFile)
import           Data.ByteString.Base64 (encode)
import qualified Data.ByteString.Char8  as B8 (unpack)
import           Data.Char              (isSpace, toLower)
import           Data.List              (sort)
import           Data.Map               (Map)
import qualified Data.Map               as M
import           Numeric                (readHex)
import           Reanimate.Animation    (SVG)
import           Reanimate.Constants    (screenHeight, screenWidth)
import           Reanimate.Misc         (getReanimateCacheDirectory, withTempFile)
import           Reanimate.Raster       (mkImage)
import           System.Directory       (doesDirectoryExist, doesFileExist, findExecutable,
                                         getDirectoryContents)
import           System.FilePath        (splitExtension, (<.>), (</>))
import           System.IO.Unsafe       (unsafePerformIO)
import           System.Process         (callProcess)

-- | Resource address
type URL = String

-- | Resource hash
type SHA256 = String

fetchStaticFile :: URL -> SHA256 -> (FilePath -> FilePath -> IO ()) -> IO FilePath
fetchStaticFile :: URL -> URL -> (URL -> URL -> IO ()) -> IO URL
fetchStaticFile URL
url URL
sha256 URL -> URL -> IO ()
unpack = do
  URL
root <- IO URL
getReanimateCacheDirectory
  let folder :: URL
folder = URL
root URL -> URL -> URL
</> URL
sha256
  Bool
hit <- URL -> IO Bool
doesDirectoryExist URL
folder
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hit (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    URL -> (URL -> IO ()) -> IO ()
forall a. URL -> (URL -> IO a) -> IO a
downloadFile URL
url ((URL -> IO ()) -> IO ()) -> (URL -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \URL
path -> do
      ByteString
inp <- URL -> IO ByteString
B.readFile URL
path
      let inpSha :: URL
inpSha = ByteString -> URL
B8.unpack (ByteString -> ByteString
encode (ByteString -> ByteString
hash ByteString
inp))
      if URL
inpSha URL -> URL -> Bool
forall a. Eq a => a -> a -> Bool
== URL
sha256
        then do
          URL -> URL -> IO ()
unpack URL
folder URL
path
        else
          URL -> IO ()
forall a. HasCallStack => URL -> a
error (URL -> IO ()) -> URL -> IO ()
forall a b. (a -> b) -> a -> b
$
            URL
"URL " URL -> URL -> URL
forall a. [a] -> [a] -> [a]
++ URL
url URL -> URL -> URL
forall a. [a] -> [a] -> [a]
++ URL
"\n"
              URL -> URL -> URL
forall a. [a] -> [a] -> [a]
++ URL
"  Expected SHA256: "
              URL -> URL -> URL
forall a. [a] -> [a] -> [a]
++ URL
sha256
              URL -> URL -> URL
forall a. [a] -> [a] -> [a]
++ URL
"\n"
              URL -> URL -> URL
forall a. [a] -> [a] -> [a]
++ URL
"  Actual SHA256:   "
              URL -> URL -> URL
forall a. [a] -> [a] -> [a]
++ URL
inpSha
  URL -> IO URL
forall (m :: * -> *) a. Monad m => a -> m a
return URL
folder

{-# NOINLINE zipArchive #-}

-- | Download and unpack zip archive. The returned path is the unpacked folder.
zipArchive :: URL -> SHA256 -> FilePath
zipArchive :: URL -> URL -> URL
zipArchive URL
url URL
sha256 = IO URL -> URL
forall a. IO a -> a
unsafePerformIO (IO URL -> URL) -> IO URL -> URL
forall a b. (a -> b) -> a -> b
$
  URL -> URL -> (URL -> URL -> IO ()) -> IO URL
fetchStaticFile URL
url URL
sha256 ((URL -> URL -> IO ()) -> IO URL)
-> (URL -> URL -> IO ()) -> IO URL
forall a b. (a -> b) -> a -> b
$ \URL
folder URL
zipfile ->
    URL -> [URL] -> IO ()
callProcess URL
"unzip" [URL
"-qq", URL
"-d", URL
folder, URL
zipfile]

{-# NOINLINE tarball #-}

-- | Download and unpack tarball. The returned path is the unpacked folder.
tarball :: URL -> SHA256 -> FilePath
tarball :: URL -> URL -> URL
tarball URL
url URL
sha256 = IO URL -> URL
forall a. IO a -> a
unsafePerformIO (IO URL -> URL) -> IO URL -> URL
forall a b. (a -> b) -> a -> b
$
  URL -> URL -> (URL -> URL -> IO ()) -> IO URL
fetchStaticFile URL
url URL
sha256 ((URL -> URL -> IO ()) -> IO URL)
-> (URL -> URL -> IO ()) -> IO URL
forall a b. (a -> b) -> a -> b
$ \URL
folder URL
tarfile ->
    URL -> [URL] -> IO ()
callProcess URL
"tar" [URL
"--overwrite", URL
"--one-top-level=" URL -> URL -> URL
forall a. [a] -> [a] -> [a]
++ URL
folder, URL
"-xzf", URL
tarfile]

downloadFile :: URL -> (FilePath -> IO a) -> IO a
downloadFile :: URL -> (URL -> IO a) -> IO a
downloadFile URL
url URL -> IO a
action = do
  Maybe URL
mbCurl <- URL -> IO (Maybe URL)
findExecutable URL
"curl"
  Maybe URL
mbWget <- URL -> IO (Maybe URL)
findExecutable URL
"wget"
  case (Maybe URL
mbCurl, Maybe URL
mbWget) of
    (Just URL
curl, Maybe URL
_)     -> URL -> URL -> (URL -> IO a) -> IO a
forall a. URL -> URL -> (URL -> IO a) -> IO a
downloadFileCurl URL
curl URL
url URL -> IO a
action
    (Maybe URL
_, Just URL
wget)     -> URL -> URL -> (URL -> IO a) -> IO a
forall a. URL -> URL -> (URL -> IO a) -> IO a
downloadFileWget URL
wget URL
url URL -> IO a
action
    (Maybe URL
Nothing, Maybe URL
Nothing) -> URL -> IO a
forall a. HasCallStack => URL -> a
error URL
"curl/wget required to download files"

downloadFileCurl :: FilePath -> URL -> (FilePath -> IO a) -> IO a
downloadFileCurl :: URL -> URL -> (URL -> IO a) -> IO a
downloadFileCurl URL
curl URL
url URL -> IO a
action = URL -> (URL -> IO a) -> IO a
forall a. URL -> (URL -> IO a) -> IO a
withTempFile URL
"dl" ((URL -> IO a) -> IO a) -> (URL -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \URL
path -> do
  URL -> [URL] -> IO ()
callProcess
    URL
curl
    [ URL
url,
      URL
"--location",
      URL
"--output",
      URL
path,
      URL
"--silent",
      URL
"--show-error",
      URL
"--max-filesize",
      URL
"10M",
      URL
"--max-time",
      URL
"60"
    ]
  URL -> IO a
action URL
path

downloadFileWget :: FilePath -> URL -> (FilePath -> IO a) -> IO a
downloadFileWget :: URL -> URL -> (URL -> IO a) -> IO a
downloadFileWget URL
wget URL
url URL -> IO a
action = URL -> (URL -> IO a) -> IO a
forall a. URL -> (URL -> IO a) -> IO a
withTempFile URL
"dl" ((URL -> IO a) -> IO a) -> (URL -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \URL
path -> do
  URL -> [URL] -> IO ()
callProcess
    URL
wget
    [ URL
url,
      URL
"--output-document=" URL -> URL -> URL
forall a. [a] -> [a] -> [a]
++ URL
path,
      URL
"--quiet"
    ]
  URL -> IO a
action URL
path



-------------------------------------------------------------------------------
-- SimpleIcons

simpleIconsFolder :: FilePath
simpleIconsFolder :: URL
simpleIconsFolder =
  URL -> URL -> URL
tarball
    URL
"https://github.com/simple-icons/simple-icons/archive/3.11.0.tar.gz"
    URL
"NXa8TrHHuQofrPbqTf0pBGt1GDRfuQ4IcQ7kNEk9OcQ="
    URL -> URL -> URL
</> URL
"simple-icons-3.11.0"

{-# NOINLINE simpleIconPath #-}
simpleIconPath :: String -> FilePath
simpleIconPath :: URL -> URL
simpleIconPath URL
key = IO URL -> URL
forall a. IO a -> a
unsafePerformIO (IO URL -> URL) -> IO URL -> URL
forall a b. (a -> b) -> a -> b
$ do
  let path :: URL
path = URL
simpleIconsFolder URL -> URL -> URL
</> URL
"icons" URL -> URL -> URL
</> URL
key URL -> URL -> URL
<.> URL
"svg"
  Bool
hit <- URL -> IO Bool
doesFileExist URL
path
  if Bool
hit
    then URL -> IO URL
forall (f :: * -> *) a. Applicative f => a -> f a
pure URL
path
    else URL -> IO URL
forall a. HasCallStack => URL -> a
error (URL -> IO URL) -> URL -> IO URL
forall a b. (a -> b) -> a -> b
$ URL
"Key not found in simple-icons dataset: " URL -> URL -> URL
forall a. [a] -> [a] -> [a]
++ URL -> URL
forall a. Show a => a -> URL
show URL
key

-- | Icons from <https://simpleicons.org/>. Version 3.11.0. License: CC0
--
-- @
-- let icon = "cplusplus" in `Reanimate.mkGroup`
-- [ `Reanimate.mkBackgroundPixel` (`Codec.Picture.Types.promotePixel` $ `simpleIconColor` icon)
-- , `Reanimate.withFillOpacity` 1 $ `simpleIcon` icon ]
-- @
--
--   <<docs/gifs/doc_simpleIcon.gif>>
simpleIcon :: String -> SVG
simpleIcon :: URL -> SVG
simpleIcon = Double -> Double -> URL -> SVG
mkImage Double
forall a. Fractional a => a
screenWidth Double
forall a. Fractional a => a
screenHeight (URL -> SVG) -> (URL -> URL) -> URL -> SVG
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URL -> URL
simpleIconPath

-- | Simple Icons svgs do not contain color. Instead, each icon has an associated color value.
simpleIconColor :: String -> PixelRGB8
simpleIconColor :: URL -> PixelRGB8
simpleIconColor URL
key =
  case URL -> Map URL PixelRGB8 -> Maybe PixelRGB8
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup URL
key Map URL PixelRGB8
simpleIconColors of
    Maybe PixelRGB8
Nothing    -> URL -> PixelRGB8
forall a. HasCallStack => URL -> a
error (URL -> PixelRGB8) -> URL -> PixelRGB8
forall a b. (a -> b) -> a -> b
$ URL
"Key not found in simple-icons dataset: " URL -> URL -> URL
forall a. [a] -> [a] -> [a]
++ URL -> URL
forall a. Show a => a -> URL
show URL
key
    Just PixelRGB8
pixel -> PixelRGB8
pixel

simpleIconColors :: Map String PixelRGB8
simpleIconColors :: Map URL PixelRGB8
simpleIconColors = IO (Map URL PixelRGB8) -> Map URL PixelRGB8
forall a. IO a -> a
unsafePerformIO (IO (Map URL PixelRGB8) -> Map URL PixelRGB8)
-> IO (Map URL PixelRGB8) -> Map URL PixelRGB8
forall a b. (a -> b) -> a -> b
$ do
  let path :: URL
path = URL
simpleIconsFolder URL -> URL -> URL
</> URL
"_data" URL -> URL -> URL
</> URL
"simple-icons.json"
  Maybe (Map URL [Map URL URL])
mbRet <- URL -> IO (Maybe (Map URL [Map URL URL]))
forall a. FromJSON a => URL -> IO (Maybe a)
decodeFileStrict URL
path
  let parsed :: Maybe (Map URL PixelRGB8)
parsed = do
        Map URL [Map URL URL]
m <- Maybe (Map URL [Map URL URL])
mbRet
        [Map URL URL]
icons <- URL -> Map URL [Map URL URL] -> Maybe [Map URL URL]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup URL
"icons" Map URL [Map URL URL]
m
        Map URL PixelRGB8 -> Maybe (Map URL PixelRGB8)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map URL PixelRGB8 -> Maybe (Map URL PixelRGB8))
-> Map URL PixelRGB8 -> Maybe (Map URL PixelRGB8)
forall a b. (a -> b) -> a -> b
$
          [(URL, PixelRGB8)] -> Map URL PixelRGB8
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
            [ (URL -> URL
fromTitle URL
title, URL -> PixelRGB8
parseHex URL
hex) | Map URL URL
icon <- [Map URL URL]
icons, Just URL
title <- [URL -> Map URL URL -> Maybe URL
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup URL
"title" Map URL URL
icon], Just URL
hex <- [URL -> Map URL URL -> Maybe URL
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup URL
"hex" Map URL URL
icon]
            ]
  case Maybe (Map URL PixelRGB8)
parsed of
    Maybe (Map URL PixelRGB8)
Nothing -> URL -> IO (Map URL PixelRGB8)
forall a. HasCallStack => URL -> a
error URL
"Invalid json in simpleIcons"
    Just Map URL PixelRGB8
v  -> Map URL PixelRGB8 -> IO (Map URL PixelRGB8)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map URL PixelRGB8
v
  where
    fromTitle :: String -> String
    fromTitle :: URL -> URL
fromTitle = URL -> URL
replaceChars (URL -> URL) -> (URL -> URL) -> URL -> URL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> URL -> URL
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower

    replaceChars :: String -> String
    replaceChars :: URL -> URL
replaceChars (Char
'.' : Char
x : URL
xs) = URL
"dot-" URL -> URL -> URL
forall a. [a] -> [a] -> [a]
++ URL -> URL
replaceChars (Char
x Char -> URL -> URL
forall a. a -> [a] -> [a]
: URL
xs)
    replaceChars URL
"." = URL
"dot"
    replaceChars (Char
x : Char
'.' : []) = URL -> URL
replaceChars (Char
x Char -> URL -> URL
forall a. a -> [a] -> [a]
: URL
"-dot")
    replaceChars (Char
x : Char
'.' : URL
xs) = URL -> URL
replaceChars (Char
x Char -> URL -> URL
forall a. a -> [a] -> [a]
: URL
"-dot-" URL -> URL -> URL
forall a. [a] -> [a] -> [a]
++ URL
xs)
    replaceChars (Char
x : URL
xs)
      | Char -> Bool
isSpace Char
x Bool -> Bool -> Bool
|| Char
x Char -> URL -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` URL
"!:'’" = URL -> URL
replaceChars URL
xs
    replaceChars (Char
'&' : URL
xs) = URL
"-and-" URL -> URL -> URL
forall a. [a] -> [a] -> [a]
++ URL -> URL
replaceChars URL
xs
    replaceChars (Char
'+' : URL
xs) = URL
"plus" URL -> URL -> URL
forall a. [a] -> [a] -> [a]
++ URL -> URL
replaceChars URL
xs
    replaceChars (Char
x : URL
xs)
      | Char
x Char -> URL -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` URL
"àáâãä" = Char
'a' Char -> URL -> URL
forall a. a -> [a] -> [a]
: URL -> URL
replaceChars URL
xs
      | Char
x Char -> URL -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` URL
"ìíîï" = Char
'i' Char -> URL -> URL
forall a. a -> [a] -> [a]
: URL -> URL
replaceChars URL
xs
      | Char
x Char -> URL -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` URL
"èéêë" = Char
'e' Char -> URL -> URL
forall a. a -> [a] -> [a]
: URL -> URL
replaceChars URL
xs
      | Char
x Char -> URL -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` URL
"šś" = Char
's' Char -> URL -> URL
forall a. a -> [a] -> [a]
: URL -> URL
replaceChars URL
xs
    replaceChars (Char
x : URL
xs) = Char
x Char -> URL -> URL
forall a. a -> [a] -> [a]
: URL -> URL
replaceChars URL
xs
    replaceChars [] = []
    parseHex :: String -> PixelRGB8
    parseHex :: URL -> PixelRGB8
parseHex URL
hex = Pixel8 -> Pixel8 -> Pixel8 -> PixelRGB8
PixelRGB8 (Int -> Pixel8
forall p. (Eq p, Num p) => Int -> p
p Int
0) (Int -> Pixel8
forall p. (Eq p, Num p) => Int -> p
p Int
2) (Int -> Pixel8
forall p. (Eq p, Num p) => Int -> p
p Int
4)
      where
        p :: Int -> p
p Int
offset = case ReadS p
forall a. (Eq a, Num a) => ReadS a
readHex (Int -> URL -> URL
forall a. Int -> [a] -> [a]
take Int
2 (URL -> URL) -> URL -> URL
forall a b. (a -> b) -> a -> b
$ Int -> URL -> URL
forall a. Int -> [a] -> [a]
drop Int
offset URL
hex) of
          [(p
num, URL
"")] -> p
num
          [(p, URL)]
_           -> URL -> p
forall a. HasCallStack => URL -> a
error (URL -> p) -> URL -> p
forall a b. (a -> b) -> a -> b
$ URL
"Invalid hex: " URL -> URL -> URL
forall a. [a] -> [a] -> [a]
++ (Int -> URL -> URL
forall a. Int -> [a] -> [a]
take Int
2 (URL -> URL) -> URL -> URL
forall a b. (a -> b) -> a -> b
$ Int -> URL -> URL
forall a. Int -> [a] -> [a]
drop Int
offset URL
hex)

{-# NOINLINE simpleIcons #-}
-- | Complete list of all Simple Icons.
simpleIcons :: [String]
simpleIcons :: [URL]
simpleIcons = IO [URL] -> [URL]
forall a. IO a -> a
unsafePerformIO (IO [URL] -> [URL]) -> IO [URL] -> [URL]
forall a b. (a -> b) -> a -> b
$ do
  let folder :: URL
folder = URL
simpleIconsFolder URL -> URL -> URL
</> URL
"icons"
  [URL]
files <- URL -> IO [URL]
getDirectoryContents URL
folder
  [URL] -> IO [URL]
forall (m :: * -> *) a. Monad m => a -> m a
return ([URL] -> IO [URL]) -> [URL] -> IO [URL]
forall a b. (a -> b) -> a -> b
$
    [URL] -> [URL]
forall a. Ord a => [a] -> [a]
sort
      [URL
key | URL
file <- [URL]
files, let (URL
key, URL
ext) = URL -> (URL, URL)
splitExtension URL
file, URL
ext URL -> URL -> Bool
forall a. Eq a => a -> a -> Bool
== URL
".svg"]


svgLogosFolder :: FilePath
svgLogosFolder :: URL
svgLogosFolder = URL -> URL -> URL
tarball
    URL
"https://github.com/gilbarbara/logos/archive/2018.01.tar.gz"
    URL
"kRRA0cF6sVOyqtfVW8EMew4OB4WJcY81DEGS3FLEY8Y="
    URL -> URL -> URL
</> URL
"logos-2018.01" URL -> URL -> URL
</> URL
"logos"

{-# NOINLINE svgLogoPath #-}
svgLogoPath :: String -> FilePath
svgLogoPath :: URL -> URL
svgLogoPath URL
key = IO URL -> URL
forall a. IO a -> a
unsafePerformIO (IO URL -> URL) -> IO URL -> URL
forall a b. (a -> b) -> a -> b
$ do
  let path :: URL
path = URL
svgLogosFolder URL -> URL -> URL
</> URL
key URL -> URL -> URL
<.> URL
"svg"
  Bool
hit <- URL -> IO Bool
doesFileExist URL
path
  if Bool
hit
    then URL -> IO URL
forall (f :: * -> *) a. Applicative f => a -> f a
pure URL
path
    else URL -> IO URL
forall a. HasCallStack => URL -> a
error (URL -> IO URL) -> URL -> IO URL
forall a b. (a -> b) -> a -> b
$ URL
"Key not found in svg logos dataset: " URL -> URL -> URL
forall a. [a] -> [a] -> [a]
++ URL -> URL
forall a. Show a => a -> URL
show URL
key

-- | Icons from <https://svgporn.com/>. Version 2018.01. License: CC0
--
-- @
-- `svgLogo` "cassandra"
-- @
--
--   <<docs/gifs/doc_svgLogo2.gif>>
svgLogo :: String -> SVG
svgLogo :: URL -> SVG
svgLogo = Double -> Double -> URL -> SVG
mkImage Double
forall a. Fractional a => a
screenWidth Double
forall a. Fractional a => a
screenHeight (URL -> SVG) -> (URL -> URL) -> URL -> SVG
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URL -> URL
svgLogoPath

{-# NOINLINE svgLogos #-}
-- | Complete list of all SVG Icons.
svgLogos :: [String]
svgLogos :: [URL]
svgLogos = IO [URL] -> [URL]
forall a. IO a -> a
unsafePerformIO (IO [URL] -> [URL]) -> IO [URL] -> [URL]
forall a b. (a -> b) -> a -> b
$ do
  [URL]
files <- URL -> IO [URL]
getDirectoryContents URL
svgLogosFolder
  [URL] -> IO [URL]
forall (m :: * -> *) a. Monad m => a -> m a
return ([URL] -> IO [URL]) -> [URL] -> IO [URL]
forall a b. (a -> b) -> a -> b
$
    [URL] -> [URL]
forall a. Ord a => [a] -> [a]
sort
      [URL
key | URL
file <- [URL]
files, let (URL
key, URL
ext) = URL -> (URL, URL)
splitExtension URL
file, URL
ext URL -> URL -> Bool
forall a. Eq a => a -> a -> Bool
== URL
".svg"]