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