{- | this module provides a QuasiQuoter that supports the HSX syntax.

-- Module      :  Language.Haskell.HSX.Tranform
-- Copyright   :  (c) Niklas Broberg 2004-2012
-- License     :  BSD-style (see the file LICENSE.txt)
--
-- Maintainer  :  Niklas Broberg, niklas.broberg@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--

You will need to enable the QuasiQuotes extension for it to work, which you can do by adding this to the top of your file:

    {-\# LANGUAGE QuasiQuotes \#-}

Here is a simple example that generates an HTML fragment:

> import Data.Char        (toUpper)
> import HSX.QQ           (hsx)
> import HSX.XMLGenerator
>
> html :: (XMLGenerator m) => XMLGenT m (XMLType m)
> html = [hsx| <p><% map toUpper "hello, world!"  %></p> |]

The syntax used by the hsx QuasiQuoter is the same as what is used by
@trhsx@. It is mostly normal XML syntax which a few key differences:

 1. strings inside tags and attributes are automatically escaped -- you do not need to do &lt;, etc.

 2. The <% %> syntax is used to embed the result of evaluating a Haskell expression into the XML

Values are embedde using the 'EmbedAsChild' and 'EmbedAsAttr'
classes. Additional instances can be added to support application
specific types.

-}
module Language.Haskell.HSX.QQ
    ( hsx
    )
    where


import qualified Language.Haskell.Exts.Syntax           as Hs
import           Language.Haskell.Exts                  hiding (Exp, parse, parseExp)
import           Language.Haskell.HSX.Transform         (transformExp)
import           Language.Haskell.Meta.Parse            hiding (parseHsExp, parseExp)
import           Language.Haskell.Meta.Syntax.Translate (toExp)
import           Language.Haskell.TH                    (Exp, ExpQ)
import           Language.Haskell.TH.Quote              (QuasiQuoter(..))

-- | QuasiQuoter which can be used to parse HSX syntax
hsx :: QuasiQuoter
hsx :: QuasiQuoter
hsx = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter { quoteExp :: String -> Q Exp
quoteExp  = String -> Q Exp
parseHsxExp
                  , quotePat :: String -> Q Pat
quotePat  = String -> String -> Q Pat
forall a. HasCallStack => String -> a
error String
"the hsx QuasiQuoter can only be used on expressions."
                  , quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall a. HasCallStack => String -> a
error String
"the hsx QuasiQuoter can only be used on expressions."
                  , quoteDec :: String -> Q [Dec]
quoteDec  = String -> String -> Q [Dec]
forall a. HasCallStack => String -> a
error String
"the hsx QuasiQuoter can only be used on expressions."
                  }

parseHsxExp :: String -> ExpQ
parseHsxExp :: String -> Q Exp
parseHsxExp = (String -> Q Exp)
-> (Exp () -> Q Exp) -> Either String (Exp ()) -> Q Exp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Q Exp
forall a. HasCallStack => String -> a
error (String -> Q Exp) -> (String -> String) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. Show a => a -> String
show) (Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> (Exp () -> Exp) -> Exp () -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp () -> Exp
forall a. ToExp a => a -> Exp
toExp (Exp () -> Exp) -> (Exp () -> Exp ()) -> Exp () -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp () -> Exp ()
transformExp) (Either String (Exp ()) -> Q Exp)
-> (String -> Either String (Exp ())) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String (Exp ())
parseHsExp

-- parseExp :: String -> Either String Exp
parseExp :: String -> Either String Exp
parseExp = (String -> Either String Exp)
-> (Exp () -> Either String Exp)
-> Either String (Exp ())
-> Either String Exp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Either String Exp
forall a b. a -> Either a b
Left (Exp -> Either String Exp
forall a b. b -> Either a b
Right (Exp -> Either String Exp)
-> (Exp () -> Exp) -> Exp () -> Either String Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp () -> Exp
forall a. ToExp a => a -> Exp
toExp (Exp () -> Exp) -> (Exp () -> Exp ()) -> Exp () -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp () -> Exp ()
transformExp) (Either String (Exp ()) -> Either String Exp)
-> (String -> Either String (Exp ()))
-> String
-> Either String Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String (Exp ())
parseHsExp

-- parseHsExp :: String -> Either String (Hs.Exp SrcSpanInfo)
parseHsExp :: String -> Either String (Exp ())
parseHsExp = (String -> Either String (Exp ()))
-> (Exp () -> Either String (Exp ()))
-> Either String (Exp ())
-> Either String (Exp ())
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Either String (Exp ())
forall a b. a -> Either a b
Left (Exp () -> Either String (Exp ())
forall a b. b -> Either a b
Right (Exp () -> Either String (Exp ()))
-> (Exp () -> Exp ()) -> Exp () -> Either String (Exp ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp () -> Exp ()
transformExp) (Either String (Exp ()) -> Either String (Exp ()))
-> (String -> Either String (Exp ()))
-> String
-> Either String (Exp ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp SrcSpanInfo -> Exp ())
-> Either String (Exp SrcSpanInfo) -> Either String (Exp ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SrcSpanInfo -> ()) -> Exp SrcSpanInfo -> Exp ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SrcSpanInfo -> ()) -> Exp SrcSpanInfo -> Exp ())
-> (SrcSpanInfo -> ()) -> Exp SrcSpanInfo -> Exp ()
forall a b. (a -> b) -> a -> b
$ () -> SrcSpanInfo -> ()
forall a b. a -> b -> a
const ()) (Either String (Exp SrcSpanInfo) -> Either String (Exp ()))
-> (String -> Either String (Exp SrcSpanInfo))
-> String
-> Either String (Exp ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseResult (Exp SrcSpanInfo) -> Either String (Exp SrcSpanInfo)
forall a. ParseResult a -> Either String a
parseResultToEither (ParseResult (Exp SrcSpanInfo) -> Either String (Exp SrcSpanInfo))
-> (String -> ParseResult (Exp SrcSpanInfo))
-> String
-> Either String (Exp SrcSpanInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseMode -> String -> ParseResult (Exp SrcSpanInfo)
parseExpWithMode ParseMode
parseMode

parseMode :: ParseMode
parseMode :: ParseMode
parseMode = String
-> Language
-> [Extension]
-> Bool
-> Bool
-> Maybe [Fixity]
-> Bool
-> ParseMode
ParseMode String
"" Language
Haskell2010 [Extension]
allExtensions Bool
False Bool
True ([Fixity] -> Maybe [Fixity]
forall a. a -> Maybe a
Just [Fixity]
baseFixities) Bool
False

allExtensions :: [Extension]
allExtensions :: [Extension]
allExtensions = (KnownExtension -> Extension) -> [KnownExtension] -> [Extension]
forall a b. (a -> b) -> [a] -> [b]
map KnownExtension -> Extension
EnableExtension
    [KnownExtension
RecursiveDo,KnownExtension
ParallelListComp,KnownExtension
MultiParamTypeClasses,KnownExtension
FunctionalDependencies,KnownExtension
RankNTypes,KnownExtension
ExistentialQuantification,
     KnownExtension
ScopedTypeVariables,KnownExtension
ImplicitParams,KnownExtension
FlexibleContexts,KnownExtension
FlexibleInstances,KnownExtension
EmptyDataDecls,KnownExtension
KindSignatures,
     KnownExtension
BangPatterns,KnownExtension
TemplateHaskell,KnownExtension
ForeignFunctionInterface,KnownExtension
Arrows,KnownExtension
Generics,KnownExtension
NamedFieldPuns,KnownExtension
PatternGuards,
     KnownExtension
MagicHash,KnownExtension
TypeFamilies,KnownExtension
StandaloneDeriving,KnownExtension
TypeOperators,KnownExtension
RecordWildCards,KnownExtension
GADTs,KnownExtension
UnboxedTuples,
     KnownExtension
PackageImports,KnownExtension
QuasiQuotes,KnownExtension
TransformListComp,KnownExtension
ViewPatterns,KnownExtension
XmlSyntax,KnownExtension
RegularPatterns]