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.Syntax.Compat (SpliceQ, unTypeCode, toCode)
33#endif
34
35-- $setup
36-- >>> :set -XTemplateHaskell
37-- >>> :set -XQuasiQuotes
38
39----------------------------------------------------------------------------
40-- Absolute URIs
41----------------------------------------------------------------------------
42
43#if __GLASGOW_HASKELL__ >= 708
44-- | 'staticURI' parses a specified string at compile time
45--   and return an expression representing the URI when it's a valid URI.
46--   Otherwise, it emits an error.
47--
48-- >>> $$(staticURI "http://www.google.com/")
49-- http://www.google.com/
50--
51-- >>> $$(staticURI "http://www.google.com/##")
52-- <BLANKLINE>
53-- <interactive>...
54-- ... Invalid URI: http://www.google.com/##
55-- ...
56staticURI :: String      -- ^ String representation of a URI
57          -> SpliceQ URI -- ^ URI
58staticURI (parseURI -> Just u) = [|| u ||]
59staticURI s = error $ "Invalid URI: " ++ s
60#endif
61
62-- | 'staticURI'' parses a specified string at compile time.
63--
64-- The typed template haskell 'staticURI' is available only with GHC-7.8+.
65staticURI' :: String    -- ^ String representation of a URI
66           -> ExpQ      -- ^ URI
67#if __GLASGOW_HASKELL__ >= 708
68staticURI' = unTypeCode . toCode . staticURI
69#else
70staticURI' (parseURI -> Just u) = [| u |]
71staticURI' s = fail $ "Invalid URI: " ++ s
72#endif
73
74-- | 'uri' is a quasi quoter for 'staticURI'.
75--
76-- >>> [uri|http://www.google.com/|]
77-- http://www.google.com/
78--
79-- >>> [uri|http://www.google.com/##|]
80-- <BLANKLINE>
81-- <interactive>...
82-- ... Invalid URI: http://www.google.com/##
83-- ...
84uri :: QuasiQuoter
85uri = QuasiQuoter {
86    quoteExp =  staticURI',
87    quotePat = undefined,
88    quoteType = undefined,
89    quoteDec = undefined
90}
91
92----------------------------------------------------------------------------
93-- Relative URIs
94----------------------------------------------------------------------------
95
96#if __GLASGOW_HASKELL__ >= 708
97-- | 'staticRelativeReference' parses a specified string at compile time and
98--   return an expression representing the URI when it's a valid relative
99--   reference. Otherwise, it emits an error.
100--
101-- >>> $$(staticRelativeReference "/foo?bar=baz#quux")
102-- /foo?bar=baz#quux
103--
104-- >>> $$(staticRelativeReference "http://www.google.com/")
105-- <BLANKLINE>
106-- <interactive>...
107-- ... Invalid relative reference: http://www.google.com/
108-- ...
109staticRelativeReference :: String      -- ^ String representation of a reference
110                        -> SpliceQ URI -- ^ Refererence
111staticRelativeReference (parseRelativeReference -> Just ref) = [|| ref ||]
112staticRelativeReference ref = error $ "Invalid relative reference: " ++ ref
113#endif
114
115-- | 'staticRelativeReference'' parses a specified string at compile time and
116--   return an expression representing the URI when it's a valid relative
117--   reference. Otherwise, it emits an error.
118--
119-- The typed template haskell 'staticRelativeReference' is available only with GHC-7.8+.
120staticRelativeReference' :: String -- ^ String representation of a reference
121                         -> ExpQ   -- ^ Refererence
122#if __GLASGOW_HASKELL__ >= 708
123staticRelativeReference' = unTypeCode . toCode . staticRelativeReference
124#else
125staticRelativeReference' (parseRelativeReference -> Just ref) = [| ref |]
126staticRelativeReference' ref = fail $ "Invalid relative reference: " ++ ref
127#endif
128
129-- | 'relativeReference' is a quasi quoter for 'staticRelativeReference'.
130--
131-- >>> [relativeReference|/foo?bar=baz#quux|]
132-- /foo?bar=baz#quux
133--
134-- >>> [relativeReference|http://www.google.com/|]
135-- <BLANKLINE>
136-- <interactive>...
137-- ... Invalid relative reference: http://www.google.com/
138-- ...
139relativeReference :: QuasiQuoter
140relativeReference = QuasiQuoter {
141    quoteExp = staticRelativeReference',
142    quotePat = undefined,
143    quoteType = undefined,
144    quoteDec = undefined
145}
146