{-# LANGUAGE OverloadedStrings, LambdaCase #-}
module Pretty (Pretty(..)) where

import Data.Text (Text)

import qualified Data.Set as S
import qualified Data.Map as M

import Type
import Data.List (sort)
import TC (initialState, apply, free)

class Pretty a where
  pretty :: a -> Text

instance Pretty PolyT where
  pretty t = case normalize t of
    Forall s t -> "∀" <> foldMap (\(Id v) -> " " <> v) s <> ": " <> pretty t
    Mono t     -> pretty t

instance Pretty MonoT where
  pretty = go . normalize
    where
      go = \case
        TArr tl@TArr{} tr -> "(" <> go tl <> ") → " <> go tr
        TArr tl tr        ->        go tl <>  " → " <> go tr
        TVar (Id i)       -> i
        TCon (Id i)       -> i

class Normalize a where
  normalize :: a -> a

instance Normalize PolyT where
  normalize = \case
      Forall i t -> Forall (S.fromList (snd <$> go t)) (normalize t)
      t@Mono{}   -> normalize t

instance Normalize MonoT where
  normalize t = apply (goS t) t

go :: MonoT -> [(Id, Id)]
go t = zip (sort (S.toList (free t))) (variables initialState)

goS :: MonoT -> Subst
goS = M.fromList . map (\(x,y) -> (x, TVar y)) . go