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