git.iko.soy/patch
on f565bee help sign in
patch/src/Reflex/Dynamic/TH.hs
38 lines 1.7 kB history raw
1{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeOperators, GADTs, EmptyDataDecls, PatternGuards #-}
2module Reflex.Dynamic.TH (qDyn, unqDyn) where
4import Reflex.Dynamic
6import Language.Haskell.TH
7import Data.Data
8import Control.Monad.State
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'
11qDyn :: Q Exp -> Q Exp
12qDyn qe = do
13 e <- qe
14 let f :: forall d. Data d => d -> StateT [(Name, Exp)] Q d
15 f d = case eqT of
16 Just (Refl :: d :~: Exp)
17 | AppE (VarE m) eInner <- d
18 , m == 'unqMarker
19 -> do n <- lift $ newName "dyn"
20 modify ((n, eInner):)
21 return $ VarE n
22 _ -> gmapM f d
23 (e', exprsReversed) <- runStateT (gmapM f e) []
24 let exprs = reverse exprsReversed
25 arg = foldr (\a b -> ConE 'FHCons `AppE` a `AppE` b) (ConE 'FHNil) $ map snd exprs
26 param = foldr (\a b -> ConP 'HCons [VarP a, b]) (ConP 'HNil []) $ map fst exprs
27 [| mapDyn $(return $ LamE [param] e') =<< distributeFHListOverDyn $(return arg) |]
29unqDyn :: Q Exp -> Q Exp
30unqDyn e = [| unqMarker $e |]
32-- | This type represents an occurrence of unqDyn before it has been processed by qDyn. If you see it in a type error, it probably means that unqDyn has been used outside of a qDyn context.
33data UnqDyn
35-- unqMarker must not be exported; it is used only as a way of smuggling data from unqDyn to qDyn
36--TODO: It would be much nicer if the TH AST was extensible to support this kind of thing without trickery
37unqMarker :: a -> UnqDyn
38unqMarker = error "An unqDyn expression was used outside of a qDyn expression"