~alcinnz/haskell-stylist

ref: a73ae4419a8e0dc8f2621ada54baa99c4172a667 haskell-stylist/src/Data/CSS/Preprocessor/Assets.hs -rw-r--r-- 2.1 KiB
a73ae441 — Adrian Cochrane Remove Stylist-Traits APIs from Stylist Core, leaving backwards-compatible stubs. 2 years ago
                                                                                
70713fc6 Adrian Cochrane
277f756c Adrian Cochrane
dc780976 Adrian Cochrane
70713fc6 Adrian Cochrane
dc780976 Adrian Cochrane
70713fc6 Adrian Cochrane
dc780976 Adrian Cochrane
70713fc6 Adrian Cochrane
dc780976 Adrian Cochrane
70713fc6 Adrian Cochrane
dc780976 Adrian Cochrane
70713fc6 Adrian Cochrane
dc780976 Adrian Cochrane
70713fc6 Adrian Cochrane
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
{-# LANGUAGE OverloadedStrings #-}
-- | Utilities for rewriting URLs referenced via CSS properties.
module Data.CSS.Preprocessor.Assets(StyleAssets(..), URIRewriter(..)) where

-- TODO Unit test!
import           Data.Text as Txt
import           Network.URI
import qualified Data.CSS.Syntax.StyleSheet as CSS
import qualified Data.CSS.Syntax.Tokens as CSSTok
import           Data.List (nub, elem)

-- | Extracts referenced URLs from specified properties.
data StyleAssets = StyleAssets {
    -- | The properties from which to extract URLs.
    filterProps :: [Txt.Text],
    -- | The extracted URLs.
    assets :: [URI]
}

instance CSS.StyleSheet StyleAssets where
    addRule self (CSS.StyleRule _ props _) =
        StyleAssets (filterProps self) $ nub (
            assets self ++ [uri | (prop, val) <- props,
                    prop `elem` filterProps self,
                    CSSTok.Url text <- val,
                    Just uri <- [parseAbsoluteURI $ Txt.unpack text]]
            )


-- | Substitutes in given URLs into a property value.
rewritePropertyVal :: [(URI, URI)] -> [CSSTok.Token] -> [CSSTok.Token] 
rewritePropertyVal rewrites (CSSTok.Url text:vals)
    | Just uri <- parseURIReference $ Txt.unpack text, Just rewrite <- uri `lookup` rewrites =
        CSSTok.Url (Txt.pack $ uriToString id rewrite "") : rewritePropertyVal rewrites vals
    | otherwise = CSSTok.Url "" : rewritePropertyVal rewrites vals
rewritePropertyVal rewrites (val:vals) = val:rewritePropertyVal rewrites vals
rewritePropertyVal _ [] = []

-- | Substitutes in given URLs into the inner stylesheet being parsed.
data URIRewriter s = URIRewriter [(URI, URI)] s
instance CSS.StyleSheet s => CSS.StyleSheet (URIRewriter s) where
    setPriority p (URIRewriter r s) = URIRewriter r $ CSS.setPriority p s
    addRule (URIRewriter r s) (CSS.StyleRule sel props psuedo) =
        URIRewriter r $ CSS.addRule s $ CSS.StyleRule sel [
            (prop, rewritePropertyVal r val) | (prop, val) <- props
        ] psuedo
    addAtRule (URIRewriter r s) name toks =
        let (self', toks') = CSS.addAtRule s name toks in (URIRewriter r self', toks')