@@ -1,46 +0,0 @@
1−module Obelisk.Asset.TH where
2−
3−import Language.Haskell.TH.Syntax
4−import System.FilePath
5−import qualified Data.Text as T
6−import qualified Data.ByteString as BS
7−import qualified Data.ByteString.Lazy as LBS
8−import qualified Data.ByteString.Lazy.Builder as LBS
9−import Data.Digest.Pure.SHA
10−import Data.Text.Encoding
11−import Data.Monoid
12−import Data.Bits
13−import qualified Data.Vector.Unboxed as UV
14−import Data.Char
15−import Data.Word
16−
17−-- | Warning: does not support negative numbers (will result in infinite loop)
18−toNixBase32 :: LBS.ByteString -> LBS.ByteString
19−toNixBase32 x = LBS.toLazyByteString $ mconcat $ map (LBS.word8 . (symbols UV.!) . fromIntegral) vals
20− where vals = byteStringToQuintets x
21− symbols = UV.fromList $ map (fromIntegral . ord) $ filter (`notElem` "eotu") $ ['0'..'9'] <> ['a'..'z']
22−
23−
24−-- See https://github.com/NixOS/nix/blob/6f1743b1a5116ca57a60b481ee4083c891b7a334/src/libutil/hash.cc#L109
25−byteStringToQuintets :: LBS.ByteString -> [Word8]
26−byteStringToQuintets hash = map f [len-1, len-2 .. 0]
27− where hashSize = fromIntegral $ LBS.length hash
28− len = (hashSize * 8 - 1) `div` 5 + 1
29− f n = let b = n * 5
30− (i, j) = b `divMod` 8
31− j' = fromIntegral j
32− c = ((hash `LBS.index` i) `shift` (-j')) .|. (if i >= hashSize - 1 then 0 else (hash `LBS.index` (i + 1)) `shift` (8 - j')) --TODO: This is probably pretty slow; replace with something that doesn't use LBS.index
33− in c .&. 0x1f
34−
35−assetPath' :: FilePath -> FilePath -> Q FilePath
36−assetPath' root relativePath = do
37− let path = root </> relativePath
38− qAddDependentFile path
39− contents <- fmap LBS.fromStrict $ runIO $ BS.readFile path
40− let hashPrefix = T.unpack $ decodeUtf8 $ LBS.toStrict $ toNixBase32 $ bytestringDigest $ sha256 contents
41− (dir, filename) = splitFileName relativePath
42− return $ dir </> (hashPrefix <> "-" <> filename)
43−
44−assetPath :: FilePath -> FilePath -> Q Exp
45−assetPath root relativePath =
46− LitE . StringL <$> assetPath' root relativePath