{-# 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 Language.Hakaru.Syntax.ABT
import Language.Hakaru.Syntax.AST
import Language.Hakaru.Syntax.IClasses
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 :: Renamer -> abt xs a -> abt xs a
renameAST Renamer
r = abt xs a -> abt xs a
forall (ys :: [Hakaru]) (b :: Hakaru). abt ys b -> abt ys b
start
where
start :: abt ys b -> abt ys b
start :: abt ys b -> abt ys b
start = View (Term abt) ys b -> abt ys b
forall (ys :: [Hakaru]) (b :: Hakaru).
View (Term abt) ys b -> abt ys b
loop (View (Term abt) ys b -> abt ys b)
-> (abt ys b -> View (Term abt) ys b) -> abt ys b -> abt ys b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. abt ys b -> View (Term abt) ys b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
(xs :: [k]) (a :: k).
ABT syn abt =>
abt xs a -> View (syn abt) xs a
viewABT
loop :: View (Term abt) ys b -> abt ys b
loop :: View (Term abt) ys b -> abt ys b
loop (Var Variable b
v) = Variable b -> abt '[] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
(a :: k).
ABT syn abt =>
Variable a -> abt '[] a
var (Renamer -> Variable b -> Variable b
forall k (a :: k). Renamer -> Variable a -> Variable a
renameVar Renamer
r Variable b
v)
loop (Syn Term abt b
s) = Term abt b -> abt '[] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
(a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn ((forall (ys :: [Hakaru]) (b :: Hakaru). abt ys b -> abt ys b)
-> Term abt b -> Term abt b
forall k1 k2 k3 (f :: (k1 -> k2 -> *) -> k3 -> *)
(a :: k1 -> k2 -> *) (b :: k1 -> k2 -> *) (j :: k3).
Functor21 f =>
(forall (h :: k1) (i :: k2). a h i -> b h i) -> f a j -> f b j
fmap21 forall (ys :: [Hakaru]) (b :: Hakaru). abt ys b -> abt ys b
start Term abt b
s)
loop (Bind Variable a
v View (Term abt) xs b
b) = Variable a -> abt xs b -> abt (a : xs) b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
(a :: k) (xs :: [k]) (b :: k).
ABT syn abt =>
Variable a -> abt xs b -> abt (a : xs) b
bind (Renamer -> Variable a -> Variable a
forall k (a :: k). Renamer -> Variable a -> Variable a
renameVar Renamer
r Variable a
v) (View (Term abt) xs b -> abt xs b
forall (ys :: [Hakaru]) (b :: Hakaru).
View (Term abt) ys b -> abt ys b
loop View (Term abt) xs b
b)
renameVar :: Renamer -> Variable a -> Variable a
renameVar :: Renamer -> Variable a -> Variable a
renameVar Renamer
r Variable a
v = Variable a
v { varHint :: Text
varHint = Renamer
r (Variable a -> Text
forall k (a :: k). Variable a -> Text
varHint Variable a
v) }
removeUnicodeChars :: Text -> Text
removeUnicodeChars :: Renamer
removeUnicodeChars = (Char -> Bool) -> Renamer
Text.filter Char -> Bool
isAscii