bd8560f · reflex · git.iko.soy

git.iko.soy/reflex

on develop help sign in

Add mkDyn quasiquoter

bd8560fRyan Trinkle11 years ago

default.nix+2

compare with develop

unifiedsplit

@@ -1,5 +1,6 @@

1{ mkDerivation, dependent-map, dependent-sum

2, mtl, ref-tf, semigroups, these, MemoTrie, exception-transformers

3+, haskell-src-exts, haskell-src-meta

3}:

4}:

4mkDerivation {

5mkDerivation {

5 pname = "reflex";

6 pname = "reflex";

@@ -7,6 +8,7 @@ mkDerivation {

7 src = builtins.filterSource (path: type: baseNameOf path != ".git") ./.;

8 src = builtins.filterSource (path: type: baseNameOf path != ".git") ./.;

8 buildDepends = [

9 buildDepends = [

9 dependent-map dependent-sum mtl ref-tf semigroups these exception-transformers

10 dependent-map dependent-sum mtl ref-tf semigroups these exception-transformers

11+ haskell-src-exts haskell-src-meta

10 ];

12 ];

11 testDepends = [

13 testDepends = [

12 MemoTrie

14 MemoTrie

reflex.cabal+4−1

@@ -28,7 +28,10 @@ library

28 ref-tf == 0.4.*,

29 exception-transformers == 0.4.*,

30 transformers >= 0.2,

31− transformers-compat >= 0.3

31+ transformers-compat >= 0.3,

32+ haskell-src-exts == 1.16.*,

33+ haskell-src-meta == 0.6.*,

34+ syb == 0.5.*

33 exposed-modules:

36 exposed-modules:

34 Reflex,

37 Reflex,

src/Reflex/Dynamic/TH.hs+30−1

@@ -1,11 +1,17 @@

1{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeOperators, GADTs, EmptyDataDecls, PatternGuards #-}

2−module Reflex.Dynamic.TH (qDyn, unqDyn) where

2+module Reflex.Dynamic.TH (qDyn, unqDyn, mkDyn) where

4import Reflex.Dynamic

6import Language.Haskell.TH

7+import qualified Language.Haskell.TH.Syntax as TH

8+import Language.Haskell.TH.Quote

7import Data.Data

9import Data.Data

8import Control.Monad.State

10import Control.Monad.State

11+import qualified Language.Haskell.Exts as Hs

12+import qualified Language.Haskell.Meta.Syntax.Translate as Hs

13+import Data.Monoid

14+import Data.Generics

10-- | Quote a Dynamic expression. Within the quoted expression, you can use '$(unqDyn [| x |])' to refer to any expression 'x' of type 'Dynamic t a'; the unquoted result will be of type 'a'

16-- | Quote a Dynamic expression. Within the quoted expression, you can use '$(unqDyn [| x |])' to refer to any expression 'x' of type 'Dynamic t a'; the unquoted result will be of type 'a'

11qDyn :: Q Exp -> Q Exp

17qDyn :: Q Exp -> Q Exp

@@ -36,3 +42,26 @@ data UnqDyn

36--TODO: It would be much nicer if the TH AST was extensible to support this kind of thing without trickery

42--TODO: It would be much nicer if the TH AST was extensible to support this kind of thing without trickery

37unqMarker :: a -> UnqDyn

43unqMarker :: a -> UnqDyn

38unqMarker = error "An unqDyn expression was used outside of a qDyn expression"

44unqMarker = error "An unqDyn expression was used outside of a qDyn expression"

45+

46+mkDyn :: QuasiQuoter

47+mkDyn = QuasiQuoter

48+ { quoteExp = mkDynExp

49+ , quotePat = error "mkDyn: pattern splices are not supported"

50+ , quoteType = error "mkDyn: type splices are not supported"

51+ , quoteDec = error "mkDyn: declaration splices are not supported"

52+ }

53+

54+mkDynExp :: String -> Q Exp

55+mkDynExp s = case Hs.parseExpWithMode (Hs.defaultParseMode { Hs.extensions = [ Hs.EnableExtension Hs.TemplateHaskell ] }) s of

56+ Hs.ParseFailed (Hs.SrcLoc _ l c) err -> fail $ "mkDyn:" <> show l <> ":" <> show c <> ": " <> err

57+ Hs.ParseOk e -> qDyn $ return $ everywhere (id `extT` reinstateUnqDyn) $ Hs.toExp $ everywhere (id `extT` antiE) e

58+ where TH.Name (TH.OccName occName) (TH.NameG _ _ (TH.ModName modName)) = 'unqMarker

59+ antiE x = case x of

60+ Hs.SpliceExp se ->

61+ Hs.App (Hs.Var $ Hs.Qual (Hs.ModuleName modName) (Hs.Ident occName)) $ case se of

62+ Hs.IdSplice v -> Hs.Var $ Hs.UnQual $ Hs.Ident v

63+ Hs.ParenSplice ps -> ps

64+ _ -> x

65+ reinstateUnqDyn (TH.Name (TH.OccName occName') (TH.NameQ (TH.ModName modName')))

66+ | modName == modName' && occName == occName' = 'unqMarker

67+ reinstateUnqDyn x = x