module Unison.PatternMatchCoverage.PmGrd where

import Data.Map (Map)
import Data.Map qualified as Map
import Data.Text (Text)
import Data.Text qualified as Text
import Unison.ConstructorReference (ConstructorReference)
import Unison.PatternMatchCoverage.PmLit (PmLit, prettyPmLit)
import Unison.PatternMatchCoverage.Pretty
import Unison.PrettyPrintEnv qualified as PPE
import Unison.Syntax.TypePrinter qualified as TypePrinter
import Unison.Term (Term')
import Unison.Type (Type)
import Unison.Util.Pretty
import Unison.Var (Var)

data
  PmGrd
    vt -- Type variable
    v -- Term variable
    loc -- annotation
  = -- | @PmCon x Con xs ys@ corresponds to the constraint @Con ys <- x@
    PmCon
      -- | Variable
      v
      -- | Constructor
      ConstructorReference
      -- | Constructor argument values and types
      [(v, Type vt loc)]
  | PmEffect
      -- | Variable
      v
      -- | Constructor
      ConstructorReference
      -- | Constructor argument values and types
      [(v, Type vt loc)]
  | PmEffectPure v (v, Type vt loc)
  | PmLit v PmLit
  | PmListHead
      -- | list root
      v
      -- | cons position (0 is head)
      Int
      -- | element variable
      v
      -- | element type
      (Type vt loc)
  | PmListTail
      -- | list root
      v
      -- | snoc position (0 is last)
      Int
      -- | element variable
      v
      -- | element type
      (Type vt loc)
  | -- | The size of the list must fall within this inclusive range
    PmListInterval v Int Int
  | -- | If a guard performs an effect
    PmBang v
  | -- | @PmLet x expr@ corresponds to a @let x = expr@ guard. This actually
    -- /binds/ @x@.
    PmLet v (Term' vt v loc) (Type vt loc)
  | -- | @PmRecordLiteral fields x typ@ corresponds to matching the record in
    -- @x@, binding a variable for each named field. A record has a single
    -- constructor, so this match is irrefutable; fields the pattern doesn't
    -- mention are absent from the map.
    PmRecordLiteral
      -- | a variable and type per matched field
      (Map Text (v, Type vt loc))
      -- | record value
      v
      -- | record type
      (Type vt loc)
  deriving stock (Int -> PmGrd vt v loc -> ShowS
[PmGrd vt v loc] -> ShowS
PmGrd vt v loc -> String
(Int -> PmGrd vt v loc -> ShowS)
-> (PmGrd vt v loc -> String)
-> ([PmGrd vt v loc] -> ShowS)
-> Show (PmGrd vt v loc)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall vt v loc.
(Show v, Show vt) =>
Int -> PmGrd vt v loc -> ShowS
forall vt v loc. (Show v, Show vt) => [PmGrd vt v loc] -> ShowS
forall vt v loc. (Show v, Show vt) => PmGrd vt v loc -> String
$cshowsPrec :: forall vt v loc.
(Show v, Show vt) =>
Int -> PmGrd vt v loc -> ShowS
showsPrec :: Int -> PmGrd vt v loc -> ShowS
$cshow :: forall vt v loc. (Show v, Show vt) => PmGrd vt v loc -> String
show :: PmGrd vt v loc -> String
$cshowList :: forall vt v loc. (Show v, Show vt) => [PmGrd vt v loc] -> ShowS
showList :: [PmGrd vt v loc] -> ShowS
Show)

prettyPmGrd :: (Var vt, Var v) => PPE.PrettyPrintEnv -> PmGrd vt v loc -> Pretty ColorText
prettyPmGrd :: forall vt v loc.
(Var vt, Var v) =>
PrettyPrintEnv -> PmGrd vt v loc -> Pretty ColorText
prettyPmGrd PrettyPrintEnv
ppe = \case
  PmCon v
var ConstructorReference
con [(v, Type vt loc)]
convars ->
    let xs :: [Pretty ColorText]
xs = ConstructorReference -> Pretty ColorText
pc ConstructorReference
con Pretty ColorText -> [Pretty ColorText] -> [Pretty ColorText]
forall a. a -> [a] -> [a]
: ((v, Type vt loc) -> Pretty ColorText)
-> [(v, Type vt loc)] -> [Pretty ColorText]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(v
trm, Type vt loc
typ) -> Pretty ColorText -> [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
sep Pretty ColorText
" " [Pretty ColorText
"(" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> v -> Pretty ColorText
forall v. Var v => v -> Pretty ColorText
prettyVar v
trm, Pretty ColorText
":", PrettyPrintEnv -> Type vt loc -> Pretty ColorText
forall v a. Var v => PrettyPrintEnv -> Type v a -> Pretty ColorText
TypePrinter.pretty PrettyPrintEnv
ppe Type vt loc
typ Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
")"]) [(v, Type vt loc)]
convars [Pretty ColorText] -> [Pretty ColorText] -> [Pretty ColorText]
forall a. [a] -> [a] -> [a]
++ [Pretty ColorText
"<-", v -> Pretty ColorText
forall v. Var v => v -> Pretty ColorText
prettyVar v
var]
     in Pretty ColorText -> [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
sep Pretty ColorText
" " [Pretty ColorText]
xs
  PmEffect v
var ConstructorReference
con [(v, Type vt loc)]
convars ->
    let xs :: [Pretty ColorText]
xs = ConstructorReference -> Pretty ColorText
pc ConstructorReference
con Pretty ColorText -> [Pretty ColorText] -> [Pretty ColorText]
forall a. a -> [a] -> [a]
: ((v, Type vt loc) -> Pretty ColorText)
-> [(v, Type vt loc)] -> [Pretty ColorText]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(v
trm, Type vt loc
typ) -> Pretty ColorText -> [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
sep Pretty ColorText
" " [Pretty ColorText
"(" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> v -> Pretty ColorText
forall v. Var v => v -> Pretty ColorText
prettyVar v
trm, Pretty ColorText
":", PrettyPrintEnv -> Type vt loc -> Pretty ColorText
forall v a. Var v => PrettyPrintEnv -> Type v a -> Pretty ColorText
TypePrinter.pretty PrettyPrintEnv
ppe Type vt loc
typ Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
")"]) [(v, Type vt loc)]
convars [Pretty ColorText] -> [Pretty ColorText] -> [Pretty ColorText]
forall a. [a] -> [a] -> [a]
++ [Pretty ColorText
"<-", v -> Pretty ColorText
forall v. Var v => v -> Pretty ColorText
prettyVar v
var]
     in Pretty ColorText -> [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
sep Pretty ColorText
" " [Pretty ColorText]
xs
  PmEffectPure v
v (v
rv, Type vt loc
rt) -> Pretty ColorText -> [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
sep Pretty ColorText
" " [Pretty ColorText
"pure", Pretty ColorText
"(" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> v -> Pretty ColorText
forall v. Var v => v -> Pretty ColorText
prettyVar v
rv, Pretty ColorText
":", PrettyPrintEnv -> Type vt loc -> Pretty ColorText
forall v a. Var v => PrettyPrintEnv -> Type v a -> Pretty ColorText
TypePrinter.pretty PrettyPrintEnv
ppe Type vt loc
rt Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
")", Pretty ColorText
"<-", v -> Pretty ColorText
forall v. Var v => v -> Pretty ColorText
prettyVar v
v]
  PmListHead v
var Int
n v
el Type vt loc
_ -> Pretty ColorText -> [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
sep Pretty ColorText
" " [Pretty ColorText
"Cons", String -> Pretty ColorText
forall s. IsString s => String -> Pretty s
string (Int -> String
forall a. Show a => a -> String
show Int
n), v -> Pretty ColorText
forall v. Var v => v -> Pretty ColorText
prettyVar v
el, Pretty ColorText
"<-", v -> Pretty ColorText
forall v. Var v => v -> Pretty ColorText
prettyVar v
var]
  PmListTail v
var Int
n v
el Type vt loc
_ -> Pretty ColorText -> [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
sep Pretty ColorText
" " [Pretty ColorText
"Snoc", String -> Pretty ColorText
forall s. IsString s => String -> Pretty s
string (Int -> String
forall a. Show a => a -> String
show Int
n), v -> Pretty ColorText
forall v. Var v => v -> Pretty ColorText
prettyVar v
el, Pretty ColorText
"<-", v -> Pretty ColorText
forall v. Var v => v -> Pretty ColorText
prettyVar v
var]
  PmListInterval v
var Int
minLen Int
maxLen -> Pretty ColorText -> [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
sep Pretty ColorText
" " [Pretty ColorText
"Interval", String -> Pretty ColorText
forall s. IsString s => String -> Pretty s
string ((Int, Int) -> String
forall a. Show a => a -> String
show (Int
minLen, Int
maxLen)), Pretty ColorText
"<-", v -> Pretty ColorText
forall v. Var v => v -> Pretty ColorText
prettyVar v
var]
  PmLit v
var PmLit
lit -> Pretty ColorText -> [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
sep Pretty ColorText
" " [PmLit -> Pretty ColorText
forall s. IsString s => PmLit -> Pretty s
prettyPmLit PmLit
lit, Pretty ColorText
"<-", v -> Pretty ColorText
forall v. Var v => v -> Pretty ColorText
prettyVar v
var]
  PmBang v
v -> Pretty ColorText
"!" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> v -> Pretty ColorText
forall v. Var v => v -> Pretty ColorText
prettyVar v
v
  PmLet v
v Term' vt v loc
_expr Type vt loc
_ -> Pretty ColorText -> [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
sep Pretty ColorText
" " [Pretty ColorText
"let", v -> Pretty ColorText
forall v. Var v => v -> Pretty ColorText
prettyVar v
v, Pretty ColorText
"=", Pretty ColorText
"<expr>"]
  PmRecordLiteral Map Text (v, Type vt loc)
fields v
v Type vt loc
_ ->
    let fieldStrs :: [Pretty ColorText]
fieldStrs = ((Text, (v, Type vt loc)) -> Pretty ColorText)
-> [(Text, (v, Type vt loc))] -> [Pretty ColorText]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Text
k, (v
fv, Type vt loc
_t)) -> Pretty ColorText -> [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
sep Pretty ColorText
" " [String -> Pretty ColorText
forall s. IsString s => String -> Pretty s
string (Text -> String
Text.unpack Text
k), Pretty ColorText
":", v -> Pretty ColorText
forall v. Var v => v -> Pretty ColorText
prettyVar v
fv]) (Map Text (v, Type vt loc) -> [(Text, (v, Type vt loc))]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map Text (v, Type vt loc)
fields)
     in Pretty ColorText -> [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
sep Pretty ColorText
" " [Pretty ColorText
"{" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
sep Pretty ColorText
", " [Pretty ColorText]
fieldStrs Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"}", Pretty ColorText
"<-", v -> Pretty ColorText
forall v. Var v => v -> Pretty ColorText
prettyVar v
v]
  where
    pc :: ConstructorReference -> Pretty ColorText
pc = PrettyPrintEnv -> ConstructorReference -> Pretty ColorText
prettyConstructorReference PrettyPrintEnv
ppe