{-# LANGUAGE FlexibleInstances #-}



{-# LANGUAGE FlexibleContexts #-}

-- {-# LANGUAGE TemplateHaskell #-}

-- {-# LANGUAGE MultiParamTypeClasses #-}

-- {-# LANGUAGE FunctionalDependencies #-}


-- {-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}


-- {-# LANGUAGE TypeOperators #-}
-- {-# LANGUAGE RecordWildCards #-}
-- {-# LANGUAGE MultiWayIf #-}
-- {-# LANGUAGE InstanceSigs #-}
-- {-# LANGUAGE LambdaCase #-}



-- -- -- for the zippers w/ lenses experiments
-- -- {-# LANGUAGE RankNTypes #-}
-- {-# LANGUAGE Rank2Types #-}


{-# OPTIONS_GHC -Wall #-}

-- {-# OPTIONS_GHC -fno-warn-unused-matches #-}


-- {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -Wno-orphans #-}


{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
-- {-# OPTIONS_GHC -Wno-warn-missing-signatures #-}


-- {-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
-- {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
-- {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
-- {-# OPTIONS_GHC -fno-warn-name-shadowing #-}



{-# LANGUAGE CPP #-}
-- {-# OPTIONS_GHC -cpp -DPiForallInstalled #-}







module OldPrettyTerm
       (
         module OldPrettyTerm
       )

       where

import Control.Monad.Reader.Class



import Utils (names)


import Data.String

import Control.Applicative


import Data.Text (Text)

import Data.Text.Prettyprint.Doc

import Control.Monad.Identity
import Control.Monad.Reader


import PrettyCommon

import PrettyTT





import OldTerm


-- import PrettyBasic
import OldPretty (prettyExpr, prettyDecl, prettyModule, prettyConstructorDef, prettyMatch, prettyTele)


import Prelude hiding (fail, mod)




#ifdef DOCTEST

-- -- fromEither'
-- import Data.Either.Combinators
-- -- -- import System.IO.Silently
-- -- -- import Debug.Trace (trace)

#endif



prettyTerm :: (Applicative f, MonadReader PrettyInfo f, Eq a, IsString a)
           =>  Term t a -> [String] -> Int -> (t -> Int -> f (Doc Ann)) -> (a -> Int -> f (Doc Ann)) -> Flavor -> f (Doc Ann)

prettyTerm (E e) vars prec kt ka fl = prettyExpr e vars prec kt ka fl

prettyTerm (D d) vars prec kt ka fl = prettyDecl d vars prec kt ka fl

prettyTerm (M m) vars prec kt ka fl = prettyModule m vars prec kt ka fl



prettyTerm (CDef c) vars prec kt ka fl = prettyConstructorDef c vars prec kt ka fl


prettyTerm (Mat m) vars prec kt ka fl = prettyMatch m vars prec kt ka fl


prettyTerm (ARG {} ) _ _ _ _ _ = error "missing: prettyTerm ARG"


prettyTerm (Tel t) vars prec kt ka fl = prettyTele t vars prec kt ka fl

prettyTerm (Pat _) _ _ _ _ _ = error "panic: prettyTerm Pat"


prettyTerm (Ide x) _ prec _  ka _  = ka x prec
prettyTerm (T x)   _ prec kt _  _  = kt x prec





instance PrettyAnn (Term Text Text) where

  prettyAnn m = prettyTerm m names' (-1) (pure . pure . pretty) (pure . pure . pretty) Pretty

  -- where names' = filter ((`notMember` setOf traverse m) . pack) names
    where names' = names


instance PrettyAnn (Term String String) where

  prettyAnn m = prettyTerm  m names' (-1) (pure . pure . pretty) (pure . pure . pretty) Pretty

  -- where names' = filter ((`notMember` setOf traverse m) . pack) names
    where names' = names



instance Pretty (Term Text Text) where
  -- pretty = unAnnotate . prettyAnn
  pretty tm = runIdentity $ runReaderT (unAnnotate <$> prettyAnn tm) initDI

instance Pretty (Term String String) where
  -- pretty = unAnnotate . prettyAnn
  pretty tm = runIdentity $ runReaderT (unAnnotate <$> prettyAnn tm) initDI