{-# OPTIONS_GHC -F -pgmF htfpp #-}
{-# OPTIONS_HADDOCK prune #-}
{-# LANGUAGE TemplateHaskell #-}

module Striot.LogicalOptimiser.RewriteRule ( LabelledRewriteRule(..)
                                           , RewriteRule(..)
                                           , lrule
                                           ) where

import Language.Haskell.TH
import Language.Haskell.TH.Syntax
import Test.Framework

import Striot.StreamGraph

type RewriteRule = StreamGraph -> Maybe (StreamGraph -> StreamGraph)

-- | A pairing of a `RewriteRule` with its name, encoded in a `String`.
data LabelledRewriteRule = LabelledRewriteRule
    { LabelledRewriteRule -> String
ruleLabel :: String
    , LabelledRewriteRule -> RewriteRule
rule :: RewriteRule }

-- | convenience function so one can write `$(lrule 'someRule)` rather than
-- `LabelledRewriteRule "someRule" someRule`.
-- This function needs to live in a separate module from LogicalOptimiser due
-- to technical limitations with Template Haskell.
lrule :: Quasi m => Name -> m Exp
lrule :: forall (m :: * -> *). Quasi m => Name -> m Exp
lrule Name
name = Exp -> m Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> m Exp) -> Exp -> m Exp
forall a b. (a -> b) -> a -> b
$
    Name -> Exp
ConE 'LabelledRewriteRule Exp -> Exp -> Exp
`AppE` ((Lit -> Exp
LitE (Lit -> Exp) -> (Name -> Lit) -> Name -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Lit
StringL (String -> Lit) -> (Name -> String) -> Name -> Lit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
nameBase) Name
name) Exp -> Exp -> Exp
`AppE` Name -> Exp
VarE Name
name