never executed always true always false
1 module Reanimate.External
2 ( URL,
3 SHA256,
4 zipArchive,
5 tarball,
6
7 -- * External Icon Datasets
8 simpleIcon,
9 simpleIconColor,
10 simpleIcons,
11 )
12 where
13
14 import Codec.Picture (PixelRGB8 (..))
15 import Control.Monad (unless)
16 import Crypto.Hash.SHA256 (hash)
17 import Data.Aeson (decodeFileStrict)
18 import qualified Data.ByteString as B (readFile)
19 import Data.ByteString.Base64 (encode)
20 import qualified Data.ByteString.Char8 as B8 (unpack)
21 import Data.Char (isSpace, toLower)
22 import Data.List (sort)
23 import Data.Map (Map)
24 import qualified Data.Map as M
25 import Numeric (readHex)
26 import Reanimate.Animation (SVG)
27 import Reanimate.Constants (screenHeight, screenWidth)
28 import Reanimate.Misc (getReanimateCacheDirectory, withTempFile)
29 import Reanimate.Raster (mkImage)
30 import System.Directory (doesDirectoryExist, doesFileExist, findExecutable, getDirectoryContents)
31 import System.FilePath (splitExtension, (<.>), (</>))
32 import System.IO.Unsafe (unsafePerformIO)
33 import System.Process (callProcess)
34
35 -- | Resource address
36 type URL = String
37
38 -- | Resource hash
39 type SHA256 = String
40
41 fetchStaticFile :: URL -> SHA256 -> (FilePath -> FilePath -> IO ()) -> IO FilePath
42 fetchStaticFile url sha256 unpack = do
43 root <- getReanimateCacheDirectory
44 let folder = root </> sha256
45 hit <- doesDirectoryExist folder
46 unless hit $
47 downloadFile url $ \path -> do
48 inp <- B.readFile path
49 let inpSha = B8.unpack (encode (hash inp))
50 if inpSha == sha256
51 then do
52 unpack folder path
53 else
54 error $
55 "URL " ++ url ++ "\n"
56 ++ " Expected SHA256: "
57 ++ sha256
58 ++ "\n"
59 ++ " Actual SHA256: "
60 ++ inpSha
61 return folder
62
63 {-# NOINLINE zipArchive #-}
64
65 -- | Download and unpack zip archive. The returned path is the unpacked folder.
66 zipArchive :: URL -> SHA256 -> FilePath
67 zipArchive url sha256 = unsafePerformIO $
68 fetchStaticFile url sha256 $ \folder zipfile ->
69 callProcess "unzip" ["-qq", "-d", folder, zipfile]
70
71 {-# NOINLINE tarball #-}
72
73 -- | Download and unpack tarball. The returned path is the unpacked folder.
74 tarball :: URL -> SHA256 -> FilePath
75 tarball url sha256 = unsafePerformIO $
76 fetchStaticFile url sha256 $ \folder tarfile ->
77 callProcess "tar" ["--overwrite", "--one-top-level=" ++ folder, "-xzf", tarfile]
78
79 downloadFile :: URL -> (FilePath -> IO a) -> IO a
80 downloadFile url action = do
81 mbCurl <- findExecutable "curl"
82 mbWget <- findExecutable "wget"
83 case (mbCurl, mbWget) of
84 (Just curl, _) -> downloadFileCurl curl url action
85 (_, Just wget) -> downloadFileWget wget url action
86 (Nothing, Nothing) -> error "curl/wget required to download files"
87
88 downloadFileCurl :: FilePath -> URL -> (FilePath -> IO a) -> IO a
89 downloadFileCurl curl url action = withTempFile "dl" $ \path -> do
90 callProcess
91 curl
92 [ url,
93 "--location",
94 "--output",
95 path,
96 "--silent",
97 "--show-error",
98 "--max-filesize",
99 "10M",
100 "--max-time",
101 "60"
102 ]
103 action path
104
105 downloadFileWget :: FilePath -> URL -> (FilePath -> IO a) -> IO a
106 downloadFileWget wget url action = withTempFile "dl" $ \path -> do
107 callProcess
108 wget
109 [ url,
110 "--output-document=" ++ path,
111 "--quiet"
112 ]
113 action path
114
115
116
117 -------------------------------------------------------------------------------
118 -- SimpleIcons
119
120 simpleIconsFolder :: FilePath
121 simpleIconsFolder =
122 tarball
123 "https://github.com/simple-icons/simple-icons/archive/3.11.0.tar.gz"
124 "NXa8TrHHuQofrPbqTf0pBGt1GDRfuQ4IcQ7kNEk9OcQ="
125 </> "simple-icons-3.11.0"
126
127 {-# NOINLINE simpleIconPath #-}
128 simpleIconPath :: String -> FilePath
129 simpleIconPath key = unsafePerformIO $ do
130 let path = simpleIconsFolder </> "icons" </> key <.> "svg"
131 hit <- doesFileExist path
132 if hit
133 then pure path
134 else error $ "Key not found in simple-icons dataset: " ++ show key
135
136 -- | Icons from <http://simpleicons.org/>. Version 3.11.0. License: CC0
137 --
138 -- @
139 -- let icon = "cplusplus" in `Reanimate.mkGroup`
140 -- [ `Reanimate.mkBackgroundPixel` (`Codec.Picture.Types.promotePixel` $ `simpleIconColor` icon)
141 -- , `Reanimate.withFillOpacity` 1 $ `simpleIcon` icon ]
142 -- @
143 --
144 -- <<docs/gifs/doc_simpleIcon.gif>>
145 simpleIcon :: String -> SVG
146 simpleIcon = mkImage screenWidth screenHeight . simpleIconPath
147
148 -- | Simple Icons svgs do not contain color. Instead, each icon has an associated color value.
149 simpleIconColor :: String -> PixelRGB8
150 simpleIconColor key =
151 case M.lookup key simpleIconColors of
152 Nothing -> error $ "Key not found in simple-icons dataset: " ++ show key
153 Just pixel -> pixel
154
155 -- | Complete list of all Simple Icons.
156 simpleIconColors :: Map String PixelRGB8
157 simpleIconColors = unsafePerformIO $ do
158 let path = simpleIconsFolder </> "_data" </> "simple-icons.json"
159 mbRet <- decodeFileStrict path
160 let parsed = do
161 m <- mbRet
162 icons <- M.lookup "icons" m
163 pure $
164 M.fromList
165 [ (fromTitle title, parseHex hex) | icon <- icons, Just title <- [M.lookup "title" icon], Just hex <- [M.lookup "hex" icon]
166 ]
167 case parsed of
168 Nothing -> error "Invalid json in simpleIcons"
169 Just v -> pure v
170 where
171 fromTitle :: String -> String
172 fromTitle = replaceChars . map toLower
173
174 replaceChars :: String -> String
175 replaceChars ('.' : x : xs) = "dot-" ++ replaceChars (x : xs)
176 replaceChars "." = "dot"
177 replaceChars (x : '.' : []) = replaceChars (x : "-dot")
178 replaceChars (x : '.' : xs) = replaceChars (x : "-dot-" ++ xs)
179 replaceChars (x : xs)
180 | isSpace x || x `elem` "!:'’" = replaceChars xs
181 replaceChars ('&' : xs) = "-and-" ++ replaceChars xs
182 replaceChars ('+' : xs) = "plus" ++ replaceChars xs
183 replaceChars (x : xs)
184 | x `elem` "àáâãä" = 'a' : replaceChars xs
185 | x `elem` "ìíîï" = 'i' : replaceChars xs
186 | x `elem` "èéêë" = 'e' : replaceChars xs
187 | x `elem` "šś" = 's' : replaceChars xs
188 replaceChars (x : xs) = x : replaceChars xs
189 replaceChars [] = []
190 parseHex :: String -> PixelRGB8
191 parseHex hex = PixelRGB8 (p 0) (p 2) (p 4)
192 where
193 p offset = case readHex (take 2 $ drop offset hex) of
194 [(num, "")] -> num
195 _ -> error $ "Invalid hex: " ++ (take 2 $ drop offset hex)
196
197 {-# NOINLINE simpleIcons #-}
198 simpleIcons :: [String]
199 simpleIcons = unsafePerformIO $ do
200 let folder = simpleIconsFolder </> "icons"
201 files <- getDirectoryContents folder
202 return $
203 sort
204 [key | file <- files, let (key, ext) = splitExtension file, ext == ".svg"]