{-# LANGUAGE OverloadedStrings #-}

module Unison.PrettyPrintEnvDecl
  ( PrettyPrintEnvDecl (..),
    biasTo,
    empty,
    addFallback,
  )
where

import Unison.Name (Name)
import Unison.Prelude hiding (empty)
import Unison.PrettyPrintEnv (PrettyPrintEnv (..))
import Unison.PrettyPrintEnv qualified as PPE

-- A pair of PrettyPrintEnvs:
--   - suffixifiedPPE uses the shortest unique suffix
--   - unsuffixifiedPPE uses the shortest full name
--
-- Generally, we want declarations LHS (the `x` in `x = 23`) to use the
-- unsuffixified names, so the LHS is an accurate description of where in the
-- namespace the definition lives. For everywhere else, we can use the
-- suffixified version.
data PrettyPrintEnvDecl = PrettyPrintEnvDecl
  { PrettyPrintEnvDecl -> PrettyPrintEnv
unsuffixifiedPPE :: PrettyPrintEnv,
    PrettyPrintEnvDecl -> PrettyPrintEnv
suffixifiedPPE :: PrettyPrintEnv
  }
  deriving stock ((forall x. PrettyPrintEnvDecl -> Rep PrettyPrintEnvDecl x)
-> (forall x. Rep PrettyPrintEnvDecl x -> PrettyPrintEnvDecl)
-> Generic PrettyPrintEnvDecl
forall x. Rep PrettyPrintEnvDecl x -> PrettyPrintEnvDecl
forall x. PrettyPrintEnvDecl -> Rep PrettyPrintEnvDecl x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PrettyPrintEnvDecl -> Rep PrettyPrintEnvDecl x
from :: forall x. PrettyPrintEnvDecl -> Rep PrettyPrintEnvDecl x
$cto :: forall x. Rep PrettyPrintEnvDecl x -> PrettyPrintEnvDecl
to :: forall x. Rep PrettyPrintEnvDecl x -> PrettyPrintEnvDecl
Generic, Int -> PrettyPrintEnvDecl -> ShowS
[PrettyPrintEnvDecl] -> ShowS
PrettyPrintEnvDecl -> String
(Int -> PrettyPrintEnvDecl -> ShowS)
-> (PrettyPrintEnvDecl -> String)
-> ([PrettyPrintEnvDecl] -> ShowS)
-> Show PrettyPrintEnvDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PrettyPrintEnvDecl -> ShowS
showsPrec :: Int -> PrettyPrintEnvDecl -> ShowS
$cshow :: PrettyPrintEnvDecl -> String
show :: PrettyPrintEnvDecl -> String
$cshowList :: [PrettyPrintEnvDecl] -> ShowS
showList :: [PrettyPrintEnvDecl] -> ShowS
Show)

-- | Lifts 'biasTo' over a PrettyPrintEnvDecl
biasTo :: [Name] -> PrettyPrintEnvDecl -> PrettyPrintEnvDecl
biasTo :: [Name] -> PrettyPrintEnvDecl -> PrettyPrintEnvDecl
biasTo [Name]
targets PrettyPrintEnvDecl {PrettyPrintEnv
$sel:unsuffixifiedPPE:PrettyPrintEnvDecl :: PrettyPrintEnvDecl -> PrettyPrintEnv
unsuffixifiedPPE :: PrettyPrintEnv
unsuffixifiedPPE, PrettyPrintEnv
$sel:suffixifiedPPE:PrettyPrintEnvDecl :: PrettyPrintEnvDecl -> PrettyPrintEnv
suffixifiedPPE :: PrettyPrintEnv
suffixifiedPPE} =
  PrettyPrintEnvDecl
    { $sel:unsuffixifiedPPE:PrettyPrintEnvDecl :: PrettyPrintEnv
unsuffixifiedPPE = [Name] -> PrettyPrintEnv -> PrettyPrintEnv
PPE.biasTo [Name]
targets PrettyPrintEnv
unsuffixifiedPPE,
      $sel:suffixifiedPPE:PrettyPrintEnvDecl :: PrettyPrintEnv
suffixifiedPPE = [Name] -> PrettyPrintEnv -> PrettyPrintEnv
PPE.biasTo [Name]
targets PrettyPrintEnv
suffixifiedPPE
    }

empty :: PrettyPrintEnvDecl
empty :: PrettyPrintEnvDecl
empty = PrettyPrintEnv -> PrettyPrintEnv -> PrettyPrintEnvDecl
PrettyPrintEnvDecl PrettyPrintEnv
PPE.empty PrettyPrintEnv
PPE.empty

-- | Will use names from the fallback pped if no names were found in the primary.
-- @addFallback primary fallback@
addFallback :: PrettyPrintEnvDecl -> PrettyPrintEnvDecl -> PrettyPrintEnvDecl
addFallback :: PrettyPrintEnvDecl -> PrettyPrintEnvDecl -> PrettyPrintEnvDecl
addFallback (PrettyPrintEnvDecl PrettyPrintEnv
unsuff1 PrettyPrintEnv
suff1) (PrettyPrintEnvDecl PrettyPrintEnv
unsuff2 PrettyPrintEnv
suff2) =
  PrettyPrintEnv -> PrettyPrintEnv -> PrettyPrintEnvDecl
PrettyPrintEnvDecl (PrettyPrintEnv
unsuff1 PrettyPrintEnv -> PrettyPrintEnv -> PrettyPrintEnv
`PPE.addFallback` PrettyPrintEnv
unsuff2) (PrettyPrintEnv
suff1 PrettyPrintEnv -> PrettyPrintEnv -> PrettyPrintEnv
`PPE.addFallback` PrettyPrintEnv
suff2)