{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}

-- | Module: Covenant.Util
--
-- Various helpers that don't fit anywhere else.
--
-- @since 1.0.0
module Covenant.Util
  ( pattern NilV,
    pattern ConsV,
    prettyStr,
  )
where

import Data.Kind (Type)
import Data.Text qualified as Text
import Data.Vector.Generic (Vector)
import Data.Vector.Generic qualified as Vector
import Prettyprinter (Pretty (pretty), defaultLayoutOptions, layoutPretty)
import Prettyprinter.Render.Text (renderStrict)

-- | A pattern matching helper for vectors (of all types), corresponding to @[]@
-- for lists. This pattern is bidirectional, which means it can be used just
-- like a data constructor.
--
-- @since 1.0.0
pattern NilV :: forall (a :: Type) (v :: Type -> Type). (Vector v a) => v a
pattern $mNilV :: forall {r} {a} {v :: Type -> Type}.
Vector v a =>
v a -> ((# #) -> r) -> ((# #) -> r) -> r
$bNilV :: forall a (v :: Type -> Type). Vector v a => v a
NilV <- (Vector.uncons -> Nothing)
  where
    NilV = v a
forall (v :: Type -> Type) a. Vector v a => v a
Vector.empty

-- | A pattern matching helper for vectors (of all types), corresponding to @x :
-- xs@-style matches. This is a read-only pattern, which means you can match
-- with it, but not construct; this is done because @cons@ for vectors is
-- inefficient and should thus be used consciously, using appropriate functions.
--
-- Together with 'NilV', 'ConsV' provides an exhaustive match.
--
-- @since 1.0.0
pattern ConsV ::
  forall (a :: Type) (v :: Type -> Type).
  (Vector v a) =>
  a ->
  v a ->
  v a
pattern $mConsV :: forall {r} {a} {v :: Type -> Type}.
Vector v a =>
v a -> (a -> v a -> r) -> ((# #) -> r) -> r
ConsV x xs <- (Vector.uncons -> Just (x, xs))

{-# COMPLETE NilV, ConsV #-}

-- | Shorthand to transform any 'Pretty' into a 'String' using the default
-- layout.
--
-- @since 1.1.0
prettyStr :: forall (a :: Type). (Pretty a) => a -> String
prettyStr :: forall a. Pretty a => a -> String
prettyStr =
  Text -> String
Text.unpack
    (Text -> String) -> (a -> Text) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDocStream Any -> Text
forall ann. SimpleDocStream ann -> Text
renderStrict
    (SimpleDocStream Any -> Text)
-> (a -> SimpleDocStream Any) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc Any -> SimpleDocStream Any
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions
    (Doc Any -> SimpleDocStream Any)
-> (a -> Doc Any) -> a -> SimpleDocStream Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc Any
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty