1#if __GLASGOW_HASKELL__ < 800
2{-# LANGUAGE RecordWildCards, TemplateHaskell, ViewPatterns #-}
3#else
4{-# LANGUAGE RecordWildCards, TemplateHaskellQuotes, ViewPatterns #-}
5#endif
6#if MIN_VERSION_template_haskell(2,12,0)
7{-# LANGUAGE Safe #-}
8#elif __GLASGOW_HASKELL__ >= 702
9{-# LANGUAGE Trustworthy #-}
10#endif
11module Network.URI.Static
12    (
13    -- * Absolute URIs
14      uri
15#if __GLASGOW_HASKELL__ >= 708
16    , staticURI
17#endif
18    , staticURI'
19    -- * Relative URIs
20    , relativeReference
21#if __GLASGOW_HASKELL__ >= 708
22    , staticRelativeReference
23#endif
24    , staticRelativeReference'
25    ) where
26
27import Language.Haskell.TH.Lib (ExpQ)
28import Language.Haskell.TH.Quote (QuasiQuoter(..))
29import Network.URI (URI(..), parseURI, parseRelativeReference)
30
31#if __GLASGOW_HASKELL__ >= 708
32import Language.Haskell.TH.Lib (TExpQ)
33import Language.Haskell.TH.Syntax (unTypeQ)
34#endif
35
36-- $setup
37-- >>> :set -XTemplateHaskell
38-- >>> :set -XQuasiQuotes
39
40----------------------------------------------------------------------------
41-- Absolute URIs
42----------------------------------------------------------------------------
43
44#if __GLASGOW_HASKELL__ >= 708
45-- | 'staticURI' parses a specified string at compile time
46--   and return an expression representing the URI when it's a valid URI.
47--   Otherwise, it emits an error.
48--
49-- >>> $$(staticURI "http://www.google.com/")
50-- http://www.google.com/
51--
52-- >>> $$(staticURI "http://www.google.com/##")
53-- <BLANKLINE>
54-- <interactive>...
55-- ... Invalid URI: http://www.google.com/##
56-- ...
57staticURI :: String    -- ^ String representation of a URI
58          -> TExpQ URI -- ^ URI
59staticURI (parseURI -> Just u) = [|| u ||]
60staticURI s = fail $ "Invalid URI: " ++ s
61#endif
62
63-- | 'staticURI'' parses a specified string at compile time.
64--
65-- The typed template haskell 'staticURI' is available only with GHC-7.8+.
66staticURI' :: String    -- ^ String representation of a URI
67           -> ExpQ      -- ^ URI
68#if __GLASGOW_HASKELL__ >= 708
69staticURI' = unTypeQ . staticURI
70#else
71staticURI' (parseURI -> Just u) = [| u |]
72staticURI' s = fail $ "Invalid URI: " ++ s
73#endif
74
75-- | 'uri' is a quasi quoter for 'staticURI'.
76--
77-- >>> [uri|http://www.google.com/|]
78-- http://www.google.com/
79--
80-- >>> [uri|http://www.google.com/##|]
81-- <BLANKLINE>
82-- <interactive>...
83-- ... Invalid URI: http://www.google.com/##
84-- ...
85uri :: QuasiQuoter
86uri = QuasiQuoter {
87    quoteExp =  staticURI',
88    quotePat = undefined,
89    quoteType = undefined,
90    quoteDec = undefined
91}
92
93----------------------------------------------------------------------------
94-- Relative URIs
95----------------------------------------------------------------------------
96
97#if __GLASGOW_HASKELL__ >= 708
98-- | 'staticRelativeReference' parses a specified string at compile time and
99--   return an expression representing the URI when it's a valid relative
100--   reference. Otherwise, it emits an error.
101--
102-- >>> $$(staticRelativeReference "/foo?bar=baz#quux")
103-- /foo?bar=baz#quux
104--
105-- >>> $$(staticRelativeReference "http://www.google.com/")
106-- <BLANKLINE>
107-- <interactive>...
108-- ... Invalid relative reference: http://www.google.com/
109-- ...
110staticRelativeReference :: String -- ^ String representation of a reference
111                        -> TExpQ URI -- ^ Refererence
112staticRelativeReference (parseRelativeReference -> Just ref) = [|| ref ||]
113staticRelativeReference ref = fail $ "Invalid relative reference: " ++ ref
114#endif
115
116-- | 'staticRelativeReference'' parses a specified string at compile time and
117--   return an expression representing the URI when it's a valid relative
118--   reference. Otherwise, it emits an error.
119--
120-- The typed template haskell 'staticRelativeReference' is available only with GHC-7.8+.
121staticRelativeReference' :: String -- ^ String representation of a reference
122                         -> ExpQ   -- ^ Refererence
123#if __GLASGOW_HASKELL__ >= 708
124staticRelativeReference' = unTypeQ . staticRelativeReference
125#else
126staticRelativeReference' (parseRelativeReference -> Just ref) = [| ref |]
127staticRelativeReference' ref = fail $ "Invalid relative reference: " ++ ref
128#endif
129
130-- | 'relativeReference' is a quasi quoter for 'staticRelativeReference'.
131--
132-- >>> [relativeReference|/foo?bar=baz#quux|]
133-- /foo?bar=baz#quux
134--
135-- >>> [relativeReference|http://www.google.com/|]
136-- <BLANKLINE>
137-- <interactive>...
138-- ... Invalid relative reference: http://www.google.com/
139-- ...
140relativeReference :: QuasiQuoter
141relativeReference = QuasiQuoter {
142    quoteExp = staticRelativeReference',
143    quotePat = undefined,
144    quoteType = undefined,
145    quoteDec = undefined
146}
147