{-# 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 
-- Copyright   :  Copyright (c) 2016 the Hakaru team
-- License     :  BSD3
-- Maintainer  :
-- Stability   :  experimental
-- Portability :  GHC-only
--
-- Performs renaming of variables hints only (in Hakaru expressions) 
-- which hopefully has no effect on semantics but can produce prettier expressions
--
----------------------------------------------------------------
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