{-# LANGUAGE InstanceSigs #-}
module Pattern.Core
  ( -- * Pattern Type
    Pattern(..)
    -- * Construction Functions
  , pattern
  , point
  , fromList
    -- * Query Functions
  , length
  , size
  , depth
  , values
    -- * Predicate Functions
  , anyValue
  , allValues
  , filterPatterns
  , findPattern
  , findAllPatterns
  , matches
  , contains
    -- * Foldable/Traversable Extras
  , flatten
  , toTuple
    -- * Context/Comonad Functions
  , extract
  , duplicate
  , extend
  , depthAt
  , sizeAt
  , indicesAt
    -- * Paramorphism Functions
  , para
  ) where

import Prelude hiding (length)
import qualified Prelude
import Data.Foldable (toList)
import Data.Semigroup (Semigroup(..), sconcat, stimes)
import Data.Monoid ()
import Data.Hashable (Hashable(..))
import Control.Comonad (Comonad(..))
import Data.List.NonEmpty (NonEmpty(..))

-- | Core Pattern data type and basic operations.
--
-- This module defines the fundamental Pattern type as a recursive structure
-- that can represent graph elements and sequences.
--
-- == Conceptual Model: Patterns as Decorated Sequences
--
-- Conceptually, a Pattern is a decorated sequence: the elements form the pattern
-- itself, and the value provides decoration about that pattern.
-- For example, the pattern "A B B A" with decoration "Enclosed rhyme" represents
-- a specific sequence pattern (A B B A) that is classified as an "Enclosed rhyme".
-- The Pattern type represents such decorated sequences where:
--
-- * @elements@ - The pattern itself, represented as a sequence of elements
-- * @value@ - Decoration about what kind of pattern it is
--
-- The elements ARE the pattern; they are not subordinate to the value.
-- While implemented using a recursive tree structure, the primary semantic is that
-- elements form the pattern sequence itself. Each element in the sequence is itself
-- a Pattern, enabling arbitrarily nested and complex pattern structures.
--
-- == Implementation: Recursive Tree Structure
--
-- The Pattern type is implemented as a recursive tree structure, but this is purely
-- an implementation detail. The relationship between the sequence conceptual model
-- and tree implementation is:
--
-- **Primary Semantic (Conceptual)**: Patterns are decorated sequences where elements
-- form the pattern itself. The sequence order is essential to the pattern.
--
-- **Implementation Detail**: The tree structure is how sequences are represented in
-- memory. Each tree node stores a decoration (value) and contains the pattern elements
-- as a list, enabling recursive nesting.
--
-- **Relationship**: The tree implementation supports sequence semantics:
--
-- * The @elements@ field IS the pattern - it contains the sequence that defines the pattern
-- * The @value@ field provides decoration about what kind of pattern it is
-- * Tree traversal provides access to sequence elements in order
-- * The recursive structure enables patterns to contain patterns containing patterns, etc.
--
-- Conceptually, developers should think of patterns as decorated sequences where elements
-- form the pattern itself. The tree structure is an implementation detail that supports
-- sequence operations (ordering, length, access by position).
--
-- This recursive implementation enables:
--
-- * Atomic patterns: Patterns with no elements (@elements == []@), representing empty sequences. Atomic patterns are the fundamental building blocks from which all other patterns are constructed.
-- * Patterns with elements: Patterns containing one or more pattern elements in sequence
-- * Arbitrary nesting: Patterns can contain patterns containing patterns, enabling
--   deeply nested pattern structures
--
-- == Values and Pattern Decoration
--
-- Each Pattern instance decorates a sequence of elements with a value:
--
-- * The @value@ field stores decoration about what kind of pattern it is. This can be any type @v@,
--   such as a string identifier, an integer, a custom data type, etc.
-- * The @value@ is decoration about the pattern sequence itself, not part of the pattern.
-- * All patterns in a structure must share the same value type @v@ (enforced by the type system).
--
-- For example, an atomic pattern might have @value = "Person"@
-- (decoration indicating the pattern type) and @elements = []@ (empty sequence pattern).
-- A pattern with two elements might have @value = "knows"@ (the pattern type decoration)
-- and @elements = [atomA, atomB]@ (the pattern itself - a sequence of two atomic patterns).
--
-- == Elements and Pattern Structure
--
-- The @elements@ field IS the pattern - it contains the sequence that defines the pattern:
--
-- * An empty sequence (@elements == []@) represents a pattern with no elements (empty sequence)
-- * A non-empty sequence represents a pattern containing one or more pattern elements
-- * The elements are ordered and maintain their sequence order - this order is essential to the pattern
-- * Each element in the sequence is itself a Pattern, enabling recursive nesting
--
-- The pattern structure enables compositional patterns:
--
-- * A pattern can include other patterns as its elements
-- * Those element patterns can themselves include patterns
-- * This enables arbitrary depth nesting while maintaining the pattern sequence semantic
--
-- For example, a pattern might have @elements = [atom1, atom2, pair1]@
-- where each element is a Pattern. A pair pattern itself might have
-- @elements = [atomA, atomB]@, creating a nested pattern structure.
--
-- == Type Safety and Type Parameter @v@
--
-- The Pattern type is parameterized over value type @v@:
--
-- * @Pattern v@ allows patterns to store values of any type @v@
-- * All patterns in a structure must share the same value type @v@
-- * This type consistency is enforced by Haskell's type system
-- * The type parameter ensures type safety when working with patterns
--
-- For example:
--
-- * @Pattern String@ - patterns storing string values
-- * @Pattern Int@ - patterns storing integer values
-- * @Pattern Person@ - patterns storing custom Person values
--
-- Type consistency means that if you have a @Pattern String@, all patterns in
-- its @elements@ list must also be @Pattern String@. This prevents mixing
-- different value types within a single pattern structure.
--
-- == Mathematical Foundation
--
-- Patterns form the foundation for category-theoretic graph representations.
-- The recursive structure enables functor instances and supports various graph
-- interpretations through categorical views. The sequence semantic aligns with
-- categorical composition and transformation operations.
--
-- The Pattern type has a Functor instance that enables value transformation while
-- preserving pattern structure. This supports functional transformations and type
-- conversions essential for pattern manipulation. See the Functor instance documentation
-- below for details on structure preservation and functor laws.
--
-- The Pattern type has a Foldable instance that enables value aggregation over pattern
-- structures. This supports operations like summing values, concatenating strings, counting
-- elements, and computing statistics without manually traversing the pattern tree. The instance
-- provides @foldr@ for right-associative folding, @foldl@ for left-associative folding,
-- @foldMap@ for monoid-based aggregation, and @toList@ for extracting all values as a flat list.
-- The module also provides @flatten@ as an explicit function for extracting all values as a flat
-- list, equivalent to @toList@. See the Foldable instance documentation below for details on
-- value aggregation and folding operations.
--
-- The Pattern type has a Traversable instance that enables effectful traversal over pattern
-- structures while preserving pattern structure. This supports operations like validation,
-- state threading, IO operations, and error handling over pattern values. The instance provides
-- @traverse@ for applying effectful functions to all values and @sequenceA@ for sequencing
-- applicative effects. See the Traversable instance documentation below for details on effectful
-- traversal and structure preservation.
--
-- The Pattern type has an Ord instance that provides lexicographic ordering for patterns based
-- on their structure. Patterns are ordered by comparing their value first, then their elements
-- recursively. This ordering is consistent with the Eq instance and enables patterns to be
-- used as keys in Data.Map and elements in Data.Set. The Ord instance requires that the value
-- type @v@ has an Ord instance. See the Ord instance documentation below for details on
-- ordering rules and consistency with equality.
--
-- The Pattern type has a Semigroup instance that enables combining patterns by concatenating
-- their elements and combining their values using the value type's Semigroup instance. This
-- enables incremental pattern construction using standard Haskell combinators like `<>`,
-- `sconcat`, and `stimes`. The instance preserves the decorated sequence model where elements
-- form the pattern and values provide decoration. The Semigroup instance requires that the
-- value type @v@ has a Semigroup instance. See the Semigroup instance documentation below
-- for details on combination semantics and associativity.
--
-- The Pattern type has a Monoid instance that extends the Semigroup instance by providing
-- an identity element (`mempty`). The identity pattern has `mempty` value (from value type's
-- Monoid) and empty elements list, enabling identity-based operations and standard Monoid
-- combinators (e.g., `mconcat`) while preserving the decorated sequence model. The Monoid
-- instance requires that the value type @v@ has a Monoid instance. See the Monoid instance
-- documentation below for details on identity semantics and laws.
--
-- The Pattern type has a Hashable instance that enables using patterns as keys in `HashMap`
-- and elements in `HashSet` for efficient hash-based lookups and deduplication. The instance
-- uses structure-preserving hashing based on value and elements recursively, ensuring that
-- equal patterns (according to `Eq`) produce the same hash value while providing good
-- distribution. The Hashable instance requires that the value type @v@ has a Hashable
-- instance. See the Hashable instance documentation below for details on hash semantics and
-- consistency with equality.
--
-- The Pattern type has a Comonad instance that enables context-aware computations where
-- functions have access to the full structural context (parent, siblings, depth, indices) around
-- each value, not just the value itself. This extends beyond Foldable (which only provides
-- values) to enable computations that consider structural context, depth, position, and
-- relationships between pattern elements. The instance provides @extract@ (extract decoration
-- value), @duplicate@ (create pattern of contexts), and @extend@ (context-aware transformation),
-- satisfying all Comonad laws (extract-extend, extend-extract, extend composition). See the
-- Comonad instance documentation below for details on context-aware computation and relationship
-- to zippers.
--
-- The Pattern type provides query functions for introspecting pattern structure:
--
-- * @length@ - Returns the number of direct elements in a pattern's sequence (O(1))
-- * @size@ - Returns the total number of nodes in a pattern structure, including all nested patterns (O(n))
-- * @depth@ - Returns the maximum nesting depth of a pattern structure (O(n))
-- * @values@ - Extracts all values from a pattern structure as a flat list (O(n))
-- * @value@ - Field accessor for accessing a pattern's decoration value (O(1))
-- * @anyValue@ - Checks if any value in a pattern satisfies a predicate (O(n))
-- * @allValues@ - Checks if all values in a pattern satisfy a predicate (O(n))
-- * @filterPatterns@ - Filters all subpatterns (including root) matching a pattern predicate (O(n))
-- * @findPattern@ - Finds the first subpattern (including root) matching a pattern predicate (O(n))
-- * @findAllPatterns@ - Finds all subpatterns (including root) matching a pattern predicate (O(n))
-- * @matches@ - Checks if two patterns match structurally (O(n))
-- * @contains@ - Checks if a pattern contains a subpattern (O(n))
--
-- These query functions enable pattern introspection, validation, and analysis operations.
-- See individual function documentation for details on usage and performance characteristics.
--
-- == Examples
--
-- Atomic pattern:
--
-- >>> atom = point "atom1"
-- >>> value atom
-- "atom1"
-- >>> elements atom
-- []
--
-- Pattern with elements:
--
-- >>> elem1 = point "elem1"
-- >>> elem2 = point "elem2"
-- >>> p = pattern "pattern" [elem1, elem2]
-- >>> value p
-- "pattern"
-- >>> length (elements p)
-- 2
-- >>> map value (elements p)
-- ["elem1","elem2"]
--
-- Nested pattern:
--
-- >>> level3 = point "level3"
-- >>> level2 = pattern "level2" [level3]
-- >>> level1 = pattern "level1" [level2]
-- >>> nested = pattern "root" [level1]
-- >>> value nested
-- "root"
-- >>> value (head (elements nested))
-- "level1"
data Pattern v = Pattern
  { forall v. Pattern v -> v
value    :: v          -- ^ Decoration about what kind of pattern it is
  , forall v. Pattern v -> [Pattern v]
elements :: [Pattern v] -- ^ The pattern itself, represented as a sequence of elements
  }
  deriving (Pattern v -> Pattern v -> Bool
(Pattern v -> Pattern v -> Bool)
-> (Pattern v -> Pattern v -> Bool) -> Eq (Pattern v)
forall v. Eq v => Pattern v -> Pattern v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall v. Eq v => Pattern v -> Pattern v -> Bool
== :: Pattern v -> Pattern v -> Bool
$c/= :: forall v. Eq v => Pattern v -> Pattern v -> Bool
/= :: Pattern v -> Pattern v -> Bool
Eq, Int -> Pattern v -> ShowS
[Pattern v] -> ShowS
Pattern v -> String
(Int -> Pattern v -> ShowS)
-> (Pattern v -> String)
-> ([Pattern v] -> ShowS)
-> Show (Pattern v)
forall v. Show v => Int -> Pattern v -> ShowS
forall v. Show v => [Pattern v] -> ShowS
forall v. Show v => Pattern v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall v. Show v => Int -> Pattern v -> ShowS
showsPrec :: Int -> Pattern v -> ShowS
$cshow :: forall v. Show v => Pattern v -> String
show :: Pattern v -> String
$cshowList :: forall v. Show v => [Pattern v] -> ShowS
showList :: [Pattern v] -> ShowS
Show)


-- | 'Ord' instance for 'Pattern'.
--
-- Provides lexicographic ordering for patterns based on their structure.
-- Patterns are compared by their value first, then by their elements recursively.
-- This ordering is consistent with the 'Eq' instance: if two patterns are equal,
-- they compare as 'EQ'.
--
-- The ordering rules are:
-- 1. Compare values: if values differ, their order determines the pattern order.
-- 2. If values are equal, compare elements lists lexicographically.
--
-- This instance enables patterns to be used as keys in 'Data.Map', elements in 'Data.Set',
-- and anywhere else that requires total ordering.
--
-- Requires the value type @v@ to be an instance of 'Ord'.
--
-- === Examples
--
-- Comparing atomic patterns:
--
-- >>> compare (point "a") (point "b")
-- LT
-- >>> compare (point "b") (point "a")
-- GT
--
-- Comparing patterns with elements (value takes precedence):
--
-- >>> p1 = pattern "root" [point "a"]
-- >>> p2 = pattern "root" [point "b"]
-- >>> compare p1 p2
-- LT
--
-- Comparing identical patterns:
--
-- >>> p1 = pattern "root" [point "a", point "b"]
-- >>> p2 = pattern "root" [point "a", point "b"]
-- >>> compare p1 p2
-- EQ
--
-- Deep structural comparison:
--
-- >>> inner1 = point "inner1"
-- >>> inner2 = point "inner2"
-- >>> outer1 = pattern "outer" [pattern "middle" [inner1]]
-- >>> outer2 = pattern "outer" [pattern "middle" [inner2]]
-- >>> compare outer1 outer2
-- LT
--
-- Using standard operators:
--
-- >>> (point "a") < (point "b")
-- True
-- >>> (point "a") <= (point "b")
-- True
-- >>> (point "b") > (point "a")
-- True
--
-- Min and Max:
--
-- >>> min (point "a") (point "b")
-- Pattern "a" []
-- >>> max (point "a") (point "b")
-- Pattern "b" []
instance Ord v => Ord (Pattern v) where
  compare :: Pattern v -> Pattern v -> Ordering
compare (Pattern v
v1 [Pattern v]
es1) (Pattern v
v2 [Pattern v]
es2) =
    case v -> v -> Ordering
forall a. Ord a => a -> a -> Ordering
compare v
v1 v
v2 of
      Ordering
EQ -> [Pattern v] -> [Pattern v] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare [Pattern v]
es1 [Pattern v]
es2
      Ordering
other -> Ordering
other

-- | 'Semigroup' instance for 'Pattern'.
--
-- Enables combining two patterns into a new pattern.
--
-- Semantics:
-- * Values are combined using the value type's 'Semigroup' instance (`<>`).
-- * Elements are concatenated using list concatenation (`++`).
--
-- This aligns with the decorated sequence model:
-- * The pattern sequence becomes the concatenation of the two sequences.
-- * The decoration becomes the combination of the two decorations.
--
-- Requires the value type @v@ to be an instance of 'Semigroup'.
--
-- === Examples
--
-- Combining atomic patterns:
--
-- >>> p1 = point "hello"
-- >>> p2 = point "world"
-- >>> p1 <> p2
-- Pattern "helloworld" []
--
-- Combining patterns with elements:
--
-- >>> elem1 = point "a"
-- >>> elem2 = point "b"
-- >>> p1 = pattern "prefix" [elem1, elem2]
-- >>> p2 = pattern "suffix" [point "c"]
-- >>> p1 <> p2
-- Pattern "prefixsuffix" [Pattern "a" [],Pattern "b" [],Pattern "c" []]
--
-- Using Sum semigroup:
--
-- >>> import Data.Monoid (Sum(..))
-- >>> p1 = pattern (Sum 5)
-- >>> p2 = pattern (Sum 3)
-- >>> getSum (value (p1 <> p2))
-- 8
--
-- Using Product semigroup:
--
-- >>> import Data.Monoid (Product(..))
-- >>> p1 = pattern (Product 5)
-- >>> p2 = pattern (Product 3)
-- >>> getProduct (value (p1 <> p2))
-- 15
--
-- Using sconcat for list of non-empty patterns:
--
-- >>> sconcat (point "a" :| [point "b", point "c"])
-- Pattern "abc" []
--
-- Using stimes for repetition:
--
-- >>> stimes 3 (pattern "x" [point "y"])
-- Pattern "xxx" [Pattern "y" [],Pattern "y" [],Pattern "y" []]
--
-- Complex combination:
--
-- >>> inner1 = point "inner1"
-- >>> inner2 = point "inner2"
-- >>> middle1 = pattern "middle1" [inner1]
-- >>> middle2 = pattern "middle2" [inner2]
-- >>> p1 = pattern "root1" [middle1]
-- >>> p2 = pattern "root2" [middle2]
-- >>> result = p1 <> p2
-- >>> value result
-- "root1root2"
-- >>> length (elements result)
-- 2
instance Semigroup v => Semigroup (Pattern v) where
  (Pattern v
v1 [Pattern v]
es1) <> :: Pattern v -> Pattern v -> Pattern v
<> (Pattern v
v2 [Pattern v]
es2) = v -> [Pattern v] -> Pattern v
forall v. v -> [Pattern v] -> Pattern v
Pattern (v
v1 v -> v -> v
forall a. Semigroup a => a -> a -> a
<> v
v2) ([Pattern v]
es1 [Pattern v] -> [Pattern v] -> [Pattern v]
forall a. [a] -> [a] -> [a]
++ [Pattern v]
es2)
  
  -- | Optimized sconcat implementation
  sconcat :: NonEmpty (Pattern v) -> Pattern v
  sconcat :: NonEmpty (Pattern v) -> Pattern v
sconcat NonEmpty (Pattern v)
ps = v -> [Pattern v] -> Pattern v
forall v. v -> [Pattern v] -> Pattern v
Pattern 
    (NonEmpty v -> v
forall a. Semigroup a => NonEmpty a -> a
sconcat ((Pattern v -> v) -> NonEmpty (Pattern v) -> NonEmpty v
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pattern v -> v
forall v. Pattern v -> v
value NonEmpty (Pattern v)
ps)) 
    ((Pattern v -> [Pattern v]) -> [Pattern v] -> [Pattern v]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Pattern v -> [Pattern v]
forall v. Pattern v -> [Pattern v]
elements (NonEmpty (Pattern v) -> [Pattern v]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Pattern v)
ps))

  -- | Optimized stimes implementation
  stimes :: Integral b => b -> Pattern v -> Pattern v
  stimes :: forall b. Integral b => b -> Pattern v -> Pattern v
stimes b
n (Pattern v
v [Pattern v]
es) = v -> [Pattern v] -> Pattern v
forall v. v -> [Pattern v] -> Pattern v
Pattern
    (b -> v -> v
forall b. Integral b => b -> v -> v
forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes b
n v
v)
    ([[Pattern v]] -> [Pattern v]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> [Pattern v] -> [[Pattern v]]
forall a. Int -> a -> [a]
replicate (b -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
n) [Pattern v]
es))

-- | 'Monoid' instance for 'Pattern'.
--
-- Extends the 'Semigroup' instance by providing an identity element ('mempty').
--
-- Semantics:
-- * 'mempty' is a pattern with 'mempty' value and empty elements list.
-- * 'mappend' is equivalent to '<>'.
-- * 'mconcat' combines a list of patterns (optimized).
--
-- Identity Laws:
-- * `mempty <> p = p`
-- * `p <> mempty = p`
--
-- Requires the value type @v@ to be an instance of 'Monoid'.
--
-- === Examples
--
-- Identity element:
--
-- >>> mempty :: Pattern String
-- Pattern "" []
-- >>> mempty :: Pattern (Sum Int)
-- Pattern (Sum {getSum = 0}) []
--
-- Identity laws:
--
-- >>> mempty <> point "test"
-- Pattern "test" []
-- >>> point "test" <> mempty
-- Pattern "test" []
--
-- Combining list of patterns:
--
-- >>> mconcat [point "a", point "b", point "c"]
-- Pattern "abc" []
--
-- Empty list returns mempty:
--
-- >>> mconcat [] :: Pattern String
-- Pattern "" []
instance Monoid v => Monoid (Pattern v) where
  mempty :: Pattern v
mempty = v -> [Pattern v] -> Pattern v
forall v. v -> [Pattern v] -> Pattern v
Pattern v
forall a. Monoid a => a
mempty []
  mappend :: Pattern v -> Pattern v -> Pattern v
mappend = Pattern v -> Pattern v -> Pattern v
forall a. Semigroup a => a -> a -> a
(<>)
  
  -- | Optimized mconcat implementation
  mconcat :: [Pattern v] -> Pattern v
  mconcat :: [Pattern v] -> Pattern v
mconcat [Pattern v]
ps = v -> [Pattern v] -> Pattern v
forall v. v -> [Pattern v] -> Pattern v
Pattern
    ([v] -> v
forall a. Monoid a => [a] -> a
mconcat ((Pattern v -> v) -> [Pattern v] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map Pattern v -> v
forall v. Pattern v -> v
value [Pattern v]
ps))
    ((Pattern v -> [Pattern v]) -> [Pattern v] -> [Pattern v]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Pattern v -> [Pattern v]
forall v. Pattern v -> [Pattern v]
elements [Pattern v]
ps)

-- | 'Hashable' instance for 'Pattern'.
--
-- Enables using patterns as keys in 'Data.HashMap' and elements in 'Data.HashSet'.
-- Patterns are hashed based on their structure (value and elements recursively).
--
-- Semantics:
-- * Hashing combines the hash of the value and the hash of the elements list.
-- * Structural equality implies hash equality (if p1 == p2, then hash p1 == hash p2).
-- * Different structures with same flattened values produce different hashes.
--
-- Requires the value type @v@ to be an instance of 'Hashable'.
--
-- === Examples
--
-- Hashing atomic patterns:
--
-- >>> hash (point "a" :: Pattern String)
-- ...
-- >>> hash (point "b" :: Pattern String)
-- ...
--
-- Hashing patterns with elements:
--
-- >>> hash (pattern "root" [point "a", point "b"] :: Pattern String)
-- ...
--
-- Hash consistency with equality:
--
-- >>> let p1 = point "test" :: Pattern String
-- >>> let p2 = point "test" :: Pattern String
-- >>> p1 == p2
-- True
-- >>> hash p1 == hash p2
-- True
--
-- Structure distinguishes hash:
--
-- >>> let p1 = pattern "a" [point "b", point "c"] :: Pattern String
-- >>> let p2 = pattern "a" [pattern "b" [point "c"]] :: Pattern String
-- >>> hash p1 /= hash p2
-- True
--
-- Using in HashMap:
--
-- >>> import qualified Data.HashMap.Strict as HashMap
-- >>> let m = HashMap.fromList [(point "a", 1), (point "b", 2)] :: HashMap (Pattern String) Int
-- >>> HashMap.lookup (point "a") m
-- Just 1
--
-- Using in HashSet:
--
-- >>> import qualified Data.HashSet as HashSet
-- >>> let s = HashSet.fromList [point "a", point "b", point "c"] :: HashSet (Pattern String)
-- >>> HashSet.member (point "a") s
-- True
instance Hashable v => Hashable (Pattern v) where
  hashWithSalt :: Int -> Pattern v -> Int
hashWithSalt Int
salt (Pattern v
v [Pattern v]
es) = 
    Int
salt Int -> v -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` v
v Int -> [Pattern v] -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` [Pattern v]
es

-- | 'Functor' instance for 'Pattern'.
--
-- Maps a function over the values decorating the pattern structure.
-- Preserves the pattern structure (number and order of elements).
--
-- Laws:
-- * Identity: `fmap id == id`
-- * Composition: `fmap (f . g) == fmap f . fmap g`
--
-- === Examples
--
-- >>> atom = point "test"
-- >>> fmap (map toUpper) atom
-- Pattern "TEST" []
--
-- >>> elem1 = point "hello"
-- >>> elem2 = point "world"
-- >>> p = pattern "greeting" [elem1, elem2]
-- >>> fmap (map toUpper) p
-- Pattern "GREETING" [Pattern "HELLO" [],Pattern "WORLD" []]
--
-- >>> elem1 = point 5
-- >>> elem2 = point 10
-- >>> p = pattern 20 [elem1, elem2]
-- >>> fmap (* 2) p
-- Pattern 40 [Pattern 10 [],Pattern 20 []]
--
-- >>> inner = point "inner"
-- >>> middle = pattern "middle" [inner]
-- >>> outer = pattern "outer" [middle]
-- >>> p = pattern "root" [outer]
-- >>> fmap (map toUpper) p
-- Pattern "ROOT" [Pattern "OUTER" [Pattern "MIDDLE" [Pattern "INNER" []]]]
--
-- >>> level4 = point "level4"
-- >>> level3 = pattern "level3" [level4]
-- >>> level2 = pattern "level2" [level3]
-- >>> level1 = pattern "level1" [level2]
-- >>> p = pattern "root" [level1]
-- >>> fmap (map toUpper) p
-- Pattern "ROOT" [Pattern "LEVEL1" [Pattern "LEVEL2" [Pattern "LEVEL3" [Pattern "LEVEL4" []]]]]
--
-- >>> branch1 = pattern "b1" [point "b1leaf"]
-- >>> branch2 = pattern "b2" [pattern "b2mid" [point "b2leaf"]]
-- >>> branch3 = point "b3"
-- >>> p = pattern "root" [branch1, branch2, branch3]
-- >>> fmap (map toUpper) p
-- Pattern "ROOT" [Pattern "B1" [Pattern "B1LEAF" []],Pattern "B2" [Pattern "B2MID" [Pattern "B2LEAF" []]],Pattern "B3" []]
--
-- >>> elem1 = point "5"
-- >>> elem2 = point "10"
-- >>> p = pattern "20" [elem1, elem2]
-- >>> fmap (read :: String -> Int) p
-- Pattern 20 [Pattern 5 [],Pattern 10 []]
--
-- >>> atom = Pattern { value = "atom", elements = [] }
-- >>> fmap (map toUpper) atom
-- Pattern "ATOM" []
--
-- >>> elem = Pattern { value = "elem", elements = [] }
-- >>> pattern = Pattern { value = "singular", elements = [elem] }
-- >>> fmap (map toUpper) pattern
-- Pattern "SINGULAR" [Pattern "ELEM" []]
--
-- >>> elem1 = Pattern { value = "first", elements = [] }
-- >>> elem2 = Pattern { value = "second", elements = [] }
-- >>> pattern = Pattern { value = "pair", elements = [elem1, elem2] }
-- >>> fmap (map toUpper) pattern
-- Pattern "PAIR" [Pattern "FIRST" [],Pattern "SECOND" []]
--
-- >>> elems = [Pattern { value = "a", elements = [] }, Pattern { value = "b", elements = [] }, Pattern { value = "c", elements = [] }]
-- >>> pattern = Pattern { value = "extended", elements = elems }
-- >>> fmap (map toUpper) pattern
-- Pattern "EXTENDED" [Pattern "A" [],Pattern "B" [],Pattern "C" []]
--
-- >>> elem1 = Pattern { value = 5, elements = [] }
-- >>> elem2 = Pattern { value = 10, elements = [] }
-- >>> pattern = Pattern { value = 20, elements = [elem1, elem2] }
-- >>> fmap show pattern
-- Pattern "20" [Pattern "5" [],Pattern "10" []]
instance Functor Pattern where
  fmap :: forall a b. (a -> b) -> Pattern a -> Pattern b
fmap a -> b
f (Pattern a
v [Pattern a]
es) = b -> [Pattern b] -> Pattern b
forall v. v -> [Pattern v] -> Pattern v
Pattern (a -> b
f a
v) ((Pattern a -> Pattern b) -> [Pattern a] -> [Pattern b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> Pattern a -> Pattern b
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [Pattern a]
es)

-- | 'Applicative' instance for 'Pattern'.
--
-- Enables applying functions stored in patterns to values stored in patterns.
--
-- Semantics:
-- * 'pure' creates an atomic pattern with the given value (empty elements list).
-- * '<*>' applies the function pattern to the value pattern:
--   - The root function is applied to the root value.
--   - Each function element is applied to the entire value pattern.
--   - The root function is applied to each value element.
--   - This ensures all Applicative laws hold, particularly: `pure f <*> x == fmap f x`
--
-- Laws (all satisfied):
-- * Identity: `pure id <*> v == v`
-- * Composition: `pure (.) <*> u <*> v <*> w == u <*> (v <*> w)`
-- * Homomorphism: `pure f <*> pure x == pure (f x)`
-- * Interchange: `u <*> pure y == pure ($ y) <*> u`
-- * Functor Consistency: `fmap f x == pure f <*> x`
--
-- === Examples
--
-- Pure creates atomic pattern:
--
-- >>> pure 5
-- Pattern 5 []
--
-- Applying function pattern to value pattern:
--
-- >>> let f = pure (+1)
-- >>> let x = pure 5
-- >>> f <*> x
-- Pattern 6 []
--
-- Functor consistency (pure f <*> x == fmap f x):
--
-- >>> let f = (+1)
-- >>> let x = pattern 5 [pure 3, pure 7]
-- >>> pure f <*> x
-- Pattern 6 [Pattern 4 [],Pattern 8 []]
--
-- >>> fmap f x
-- Pattern 6 [Pattern 4 [],Pattern 8 []]
--
-- Identity law (pure id <*> v == v):
--
-- >>> let v = pattern 5 [pure 3]
-- >>> pure id <*> v
-- Pattern 5 [Pattern 3 []]
--
-- >>> v
-- Pattern 5 [Pattern 3 []]
instance Applicative Pattern where
  pure :: a -> Pattern a
  pure :: forall a. a -> Pattern a
pure a
x = a -> [Pattern a] -> Pattern a
forall v. v -> [Pattern v] -> Pattern v
Pattern a
x []

  (<*>) :: Pattern (a -> b) -> Pattern a -> Pattern b
  (Pattern a -> b
f [Pattern (a -> b)]
fs) <*> :: forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
<*> (Pattern a
x [Pattern a]
xs) = 
    b -> [Pattern b] -> Pattern b
forall v. v -> [Pattern v] -> Pattern v
Pattern (a -> b
f a
x) ((Pattern (a -> b) -> Pattern b)
-> [Pattern (a -> b)] -> [Pattern b]
forall a b. (a -> b) -> [a] -> [b]
map (Pattern (a -> b) -> Pattern a -> Pattern b
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> [Pattern a] -> Pattern a
forall v. v -> [Pattern v] -> Pattern v
Pattern a
x [Pattern a]
xs) [Pattern (a -> b)]
fs [Pattern b] -> [Pattern b] -> [Pattern b]
forall a. [a] -> [a] -> [a]
++ (Pattern a -> Pattern b) -> [Pattern a] -> [Pattern b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> [Pattern (a -> b)] -> Pattern (a -> b)
forall v. v -> [Pattern v] -> Pattern v
Pattern a -> b
f [Pattern (a -> b)]
fs Pattern (a -> b) -> Pattern a -> Pattern b
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>) [Pattern a]
xs)

-- | 'Comonad' instance for 'Pattern'.
--
-- Enables context-aware computations where functions have access to the full
-- structural context (parent, siblings, depth, indices) around each value.
--
-- Semantics:
-- * 'extract' returns the decoration value at the current focus (root).
-- * 'duplicate' creates a pattern where each position contains the full pattern
--   structure focused at that position. This allows each position to "see" its
--   structural context.
-- * 'extend' applies a context-aware function to each position in the pattern.
--
-- Laws:
-- * Left Identity: `extract . extend f == f`
-- * Right Identity: `extend extract == id`
-- * Associativity: `extend f . extend g == extend (f . extend g)`
--
-- === Examples
--
-- Extract returns the root value:
--
-- >>> p = point 5
-- >>> extract p
-- 5
--
-- Duplicate creates context structure:
--
-- >>> p = pattern "root" [point "child"]
-- >>> d = duplicate p
-- >>> value d
-- Pattern "root" [Pattern "child" []]
-- >>> value (head (elements d))
-- Pattern "child" []
--
-- Extend applies context-aware function:
--
-- >>> p = pattern 1 [point 2, point 3]
-- >>> -- Calculate sum of subtree at each position
-- >>> sumSubtree (Pattern v es) = v + sum (map (extract . fmap sumSubtree) es)
-- >>> -- Note: proper implementation would use sizeAt or similar helper
-- >>> extend (const "context") p
-- Pattern "context" [Pattern "context" [],Pattern "context" []]
instance Comonad Pattern where
  extract :: Pattern a -> a
  extract :: forall v. Pattern v -> v
extract (Pattern a
v [Pattern a]
_) = a
v

  duplicate :: Pattern a -> Pattern (Pattern a)
  duplicate :: forall a. Pattern a -> Pattern (Pattern a)
duplicate p :: Pattern a
p@(Pattern a
_ [Pattern a]
es) = Pattern a -> [Pattern (Pattern a)] -> Pattern (Pattern a)
forall v. v -> [Pattern v] -> Pattern v
Pattern Pattern a
p ((Pattern a -> Pattern (Pattern a))
-> [Pattern a] -> [Pattern (Pattern a)]
forall a b. (a -> b) -> [a] -> [b]
map Pattern a -> Pattern (Pattern a)
forall a. Pattern a -> Pattern (Pattern a)
forall (w :: * -> *) a. Comonad w => w a -> w (w a)
duplicate [Pattern a]
es)

  extend :: (Pattern a -> b) -> Pattern a -> Pattern b
  extend :: forall a b. (Pattern a -> b) -> Pattern a -> Pattern b
extend Pattern a -> b
f p :: Pattern a
p@(Pattern a
_ [Pattern a]
es) = b -> [Pattern b] -> Pattern b
forall v. v -> [Pattern v] -> Pattern v
Pattern (Pattern a -> b
f Pattern a
p) ((Pattern a -> Pattern b) -> [Pattern a] -> [Pattern b]
forall a b. (a -> b) -> [a] -> [b]
map ((Pattern a -> b) -> Pattern a -> Pattern b
forall a b. (Pattern a -> b) -> Pattern a -> Pattern b
forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend Pattern a -> b
f) [Pattern a]
es)

-- | 'Foldable' instance for 'Pattern'.
--
-- folds over the values decorating the pattern structure.
--
-- The fold order is defined by the recursive structure:
-- 1. The value at the current node
-- 2. The elements in the elements list (recursively)
--
-- === Examples
--
-- >>> atom = point "test"
-- >>> toList atom
-- ["test"]
--
-- >>> p = pattern "root" [point "a", point "b"]
-- >>> toList pattern
-- ["root","a","b"]
--
-- >>> sum (pattern 1 [point 2, point 3])
-- 6
instance Foldable Pattern where
  foldMap :: forall m a. Monoid m => (a -> m) -> Pattern a -> m
foldMap a -> m
f (Pattern a
v [Pattern a]
es) = a -> m
f a
v m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (Pattern a -> m) -> [Pattern a] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> Pattern a -> m
forall m a. Monoid m => (a -> m) -> Pattern a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) [Pattern a]
es

-- | 'Traversable' instance for 'Pattern'.
--
-- Enables effectful traversal over pattern values while preserving structure.
--
-- Semantics:
-- * Applies an effectful function to each value.
-- * Sequences the effects.
-- * Reconstructs the pattern structure with the results.
--
-- Laws:
-- * Naturality: `t . traverse f = traverse (t . f)`
-- * Identity: `traverse Identity = Identity`
-- * Composition: `traverse (Compose . fmap g . f) = Compose . fmap (traverse g) . traverse f`
--
-- === Examples
--
-- Basic traversal with Identity (equivalent to fmap):
--
-- >>> import Data.Functor.Identity
-- >>> p = pattern 1 [point 2]
-- >>> runIdentity $ traverse (Identity . (*2)) p
-- Pattern 2 [Pattern 4 []]
--
-- Traversal with Maybe (validation):
--
-- >>> let validate x = if x > 0 then Just x else Nothing
-- >>> p = pattern 1 [point 2]
-- >>> traverse validate p
-- Just (Pattern 1 [Pattern 2 []])
--
-- >>> invalid = pattern 1 [point (-1)]
-- >>> traverse validate invalid
-- Nothing
--
-- Sequencing effects:
--
-- >>> p = pattern (Just 1) [point (Just 2)]
-- >>> sequenceA p
-- Just (Pattern 1 [Pattern 2 []])
--
-- Atomic pattern:
--
-- >>> atom = point 5
-- >>> traverse (Just . (*2)) atom
-- Just (Pattern 10 [])
--
-- Pattern with multiple elements:
--
-- >>> let validate x = if x > 0 then Just x else Nothing
-- >>> elem1 = point 5
-- >>> elem2 = point 10
-- >>> p = pattern 20 [elem1, elem2]
-- >>> traverse validate p
-- Just (Pattern 20 [Pattern 5 [],Pattern 10 []])
--
-- Nested pattern structure:
--
-- >>> let validate x = if x > 0 then Just x else Nothing
-- >>> inner = point 1
-- >>> middle = pattern 2 [inner]
-- >>> p = pattern 3 [middle]
-- >>> traverse validate p
-- Just (Pattern 3 [Pattern 2 [Pattern 1 []]])
--
-- Effect failure propagation:
--
-- >>> let validate x = if x > 0 then Just x else Nothing
-- >>> inner = point (-1) -- Invalid value
-- >>> middle = pattern 2 [inner]
-- >>> p = pattern 3 [middle]
-- >>> traverse validate p
-- Nothing
instance Traversable Pattern where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Pattern a -> f (Pattern b)
traverse a -> f b
f (Pattern a
v [Pattern a]
es) = b -> [Pattern b] -> Pattern b
forall v. v -> [Pattern v] -> Pattern v
Pattern (b -> [Pattern b] -> Pattern b)
-> f b -> f ([Pattern b] -> Pattern b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
v f ([Pattern b] -> Pattern b) -> f [Pattern b] -> f (Pattern b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Pattern a -> f (Pattern b)) -> [Pattern a] -> f [Pattern b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((a -> f b) -> Pattern a -> f (Pattern b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Pattern a -> f (Pattern b)
traverse a -> f b
f) [Pattern a]
es

-- * Construction Functions

-- | Create an atomic pattern (a pattern with no elements) from a value.
--
-- This uses category-theory terminology (pointed functor). Functionally
-- equivalent to 'pattern v []' and 'pure v'.
--
-- === Examples
--
-- >>> point "atom"
-- Pattern "atom" []
--
-- >>> point 42
-- Pattern 42 []
point :: v -> Pattern v
point :: forall a. a -> Pattern a
point v
v = v -> [Pattern v] -> Pattern v
forall v. v -> [Pattern v] -> Pattern v
Pattern v
v []

-- | Create a pattern with a value and elements.
--
-- This is the primary constructor for creating patterns. Takes a decoration value
-- and a list of pattern elements. The elements form the pattern itself; the value
-- provides decoration about that pattern.
--
-- === Examples
--
-- >>> pattern "root" [point "child"]
-- Pattern "root" [Pattern "child" []]
--
-- >>> pattern "pair" [point 1, point 2]
-- Pattern "pair" [Pattern 1 [],Pattern 2 []]
pattern :: v -> [Pattern v] -> Pattern v
pattern :: forall v. v -> [Pattern v] -> Pattern v
pattern v
v [Pattern v]
es = v -> [Pattern v] -> Pattern v
forall v. v -> [Pattern v] -> Pattern v
Pattern v
v [Pattern v]
es

-- | Create a pattern from a list of values.
--
-- Creates a pattern where the first argument is the decoration value,
-- and the list of values are converted to atomic patterns and used as elements.
--
-- === Examples
--
-- >>> fromList "root" ["a", "b", "c"]
-- Pattern "root" [Pattern "a" [],Pattern "b" [],Pattern "c" []]
fromList :: v -> [v] -> Pattern v
fromList :: forall v. v -> [v] -> Pattern v
fromList v
v [v]
vs = v -> [Pattern v] -> Pattern v
forall v. v -> [Pattern v] -> Pattern v
pattern v
v ((v -> Pattern v) -> [v] -> [Pattern v]
forall a b. (a -> b) -> [a] -> [b]
map v -> Pattern v
forall a. a -> Pattern a
point [v]
vs)

-- * Query Functions

-- | Returns the number of direct elements in a pattern's sequence.
--
-- This operation is O(1).
--
-- === Examples
--
-- >>> length (point "atom")
-- 0
--
-- >>> length (pattern "pair" [point 1, point 2])
-- 2
length :: Pattern v -> Int
length :: forall a. Pattern a -> Int
length (Pattern v
_ [Pattern v]
es) = [Pattern v] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [Pattern v]
es

-- | Returns the total number of nodes in a pattern structure.
--
-- Counts the root node plus all nodes in all nested subpatterns.
-- This operation is O(n) where n is the total number of nodes.
--
-- === Examples
--
-- >>> size (point "atom")
-- 1
--
-- >>> size (pattern "root" [point "child"])
-- 2
--
-- >>> size (pattern "root" [point "a", point "b"])
-- 3
size :: Pattern v -> Int
size :: forall a. Pattern a -> Int
size (Pattern v
_ [Pattern v]
es) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Pattern v -> Int) -> [Pattern v] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Pattern v -> Int
forall a. Pattern a -> Int
size [Pattern v]
es)

-- | Returns the maximum nesting depth of a pattern structure.
--
-- An atomic pattern has depth 0 (root only, no nesting).
-- A pattern with elements has depth 1 + max depth of elements.
-- This operation is O(n) where n is the total number of nodes.
--
-- === Examples
--
-- >>> depth (point "atom")
-- 0
--
-- >>> depth (pattern "root" [point "child"])
-- 1
--
-- >>> depth (pattern "root" [pattern "middle" [point "inner"]])
-- 2
depth :: Pattern v -> Int
depth :: forall a. Pattern a -> Int
depth (Pattern v
_ []) = Int
0
depth (Pattern v
_ [Pattern v]
es) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((Pattern v -> Int) -> [Pattern v] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Pattern v -> Int
forall a. Pattern a -> Int
depth [Pattern v]
es)

-- | Extracts all values from a pattern structure as a flat list.
--
-- The order of values corresponds to a pre-order traversal (root, then elements).
-- This is equivalent to 'toList' from 'Foldable', but specific to 'Pattern'.
-- This operation is O(n) where n is the total number of nodes.
--
-- === Examples
--
-- >>> values (point "atom")
-- ["atom"]
--
-- >>> values (pattern "root" [point "a", point "b"])
-- ["root","a","b"]
values :: Pattern v -> [v]
values :: forall a. Pattern a -> [a]
values = Pattern v -> [v]
forall a. Pattern a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

-- * Predicate Functions

-- | Checks if any value in the pattern satisfies the predicate.
--
-- Traverses the pattern structure and applies the predicate to each value.
-- Returns True if at least one value satisfies the predicate.
-- This operation is O(n).
--
-- === Examples
--
-- >>> anyValue (> 5) (pattern 3 [point 6, point 2])
-- True
--
-- >>> anyValue (> 10) (pattern 3 [point 6, point 2])
-- False
anyValue :: (v -> Bool) -> Pattern v -> Bool
anyValue :: forall v. (v -> Bool) -> Pattern v -> Bool
anyValue v -> Bool
p = (v -> Bool -> Bool) -> Bool -> Pattern v -> Bool
forall a b. (a -> b -> b) -> b -> Pattern a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\v
v Bool
acc -> v -> Bool
p v
v Bool -> Bool -> Bool
|| Bool
acc) Bool
False

-- | Checks if all values in the pattern satisfy the predicate.
--
-- Traverses the pattern structure and applies the predicate to each value.
-- Returns True if all values satisfy the predicate.
-- This operation is O(n).
--
-- === Examples
--
-- >>> allValues (> 0) (pattern 3 [point 6, point 2])
-- True
--
-- >>> allValues (> 5) (pattern 3 [point 6, point 2])
-- False
allValues :: (v -> Bool) -> Pattern v -> Bool
allValues :: forall v. (v -> Bool) -> Pattern v -> Bool
allValues v -> Bool
p = (v -> Bool -> Bool) -> Bool -> Pattern v -> Bool
forall a b. (a -> b -> b) -> b -> Pattern a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\v
v Bool
acc -> v -> Bool
p v
v Bool -> Bool -> Bool
&& Bool
acc) Bool
True

-- | Filters subpatterns (including root) that satisfy a pattern predicate.
--
-- Traverses the pattern structure and applies the predicate to each subpattern.
-- Returns a list of all matching patterns.
-- This operation is O(n).
--
-- === Examples
--
-- >>> p = pattern 3 [point 6, point 2]
-- >>> map value $ filterPatterns (\x -> value x > 5) p
-- [6]
--
-- >>> map value $ filterPatterns (\x -> length x > 0) p
-- [3]
filterPatterns :: (Pattern v -> Bool) -> Pattern v -> [Pattern v]
filterPatterns :: forall v. (Pattern v -> Bool) -> Pattern v -> [Pattern v]
filterPatterns Pattern v -> Bool
p pat :: Pattern v
pat@(Pattern v
_ [Pattern v]
es) =
  (if Pattern v -> Bool
p Pattern v
pat then [Pattern v
pat] else []) [Pattern v] -> [Pattern v] -> [Pattern v]
forall a. [a] -> [a] -> [a]
++ (Pattern v -> [Pattern v]) -> [Pattern v] -> [Pattern v]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Pattern v -> Bool) -> Pattern v -> [Pattern v]
forall v. (Pattern v -> Bool) -> Pattern v -> [Pattern v]
filterPatterns Pattern v -> Bool
p) [Pattern v]
es

-- | Finds the first subpattern (including root) that satisfies a pattern predicate.
--
-- Traverses the pattern structure in pre-order and returns the first match.
-- Returns Nothing if no pattern matches.
-- This operation is O(n).
--
-- === Examples
--
-- >>> p = pattern 3 [point 6, point 2]
-- >>> fmap value $ findPattern (\x -> value x > 5) p
-- Just 6
--
-- >>> findPattern (\x -> value x > 10) p
-- Nothing
findPattern :: (Pattern v -> Bool) -> Pattern v -> Maybe (Pattern v)
findPattern :: forall v. (Pattern v -> Bool) -> Pattern v -> Maybe (Pattern v)
findPattern Pattern v -> Bool
p pat :: Pattern v
pat@(Pattern v
_ [Pattern v]
es)
  | Pattern v -> Bool
p Pattern v
pat = Pattern v -> Maybe (Pattern v)
forall a. a -> Maybe a
Just Pattern v
pat
  | Bool
otherwise = (Maybe (Pattern v) -> Maybe (Pattern v) -> Maybe (Pattern v))
-> Maybe (Pattern v) -> [Maybe (Pattern v)] -> Maybe (Pattern v)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Maybe (Pattern v) -> Maybe (Pattern v) -> Maybe (Pattern v)
forall {a}. Maybe a -> Maybe a -> Maybe a
orElse Maybe (Pattern v)
forall a. Maybe a
Nothing ((Pattern v -> Maybe (Pattern v))
-> [Pattern v] -> [Maybe (Pattern v)]
forall a b. (a -> b) -> [a] -> [b]
map ((Pattern v -> Bool) -> Pattern v -> Maybe (Pattern v)
forall v. (Pattern v -> Bool) -> Pattern v -> Maybe (Pattern v)
findPattern Pattern v -> Bool
p) [Pattern v]
es)
  where
    orElse :: Maybe a -> Maybe a -> Maybe a
orElse (Just a
x) Maybe a
_ = a -> Maybe a
forall a. a -> Maybe a
Just a
x
    orElse Maybe a
Nothing Maybe a
y = Maybe a
y

-- | Finds all subpatterns (including root) that satisfy a pattern predicate.
--
-- Equivalent to 'filterPatterns'. Returns a list of all matching patterns.
-- This operation is O(n).
--
-- === Examples
--
-- >>> p = pattern 3 [point 6, point 2]
-- >>> map value $ findAllPatterns (\x -> value x > 1) p
-- [3,6,2]
findAllPatterns :: (Pattern v -> Bool) -> Pattern v -> [Pattern v]
findAllPatterns :: forall v. (Pattern v -> Bool) -> Pattern v -> [Pattern v]
findAllPatterns = (Pattern v -> Bool) -> Pattern v -> [Pattern v]
forall v. (Pattern v -> Bool) -> Pattern v -> [Pattern v]
filterPatterns

-- | Checks if two patterns match structurally.
--
-- Uses the 'Eq' instance to compare patterns for structural equality.
-- Both values and elements must match recursively.
-- This operation is O(n).
--
-- === Examples
--
-- >>> matches (point "a") (point "a")
-- True
--
-- >>> matches (point "a") (point "b")
-- False
matches :: Eq v => Pattern v -> Pattern v -> Bool
matches :: forall v. Eq v => Pattern v -> Pattern v -> Bool
matches = Pattern v -> Pattern v -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | Checks if a pattern contains a specific subpattern.
--
-- Traverses the pattern structure to see if any subpattern matches the target.
-- Uses 'matches' (structural equality) for comparison.
-- This operation is O(n).
--
-- === Examples
--
-- >>> p = pattern "root" [point "child"]
-- >>> contains p (point "child")
-- True
--
-- >>> contains p (point "missing")
-- False
contains :: Eq v => Pattern v -> Pattern v -> Bool
contains :: forall v. Eq v => Pattern v -> Pattern v -> Bool
contains Pattern v
haystack Pattern v
needle =
  Pattern v -> Pattern v -> Bool
forall v. Eq v => Pattern v -> Pattern v -> Bool
matches Pattern v
haystack Pattern v
needle Bool -> Bool -> Bool
|| (Pattern v -> Bool) -> [Pattern v] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Pattern v -> Pattern v -> Bool
forall v. Eq v => Pattern v -> Pattern v -> Bool
`contains` Pattern v
needle) (Pattern v -> [Pattern v]
forall v. Pattern v -> [Pattern v]
elements Pattern v
haystack)

-- * Foldable/Traversable Extras

-- | Extracts all values from a pattern structure as a flat list.
--
-- Equivalent to 'toList' and 'values'. Provided for explicit API clarity.
--
-- === Examples
--
-- >>> flatten (point "atom")
-- ["atom"]
flatten :: Pattern v -> [v]
flatten :: forall a. Pattern a -> [a]
flatten = Pattern v -> [v]
forall a. Pattern a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

-- | Extracts the pattern structure as a tuple (value, elements).
--
-- Preserves the structure while exposing the internal components.
-- Useful for pattern matching or transformation without direct field access.
--
-- === Examples
--
-- >>> toTuple (point "atom")
-- ("atom",[])
--
-- >>> toTuple (pattern "root" [point "child"])
-- ("root",[Pattern "child" []])
toTuple :: Pattern v -> (v, [Pattern v])
toTuple :: forall v. Pattern v -> (v, [Pattern v])
toTuple (Pattern v
v [Pattern v]
es) = (v
v, [Pattern v]
es)

-- * Context/Comonad Functions

-- | Computes the nesting depth at each position in the pattern.
--
-- Returns a new pattern with the same structure where each value is replaced
-- by its depth (maximum nesting depth of the subtree at that position).
--
-- === Examples
--
-- >>> p = pattern "root" [point "child"]
-- >>> depthAt p
-- Pattern 1 [Pattern 0 []]
depthAt :: Pattern v -> Pattern Int
depthAt :: forall v. Pattern v -> Pattern Int
depthAt = (Pattern v -> Int) -> Pattern v -> Pattern Int
forall a b. (Pattern a -> b) -> Pattern a -> Pattern b
forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend Pattern v -> Int
forall a. Pattern a -> Int
depth

-- | Computes the size of the subtree at each position in the pattern.
--
-- Returns a new pattern with the same structure where each value is replaced
-- by the size (number of nodes) of the subtree rooted at that position.
--
-- === Examples
--
-- >>> p = pattern "root" [point "a", point "b"]
-- >>> sizeAt p
-- Pattern 3 [Pattern 1 [],Pattern 1 []]
sizeAt :: Pattern v -> Pattern Int
sizeAt :: forall v. Pattern v -> Pattern Int
sizeAt (Pattern v
_ [Pattern v]
es) =
  let subResults :: [Pattern Int]
subResults = (Pattern v -> Pattern Int) -> [Pattern v] -> [Pattern Int]
forall a b. (a -> b) -> [a] -> [b]
map Pattern v -> Pattern Int
forall v. Pattern v -> Pattern Int
sizeAt [Pattern v]
es
      mySize :: Int
mySize = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Pattern Int -> Int) -> [Pattern Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Pattern Int -> Int
forall v. Pattern v -> v
value [Pattern Int]
subResults)
  in Int -> [Pattern Int] -> Pattern Int
forall v. v -> [Pattern v] -> Pattern v
Pattern Int
mySize [Pattern Int]
subResults

-- | Computes the path indices from root to each position in the pattern.
--
-- Returns a new pattern with the same structure where each value is replaced
-- by a list of indices representing the path from root to that position.
--
-- === Examples
--
-- >>> p = pattern "root" [point "a", point "b"]
-- >>> indicesAt p
-- Pattern [] [Pattern [0] [],Pattern [1] []]
indicesAt :: Eq v => Pattern v -> Pattern [Int]
indicesAt :: forall v. Eq v => Pattern v -> Pattern [Int]
indicesAt = [Int] -> Pattern v -> Pattern [Int]
forall {a} {v}. (Num a, Enum a) => [a] -> Pattern v -> Pattern [a]
go []
  where
    go :: [a] -> Pattern v -> Pattern [a]
go [a]
path (Pattern v
_ [Pattern v]
es) =
      [a] -> [Pattern [a]] -> Pattern [a]
forall v. v -> [Pattern v] -> Pattern v
Pattern [a]
path ((a -> Pattern v -> Pattern [a])
-> [a] -> [Pattern v] -> [Pattern [a]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\a
i Pattern v
e -> [a] -> Pattern v -> Pattern [a]
go ([a]
path [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
i]) Pattern v
e) [a
0..] [Pattern v]
es)

-- | Paramorphism: structure-aware folding over patterns.
--
-- Paramorphism enables folding over pattern structures while providing access
-- to the full pattern subtree at each position. The folding function receives:
--
-- 1. The current pattern subtree (@Pattern v@)
-- 2. The list of recursively computed results from children (@[r]@)
--
-- This extends 'Foldable' (value-only folding) to provide structure-aware folding,
-- just as 'Comonad' extends 'Functor' to provide structure-aware transformation.
--
-- Paramorphism enables structure-aware aggregations that consider structural
-- properties (depth, element count, nesting level) in addition to values.
--
-- === Examples
--
-- Depth-weighted sum:
--
-- >>> p = pattern 10 [point 5, point 3]
-- >>> para (\pat rs -> value pat * depth pat + sum rs) p
-- 10
--
-- Element-count-aware aggregation:
--
-- >>> p = pattern 10 [point 5, point 3]
-- >>> para (\pat rs -> value pat * length (elements pat) + sum (map value (elements pat)) + sum rs) p
-- 28
--
-- Structure-preserving transformation during fold:
--
-- >>> p = pattern 10 [point 5, point 3]
-- >>> para (\pat rs -> Pattern (value pat * depth pat) rs) p
-- Pattern 10 [Pattern 0 [],Pattern 0 []]
--
-- === Relationship to Other Operations
--
-- * 'Foldable': Provides value-only folding (@foldr@, @foldl@, @foldMap@).
--   Use when you only need values, not structural information.
--
-- * Paramorphism: Provides structure-aware folding (@para@).
--   Use when you need structure-aware aggregations (depth-weighted sums,
--   nesting-level statistics, element-count-based aggregations).
--
-- * 'Comonad': Provides structure-aware transformation (@extend@).
--   Use when you need structure-aware transformation (not aggregation).
--
-- @since 0.1.0
para :: (Pattern v -> [r] -> r) -> Pattern v -> r
para :: forall v r. (Pattern v -> [r] -> r) -> Pattern v -> r
para Pattern v -> [r] -> r
f (Pattern v
v [Pattern v]
els) = 
  Pattern v -> [r] -> r
f (v -> [Pattern v] -> Pattern v
forall v. v -> [Pattern v] -> Pattern v
Pattern v
v [Pattern v]
els) ((Pattern v -> r) -> [Pattern v] -> [r]
forall a b. (a -> b) -> [a] -> [b]
map ((Pattern v -> [r] -> r) -> Pattern v -> r
forall v r. (Pattern v -> [r] -> r) -> Pattern v -> r
para Pattern v -> [r] -> r
f) [Pattern v]
els)