~alcinnz/haskell-stylist

ref: e8442cdfb21a746bfb3b5503c637a6fe8895bead haskell-stylist/src/Data/CSS/Preprocessor/Assets.hs -rw-r--r-- 2.1 KiB
e8442cdf — Adrian Cochrane ISSUES: Plan psuedoclass lowering. 4 years ago
                                                                                
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
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')