{-# LANGUAGE CPP
, DataKinds
, EmptyCase
, ExistentialQuantification
, FlexibleContexts
, GADTs
, GeneralizedNewtypeDeriving
, KindSignatures
, MultiParamTypeClasses
, OverloadedStrings
, PolyKinds
, ScopedTypeVariables
, TypeFamilies
, TypeOperators
#-}
{-# OPTIONS_GHC -Wall -fwarn-tabs #-}
module Language.Hakaru.Syntax.Rename where
import Control.Monad.Reader
import Control.Monad.State
import Data.Maybe (fromMaybe)
import Data.Number.Nat
import Language.Hakaru.Syntax.ABT
import Language.Hakaru.Syntax.AST
import Language.Hakaru.Syntax.AST.Eq (Varmap)
import Language.Hakaru.Syntax.Gensym
import Language.Hakaru.Syntax.IClasses
import Language.Hakaru.Syntax.Variable
import qualified Data.Text as Text
import Data.Text (Text)
import Data.Char
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
type Renamer = Text -> Text
renameAST
:: forall abt xs a . (ABT Term abt)
=> Renamer
-> abt xs a
-> abt xs a
renameAST r = start
where
start :: abt ys b -> abt ys b
start = loop . viewABT
loop :: View (Term abt) ys b -> abt ys b
loop (Var v) = var (renameVar r v)
loop (Syn s) = syn (fmap21 start s)
loop (Bind v b) = bind (renameVar r v) (loop b)
renameVar :: Renamer -> Variable a -> Variable a
renameVar r v = v { varHint = r (varHint v) }
removeUnicodeChars :: Text -> Text
removeUnicodeChars = Text.filter isAscii