holeyexp (empty) → 0.2.0.0
raw patch · 13 files changed
+1541/−0 lines, 13 filesdep +QuickCheckdep +basedep +containerssetup-changed
Dependencies added: QuickCheck, base, containers, extra, holeyexp, hspec, megaparsec, quickcheck-instances, text
Files
- CHANGELOG.md +25/−0
- LICENSE.md +26/−0
- README.md +16/−0
- Setup.hs +2/−0
- holeyexp.cabal +111/−0
- src/Data/HoleyExp/HExp.hs +191/−0
- src/Data/HoleyExp/HExpInternal.hs +515/−0
- src/Data/HoleyExp/Text.hs +326/−0
- src/Data/NatMap.hs +114/−0
- test/Data/HoleyExp/HExpInternalSpec.hs +103/−0
- test/Spec.hs +1/−0
- test/Test/Helpers.hs +53/−0
- test/Test/QuickCheck/HExp.hs +58/−0
+ CHANGELOG.md view
@@ -0,0 +1,25 @@+# Changelog for `holeyexp`++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),+and this project adheres to the+[Haskell Package Versioning Policy](https://pvp.haskell.org/).++## Unreleased++## [0.2.0.0] - 2026-08-28+### Added+ - New documentation and complete Haddock docs on all definitions.+ - New cabal package.+### Changed+ - Better naming of combinators. + - Data.HoleyExp.HExp.empty is now emptyExp+ - Data.HoleyExp.HExp.hole is now empty + - Data.HoleyExp.HExp.plugHole is now plug+ - Data.HoleyExp.HExp.fillHole is now update+ - Data.HoleyExp.HExp.placeInHole is now place+ - Moved template haskell and JSON out of this package and into their own packages.++## [0.1.0.0] - 2026-08-14+ - First complete implementation.
+ LICENSE.md view
@@ -0,0 +1,26 @@+Copyright 2026 Harley Eades III++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,16 @@+# Holey Expression++[](http://opensource.org/licenses/BSD-3-Clause)++* [Documentation](#documentation)++Holey expressions correspond to a monoid with two kinds of elements: i. chunks+and ii. holes. The former correspond to chunks of "text" which we leave+abstract, and the latter correspond to placeholders for values that will+eventually be translated into "text".++# Documentation++The API is well documented. Please see [hackage] for the complete documentation.++[hackage]: https://hackage.haskell.org/package/holeyexp
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ holeyexp.cabal view
@@ -0,0 +1,111 @@+cabal-version: 2.4+name: holeyexp+version: 0.2.0.0+license: BSD-3-Clause+license-file: LICENSE.md+maintainer: Harley Eades III <harley.eades@gmail.com>+author: Harley Eades III++tested-with: + GHC == 9.10.*+ GHC == 9.12.*+ GHC == 9.14.1++homepage: https://github.com/DevWKB/holey-expression+bug-reports: https://github.com/DevWKB/holey-expression/issues+synopsis: Add, fill, plug holes in monoids+description: + This is a library that allows you to add placeholders we call "holes" + to any monoid. Then these holes can be filled or plugged.++category: Language+build-type: Simple++extra-source-files:+ README.md+extra-doc-files:+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/heades/holey-expression++common depends + build-depends:+ base >= 4.7 && < 5 + ,containers >= 0.7 && < 0.8+ ,extra >= 1.8.1 && < 1.9+ ,megaparsec >= 9.7.0 && < 9.9+ ,text >= 2.1.3 && < 2.2 ++common test-depends+ build-depends:+ QuickCheck > 2.15.0 && < 2.19+ ,hspec >= 2.11.17 && < 2.12 + ,quickcheck-instances >= 0.3.33 && < 0.5+ build-tool-depends: + hspec-discover:hspec-discover++library+ import: depends ++ if impl(ghc >= 9.10.0)+ buildable: True+ else+ buildable: False+ + exposed-modules:+ Data.HoleyExp.HExp+ Data.HoleyExp.HExpInternal+ Data.HoleyExp.Text+ Data.NatMap+ other-modules:+ Paths_holeyexp + autogen-modules:+ Paths_holeyexp+ hs-source-dirs:+ src + ghc-options: -Wall + -Wcompat + -Widentities + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wmissing-export-lists + -Wmissing-home-modules + -Wpartial-fields + -Wredundant-constraints+ -Wno-name-shadowing + default-extensions: + ImportQualifiedPost+ OverloadedStrings+ InstanceSigs+ LambdaCase+ ViewPatterns+ PatternSynonyms+ GADTs+ default-language: Haskell2010++test-suite holey-expression-test+ import: depends, test-depends + type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Paths_holeyexp+ Data.HoleyExp.HExpInternalSpec+ Test.QuickCheck.HExp+ Test.Helpers+ autogen-modules:+ Paths_holeyexp+ hs-source-dirs:+ test+ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+ default-extensions: + ImportQualifiedPost+ OverloadedStrings+ InstanceSigs+ LambdaCase+ ViewPatterns+ GADTs+ build-depends: + ,holeyexp + default-language: Haskell2010
+ src/Data/HoleyExp/HExp.hs view
@@ -0,0 +1,191 @@+{-|+Module : HExp+Description : Holey Expressions+Copyright : (c) Harley Eades, 2026+ (c) W⋊B, 2026+Maintainer : harley.eades@gmail.com++Holey expressions correspond to a monoid with two kinds of elements: i. chunks+and ii. holes. The former correspond to chunks of "text" which we leave+abstract, and the latter correspond to placeholders for values that will+eventually be translated into "text".++Suppose we have a monoid \((\mathsf{Txt},\otimes,\mathsf{e})\), where we call+elements of \(\mathsf{Txt}\) __text__. Furthermore, suppose we have a set+\(\mathsf{Fill}\) which we call its elements __fillings__. ++We define the collection of __holey expressions__ to be:++\( \mathsf{HExp}(\mathsf{Txt},\mathsf{Fill}) = \Pi(\mathsf{Txt} + (\mathbb{N} \times \mathsf{Fill}_{\mathsf{?}})) \)++We call elements of \( \mathbb{N} \times \mathsf{Fill}_{\mathsf{?}} \)+__holes__, and denote __filled holes__ by \($(i,f)\) and __empty holes__ by+\($(i,\mathsf{?})\). Lastly, composition of expressions, elements of+\(\mathsf{HExp}\), is concatenation of products denoted by +\(e_1 * \cdots * e_i \); +note that we leave injections implicit to make the expression more readable.++__Chunks__ are the pieces of text that sit between holes. It's quite simple to+define the function +\(\mathsf{chunk}(t) = t : \mathsf{HExp}(\mathsf{Txt},\mathsf{Fill})\). We+will leave the application of \(\mathsf{chunk}\) implicit.++Let's consider a few abstract example expressions:++1. \( t_1 * $(1,\mathsf{?}) * t_2 * $(2,\mathsf{?}) \), has chunks+ \(\{t_1,t_2\}\) and two empty holes indexed by \(1\) and \(2\).+2. \( t_1 * $(5,f_5) * $(3,\mathsf{?}) * t_2 * $(7,f_7) \), has chunks+ \(\{t_1,t_2\}\) and one empty holes indexed by \(3\) and a filled hole index+ by \(7\) whose filling is \(f_2\).++Now if we choose some concrete sets for \(\mathsf{Txt}\) and \(\mathsf{Fill}\)+then we can create more interesting expressions:++1. \(123 * $(1,?) * 456 * $(2,5) : \mathsf{HExp}(\mathbb{N},\mathbb{N})\), where+ \((\mathbb{N},0,+)\) is the monoid for \(\mathsf{Txt}\)+2. \(\text{"Hi, my name is "} * $(1,?) : \mathsf{HExp}(\Sigma^*,\Sigma^*)\), where+ \((\Sigma^*,\circ)\) is the monoid of words over the English alphabet.+3. \($(1,?) * \text{":"} * $(2,?) * \text{":"} * $(3,?) : \mathsf{HExp}(\Sigma^*,\mathbb{N})\), where+ \((\Sigma^*,\circ)\) is the monoid of words over \(\Sigma = \mathbb{N} \cup \{\text{":"}\}\). + This could represent time.++Holey expressions are ultimately meant to be translated into \(\mathsf{Txt}\) by+filling in all of their holes. This implies that we must require the existence+of a function \(p : \mathsf{Fill} \to \mathsf{Txt} \). There are two operations+on holes: i. plugging a hole (replacing it with a filling) and ii. filling a+hole (placing a filling inside the hole). ++Plugging a hole amounts to defining a function +\(\mathsf{plug} : \mathbb{N} \times \mathsf{Fill}_\mathsf{?} \to \mathsf{Fill}_\perp\)+that chooses which filling to replace the hole with; note that this is a partial+function, and is defined per-expression. Then plugging an expression corresponds to+the function: +\( \Pi(\mathsf{id} + (\mathsf{plug};p_\perp)) : \mathsf{HExp}(\mathsf{Txt},\mathsf{Fill}) \to \mathsf{Txt}_\perp \).+If the plug function is defined for all holes in the input expression, then the+above composition will indeed yield a text (an element of \(\mathsf{Txt}\)).++Filling a hole is a bit more simple, and requires the definition of a function+\(\mathsf{place} : \mathsf{Fill}_\mathsf{?} \to \mathsf{Fill}_\mathsf{?}\)+that simply updates the filling in the hole. Then filling an expression corresponds to+the function: +\( \Pi(\mathsf{id} + (\mathsf{id} \times \mathsf{place})) : \mathsf{HExp}(\mathsf{Txt},\mathsf{Fill}) \to \mathsf{HExp}(\mathsf{Txt},\mathsf{Fill}) \).++Each one of these concepts map to a corresponding item in this module.++The holey expressions type, @exp :: t`HExp` text filling@, abstracts+over \(\mathsf{Txt}\) and \(\mathsf{Fill}\) using type variables @text@ and+@filling@. We enforce that @filling@ can be translated to @text@ using the type+class @`HoleFilling` text filling@. This requires that there is a function +@`fillingToText` :: filling -> text@.++There are three main combinators for creating holey expressions:++1. @`chunk` :: text -> t`HExp` text filling@ is a piece of @text@ that+sits between the holes in an expression;+2. An empty hole, @`empty` :: t`GHC.Num.Natural` -> t`HExp` text filling@,+ informally denoted @$i()@, simply corresponds to a natural number that acts as its index; and+3. a filled hole, @`filled` :: t`GHC.Num.Natural` -> filling -> t`HExp` text filling@, are also indexed by a+natural number, but now contain a filling that /may/ replace the hole when it's+converted into a @text@.++When @text@ is a monoid, then we can compose chunks and holes together using the+sequential composition @`(+>)` :: t`HExp` text filling -> t`HExp` text filling+-> t`HExp` text filling@. ++Concrete examples are more interesting when we actually instantiate @text@ and+@filling@. For several using t`Data.Text.Text` as the @text@, see+"Data.HoleyExp.Text".+-}++++module Data.HoleyExp.HExp (-- * Holey Expressions + HExp+ ,TextLike(..)+ ,HoleFilling(..)+ ,ToHExp(..)+ -- __ Holes + ,Hole+ ,HoleProps+ -- __* Patterns+ -- | Patterns make it easier to decide if a hole is empty, filled, or neither.+ -- For example:+ --+ -- @+ -- holeIndex :: Hole f -> Maybe Natural+ -- holeIndex (EmptyHole i _) = Just i+ -- holeIndex (FilledHole i _) = Just i+ -- holeIndex (UndefHole i _) = Nothing+ -- @+ -- Each pattern uses the hole's properties+ -- ('HoleProps') to decide if the hole's index is in+ -- the required is location within the hole+ -- properties, if not then it's considered+ -- undefined. This prevents a lot of boilerplate+ -- pattern matching.+ ,pattern Empty+ ,pattern Chunk+ ,pattern Compose + -- __ Combinators+ -- | The following combinators are the interface to+ -- holey expressions. First, there are two+ -- combinators for holes:+ -- + -- 1. Empty holes:+ --+ -- >>> empty 1+ -- + -- 2. Filled holes:+ --+ -- >>> filled 1 f+ --+ -- where @f@ is some hole filling of type @filling@.+ -- There are no constraints on how many times a hole+ -- index can occur. However, a hole is either filled+ -- or empty, but not both.+ --+ -- Secondly, we have a combinator for chunks of + -- @text@:+ --+ -- >>> chunk t+ --+ -- where @t@ is some element of @text@.+ -- + -- Then we build larger expressions using+ -- composition:+ --+ -- >>> e1 +> e2 +> ... +> ei+ --+ -- for some expressions @e1,e2,...,ei@. This+ -- composition is associative, but non-commutative.+ ,empty+ ,filled+ ,chunk+ ,(+>) + -- __* Plugging Holes+ -- | Holes can be either filled or plugged. The+ -- former simply places a value of type @filling@+ -- into the hole, but doesn't replace the hole. The+ -- latter, replaces the hole altogether with the+ -- value. There are two combinators for filling a+ -- hole: a destructive one @update@, and a+ -- non-destructive one @place@. Finally,+ -- @plugAll@ plugs every hole the function is defined for.+ ,plug+ ,plugAll+ ,update+ ,place+ -- __* Hole Properties+ ,unfilledHoles+ ,filledHoles+ ,numberOfUnfilledHoles+ ,numberOfFilledHoles+ -- __* Equality+ ,(==>)+ -- __* Useful Helpers+ ,showAST+ ,sepHExpsBy+ ,betweenHExp+ ,chunkToText) where++import Data.HoleyExp.HExpInternal
+ src/Data/HoleyExp/HExpInternal.hs view
@@ -0,0 +1,515 @@+{-|+Module : HExpInternal+Description : Internal framework for creating holey expressions+Copyright : (c) Harley Eades, 2026+ (c) W⋊B, 2026+Maintainer : harley.eades@gmail.com+-}+{-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_GHC -Wno-missing-export-lists #-}+{-# LANGUAGE TypeAbstractions #-}+{-# LANGUAGE FlexibleContexts #-}+module Data.HoleyExp.HExpInternal where+import Prelude hiding (null)+import Data.Text (Text)+import Data.Text qualified as DT+import Data.Maybe (isNothing)+import Data.String (IsString (..))+import Data.List qualified as L+import Data.NatMap (NatMap+ ,Natural+ ,(!?)+ ,keys+ ,insert+ ,(!)+ ,delete+ ,singleton)+import Data.NatMap qualified as M++-- | Holes are either empty or filled; thus, a hole's properties consists of a+-- pair of a list of natural numbers designating the set of empty holes and a+-- natural-number map (t'NatMap') that assigns fillings of type @f@ to hole+-- indices.+type HoleProps f = ([Natural],NatMap f)++-- | A hole that can be filled with a filling of type @f@ is a natural number+-- and a set of hole properties (t`HoleProps`).+type Hole f = (Natural,HoleProps f)++-- ** Hole Patterns++-- | Pattern synonym for empty holes. +pattern EmptyHole :: Natural -> HoleProps f -> Hole f+pattern EmptyHole i hlsProps <- (decomposeEmptyHole -> Just (i,hlsProps))++-- | Pattern synonym for filled holes.+pattern FilledHole :: Natural -> f -> HoleProps f -> Hole f+pattern FilledHole i f hlsProps <- (decomposeFilledHole -> Just (i,Just f,hlsProps))++-- | Pattern synonym for undefined holes. These are holes which are not currently used+-- in the expression; and thus, are neither free nor empty.+pattern UndefHole :: Natural -> HoleProps f -> Hole f+pattern UndefHole i hlsProps <- (decomposeUndefHole -> Just (i,hlsProps))++-- | Determines if the input hole index @i@ is the index of an empty hole.+decomposeEmptyHole :: (Natural, HoleProps f) -> Maybe (Natural, HoleProps f)+decomposeEmptyHole h@(i,hlsProps) | emptyHole i hlsProps = Just h+ | otherwise = Nothing++-- | Determines if the input hole index @i@ is the index of a filled hole.+decomposeFilledHole :: Hole f -> Maybe (Natural, Maybe f, HoleProps f)+decomposeFilledHole (i,hlsProps@(_,fhls)) | filledHole i hlsProps = Just (i,fhls !? i,hlsProps)+ | otherwise = Nothing++-- | Determines if the input hole index @i@ is neither an empty hole or a filled+-- hole; thus, is undefined in the expression.+decomposeUndefHole :: Hole f -> Maybe (Hole f)+decomposeUndefHole h | isNothing (decomposeEmptyHole h) && isNothing (decomposeFilledHole h) = Just h+ | otherwise = Nothing++{-# COMPLETE EmptyHole, FilledHole, UndefHole #-}++-- | Tests to see if a hole index exist in the given hole properties.+isFreshHoleIndex :: Natural -- ^ Hole index+ -> HoleProps f -- ^ Hole properties+ -> Bool+isFreshHoleIndex h holeProps = not $ filledHole h holeProps || emptyHole h holeProps++-- | Decides if the given hole index is empty with respect to the given hole+-- properties. This returns `True` when the given index is in the set of+-- empty holes, but is not defined in the map of filled holes.+emptyHole :: Natural -> HoleProps f -> Bool+emptyHole i (hls,fhls) = i `elem` hls && not (i `elem` keys fhls)++-- | Decides if the given hole index is filled with respect to the given hole+-- properties. This returns `True` when the given index is not in the set of+-- empty holes, but is defined in the map of filled holes.+filledHole :: Natural -> HoleProps f -> Bool+filledHole i (hls,fhls) = not (i `elem` hls) && i `elem` keys fhls++-- | The hole properties with no defined holes.+emptyHoleProps :: HoleProps f+emptyHoleProps = ([], M.empty)++-- | Adds a hole index and potential filling to the given hole properties. If+-- the given filling is @Nothing@ then the hole is assumed to be added as an+-- unfilled hole, otherwise it's added as a filled hole. The given index cannot+-- already exist in the hole properties.+updateFreshHolePropsWith + :: HoleProps text + -> (Natural,Maybe text) + -> HoleProps text+updateFreshHolePropsWith holeProps@(hls, fhls) (h, Nothing) | h `isFreshHoleIndex` holeProps = (h:hls,fhls)+updateFreshHolePropsWith holeProps@(hls, fhls) (h, (Just f)) | h `isFreshHoleIndex` holeProps = (hls,insert h f fhls)+updateFreshHolePropsWith holeProps (_,_) = holeProps++-- | The underlying structure of t'HExp'.+data IHExp text where+ IChunk :: text -> IHExp text+ ICompose :: text -> Natural -> IHExp text -> IHExp text++-- | An expression with pluggable holes. We do not expose the underlying+-- constructors in favor of the combinators.+data HExp text filling where+ HExp :: IHExp text -- ^ Internal expression+ -> HoleProps filling -- ^ Empty holes and hole-filling map+ -> HExp text filling++instance (TextLike text, HoleFilling text filling) => Show (HExp text filling) where+ show :: HExp text filling -> String + show (HExp (IChunk t) _) = DT.unpack . toText $ t + show (HExp (ICompose prefix i rest) (emptyHoles, filledHoles))+ = (DT.unpack . toText $ prefix) + <> "$" <> show i <> "{"+ <> (if i `elem` emptyHoles then "" else (DT.unpack . toText . (fillingToText @text) $ filledHoles ! i))+ <> "}" + <> show (HExp rest (emptyHoles, filledHoles))++-- * Combinators++-- | Pattern synonym for the empty expression.+pattern Empty :: (Eq text, Monoid text) => HExp text filling+pattern Empty <- (null -> True) where+ Empty = emptyExp++-- | Decides if an expression corresponds to a chunk or not. +isChunk :: HExp text filling -> Maybe text+isChunk (HExp (IChunk s) ([],m)) | M.null m = Just s+isChunk _ = Nothing++-- | Pattern synonym for expression chunk's.+pattern Chunk :: text -> HExp text filling+pattern Chunk s <- (isChunk -> Just s)+ where+ Chunk = chunk++-- | Pattern synonym for the composition of holey expressions.+pattern Compose :: Monoid text => text -> (Natural,Maybe filling) -> HExp text filling -> HExp text filling+pattern Compose c h t <- (decompose -> Just (c, h, t))+ where+ Compose = compose++{-# COMPLETE Chunk, Compose #-}++-- | Explicitly create a top-level composition expression.+compose :: Monoid text+ => text -- ^ Prefix chunk+ -> (Natural,Maybe filling) + -> HExp text filling -- ^ HExp branch+ -> HExp text filling+compose c (i, Nothing) t = chunk c +> empty i +> t+compose c (i, Just f) t = chunk c +> filled i f +> t++-- | Decompose an expression into the top-level compose.+decompose :: HExp text filling + -> Maybe (text, (Natural,Maybe filling), HExp text filling)+decompose (HExp (ICompose c i t') hlsProps) = + case (i,hlsProps) of+ (EmptyHole _ (uh,fh)) -> Just (c, (i,Nothing), HExp t' (i `L.delete` uh,fh))+ (FilledHole _ f (uh,fh)) -> Just (c, (i,Just f), HExp t' (uh,i `delete` fh))+ (UndefHole _ _) -> Nothing+decompose _ = Nothing++-- | Decide if an element of a monoid is the unit.+isUnit :: (Eq m, Monoid m) + => m + -> Bool+isUnit m | m == mempty = True+ | otherwise = False++-- | Test to see if an expression is empty.+null :: (Eq text, Monoid text) => HExp text filling -> Bool+null (HExp (IChunk c) ([],m)) | isUnit c && M.null m = True+null _ = False++-- | Equality of t`IHExp`. Holes are ignored.+(>==>) :: Eq text + => IHExp text + -> IHExp text+ -> Bool+(IChunk chk1) >==> (IChunk chk2) = chk1 == chk2+(ICompose chk1 _ r1) >==> (ICompose chk2 _ r2) = chk1 == chk2 && r1 >==> r2+_ >==> _ = False++instance (Eq text, Eq filling) => Eq (HExp text filling) where+ (==) :: HExp text filling -> HExp text filling -> Bool+ (==) = (==>)++-- | Equality of holey expressions. Two holey expressions are considered equivalent if and only+-- if they differ by hole labels only. The contents of filled holes are included+-- in the decision.+(==>) :: (Eq text,Eq filling)+ => HExp text filling+ -> HExp text filling+ -> Bool+(HExp t1 (hls1,fhls1)) ==> (HExp t2 (hls2,fhls2)) = t1 >==> t2 && hls1 == hls2 && fhls1 == fhls2++-- | An empty hole.+empty :: Monoid text+ => Natural -- ^ Hole index+ -> HExp text filling+empty i = flip HExp ([i],M.empty) $ ICompose mempty i (IChunk mempty)++-- | A hole with a filling. +filled :: Monoid text+ => Natural -- ^ Hole index+ -> filling -- ^ Hole filling+ -> HExp text filling+filled i f + = flip HExp ([],singleton i f) $ (ICompose mempty i (IChunk mempty))++-- | A chunk is a constant; it's helpful to think of these as a piece of+-- subtext. +chunk :: text -- ^ Constant+ -> HExp text filling+chunk = flip HExp ([],M.empty) . IChunk++-- | The empty expression.+emptyExp :: Monoid text + => HExp text filling+emptyExp = chunk mempty++-- | Composition of `IHExp`.+(>+>) :: Semigroup text+ => IHExp text + -> IHExp text + -> IHExp text +(IChunk chk1) >+> (IChunk chk2) = IChunk $ chk1 <> chk2+(IChunk chk) >+> (ICompose p h r) = ICompose (chk <> p) h r+(ICompose p h r) >+> t = ICompose p h $ r >+> t++-- | Composition of holey expressions.+(+>) :: Semigroup text + => HExp text filling+ -> HExp text filling+ -> HExp text filling+(HExp t1 (ufhs1,fhs1)) +> (HExp t2 (ufhs2,fhs2)) + = HExp (t1 >+> t2) (ufhs1 `L.union` ufhs2,fhs1 `M.union` fhs2) ++instance Semigroup text => Semigroup (HExp text filling) where+ (<>) :: HExp text filling -> HExp text filling -> HExp text filling+ (<>) = (+>)++instance Monoid text => Monoid (HExp text filling) where+ mempty :: HExp text filling+ mempty = emptyExp++ mconcat :: [HExp text filling] -> HExp text filling+ mconcat = foldr (<>) emptyExp++instance Functor (HExp text) where+ fmap :: (filling1 -> filling2) -> HExp text filling1 -> HExp text filling2+ fmap f (HExp t (hls,fhls)) = HExp t $ (hls,M.map f fhls)++instance IsString text => IsString (HExp text filling) where+ fromString :: String -> HExp text filling+ fromString = Chunk . fromString++-- | A type is "text like" if it can be converted into t`Text`.+class TextLike text where+ toText :: text -> Text++instance TextLike Text where+ toText :: Text -> Text+ toText = id++instance TextLike String where+ toText :: String -> Text+ toText = DT.pack++instance TextLike Double where+ toText :: Double -> Text+ toText = DT.show++instance TextLike Int where+ toText :: Int -> Text+ toText = DT.show++instance TextLike Integer where+ toText :: Integer -> Text+ toText = DT.show++-- | Convert a holey expression's AST into a `Text`. The `Show` instance for+-- t`HExp` is set to pretty print, but for debugging it is sometimes useful to+-- see the raw AST.+showAST :: (TextLike text, TextLike filling) => HExp text filling -> Text+showAST (HExp (IChunk x) _) = "IChunk " <> (toText x)+showAST (HExp (ICompose p i r) hls@(_,fhls)) = "ICompose " <> (toText p) <> " " <> (DT.show i) <> " (" <> (DT.show . (fmap toText) $ fhls !? i) <> ") (" <> (showAST (HExp r hls)) <> ")"++-- | Get the list of unfilled-hole indices present in an expression.+-- Time complexity: \( \mathcal{O}(0) \)+unfilledHoles :: HExp text filling -- ^ HExp + -> [Natural]+unfilledHoles (HExp _ (hls,_)) = hls++-- | Get the list of filled-hole indices present in an expression.+-- Time complexity: \( \mathcal{O}(n) \)+filledHoles :: HExp text filling -- ^ HExp + -> [Natural]+filledHoles (HExp _ (_,fhls)) = keys fhls++-- | Get the filling of a hole. Returns @Nothing@ when the hole doesn't exist.+fillingInHole :: HExp text filling -- ^ HExp+ -> Natural -- ^ Hole index+ -> Maybe filling+fillingInHole (HExp _ (_,fhls)) h = fhls !? h++-- | Get the number of unfilled holes in an expression.+-- Time complexity: \( \mathcal{O}(n) \)+numberOfUnfilledHoles :: HExp text filling -- ^ HExp + -> Int+numberOfUnfilledHoles (HExp _ (hls,_)) = length hls++-- | Get the number of filled holes in an expression.+-- Time complexity: \( \mathcal{O}(n) \)+numberOfFilledHoles :: HExp text filling -- ^ HExp + -> Int+numberOfFilledHoles (HExp _ (_,fhls)) = M.size fhls++-- | Decide if an expression is filled or not. +-- Time complexity: \(\mathcal{O}(n)\)+isFilled :: HExp text filling -> Bool+isFilled t = numberOfUnfilledHoles t == 0++-- | Convert an expression with no holes, a chunk, into a text.+-- Time complexity: \( \mathcal{O}(0) \)+chunkToText :: HExp text filling + -> Maybe text+chunkToText (HExp (IChunk c) ([],fhls)) | M.null fhls = Just c+chunkToText _ = Nothing++-- | Like `update`, but doesn't update an already filled hole's value.+place :: HExp text filling+ -> Natural -- ^ Hole index to plug+ -> filling -- ^ Hole filling+ -> Maybe (HExp text filling)+place t@(HExp it hlsProps) i c =+ case (i,hlsProps) of+ EmptyHole _ (hls,fhls) -> Just $ HExp it $ (i `L.delete` hls,insert i c fhls)+ FilledHole _ _ _ -> Just $ t+ UndefHole _ _ -> Nothing++-- | Update a hole adding or removing a filling. If the hole is already filled,+-- then the filling is updated with the new value. Filling a hole doesn't+-- replace the hole, but simply puts the input @filling@ inside the hole.+-- Returns @Nothing@ if the hole doesn't exist. If the input filling is+-- `Nothing`, then the hole is emptied. The complexity of this operation+-- is \(\mathcal{O}(\max(n_0,\min(n_1,W)))\), where \(n_0\) is the number of+-- empty holes, and \(n_1\) is the number of filled holes with a max of \(W\)+-- the number of bits in an `Int` (32 or 64).+update :: HExp text filling+ -> Natural -- ^ Hole index to fill+ -> Maybe filling -- ^ Hole filling+ -> Maybe (HExp text filling)+update (HExp t hlsProps) i Nothing = + case (i,hlsProps) of+ EmptyHole _ _ -> Just $ HExp t hlsProps+ FilledHole _ _ (hls,fhls) -> Just $ HExp t (i `L.insert` hls,delete i fhls)+ UndefHole _ _ -> Nothing++update (HExp t hlsProps) i (Just c) = + case (i,hlsProps) of+ EmptyHole _ (hls,fhls) -> Just $ HExp t (i `L.delete` hls,insert i c fhls)+ FilledHole _ _ (hls,fhls) -> Just $ HExp t (hls,insert i c fhls)+ UndefHole _ _ -> Nothing++-- | Plug an unfilled hole in an expression with some filling. Returns @Nothing@ when+-- the hole index doesn't exist in the expression or is filled, otherwise returns+-- an expression with the hole plugged. Plugging a hole replaces the hole with the+-- value unlike `update`.+plugHoleI :: Semigroup text+ => (filling -> text)+ -> IHExp text+ -> [Natural] -- ^ List of unfilled holes+ -> Natural -- ^ Hole index to plug+ -> filling -- ^ Text to replace hole+ -> Maybe (IHExp text)+plugHoleI toText (ICompose p h (IChunk s)) hls i c + | i == h && h `elem` hls = Just $ IChunk $ p <> toText c <> s+plugHoleI toText (ICompose p h r@(ICompose p' h' s)) hls i c + | i == h && h `elem` hls = Just $ ICompose (p <> toText c <> p') h' s+ | otherwise = do r' <- plugHoleI toText r hls i c+ Just $ ICompose p h r'+plugHoleI _ _ _ _ _ = Nothing ++-- | Plug an unfilled hole in an expression with some filling. Returns @Nothing@ when+-- the hole index doesn't exist in the expression or is filled, otherwise returns+-- an expression with the hole plugged. Plugging a hole replaces the hole with the+-- value unlike `update`.+plug :: HoleFilling text filling + => HExp text filling+ -> Natural -- ^ Hole index to plug+ -> filling -- ^ Text to replace hole+ -> Maybe (HExp text filling)+plug (HExp t@(ICompose _ _ _) (hls,fhls)) i c | i `elem` hls = + do t' <- plugHoleI fillingToText t hls i c+ pure $ HExp t' (i `L.delete` hls,fhls)+plug _ _ _ = Nothing++-- | Plugs every hole in an expression with no filled holes using the given plug+-- function. If the plug function is defined for every hole in the input+-- expression, then this function guarantees an expression with no holes (a constant).+plugAllI + :: Semigroup text+ => (filling -> text)+ -> [Natural]+ -> (Natural -> Maybe filling) -- ^ Plug function.+ -> IHExp text -- ^ IHExp to plug.+ -> Maybe (IHExp text)+plugAllI toText hls f (ICompose chk i r) | i `elem` hls = do+ chk' <- f i+ IChunk chk'' <- plugAllI toText hls f r+ return . IChunk $ chk <> toText chk' <> chk''+plugAllI _ _ _ (ICompose _ _ _) = Nothing+plugAllI _ _ _ t@(IChunk _) = return t++-- | Plugs every hole in an expression with no filled holes using the given plug+-- function. If the plug function is defined for every hole in the input+-- expression, then this function guarantees an expression with no holes (a constant) is+-- returned.+plugAll :: HoleFilling text filling + => HExp text filling -- ^ HExp to plug+ -> ([Natural] -> (Natural -> Maybe filling)) -- ^ Plug function+ -> Maybe text+plugAll (HExp t (hls,fhls)) f | M.null fhls = + case plugAllI fillingToText hls (f hls) t of + Just (IChunk c) -> Just c+ _ -> Nothing+plugAll _ _ = Nothing++-- | In the simplest form, a type @filling@ is a hole filling if it+-- can be converted into @text@, because values of type @filling@ will+-- ultimately plug the hole they are filling. Optionally, a parser from t`Text`+-- into @filling@ can be declared as well. This makes it easier to plug a custom+-- parser in for @text@ making use of the existing parsers for the various+-- instances of t`HExp`.+class (Monoid text,Eq filling) => HoleFilling text filling where + fillingToText :: filling -> text ++ parseFilling :: Maybe (Text -> Either Text filling)+ parseFilling = Nothing ++instance HoleFilling Text String where+ fillingToText :: String -> Text+ fillingToText = DT.pack++ parseFilling :: Maybe(Text -> Either Text String)+ parseFilling = Just $ Right . DT.unpack++instance HoleFilling String Text where+ fillingToText :: Text -> String+ fillingToText = DT.unpack++ parseFilling :: Maybe(Text -> Either Text Text)+ parseFilling = Just $ Right++-- | This class is used to define generic combinators on holey expressions. Simply, this+-- is the class of types that can be converted into a t`HExp`.+class HoleFilling text filling => ToHExp text filling a where+ toHExp :: a -> HExp text filling++-- | Used to add `HoleFilling` constraints to functions that don't take in an+-- explicit t`HExp`. This is useful for writing generic functions. +data Proxy filling r = Proxy {+ runProxy :: r+}++instance (ToHExp text filling a) => ToHExp text filling (Either (HExp text filling) a) where+ toHExp :: Either (HExp text filling) a -> HExp text filling+ toHExp (Left t) = t+ toHExp (Right a) = toHExp a++instance Monoid text => HoleFilling text () where+ fillingToText :: () -> text+ fillingToText () = mempty++-- | Translates a list into an expression list where each expression in the input+-- list is separated by the input expression.+sepHExpsBy :: (ToHExp text filling a)+ => HExp text filling -- ^ Separator+ -> [a] -- ^ List of holey expressions+ -> HExp text filling+sepHExpsBy _ [] = chunk mempty+sepHExpsBy _ [v] = toHExp v+sepHExpsBy sep (v:vs) = toHExp v +> sep +> sepHExpsBy sep vs ++-- | Add a prefix and suffix holey expressions to the given value.+betweenHExp :: (ToHExp text filling a) + => HExp text filling -- ^ Prefix expression+ -> HExp text filling -- ^ Suffice expression+ -> a -- ^ Value to be converted into an expression+ -> HExp text filling+betweenHExp b a (toHExp->t) = b +> t +> a
+ src/Data/HoleyExp/Text.hs view
@@ -0,0 +1,326 @@+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# OPTIONS_GHC -Wno-orphans #-}+{-|+Module : Text+Description : Holey Expressions in Text+Copyright : (c) Harley Eades, 2026+ (c) W⋊B, 2026+Maintainer : harley.eades@gmail.com++This is the library for working with holey expressions in "Data.Text". ++If you are new to this library, it is recommended to first read over the start+of the base module "Data.HoleyExp.HExp" for an introduction to how holey+expressions work. ++Here we give a number of example holey-expressions.++A simple example:++>>> let t = (chunk "Today's Temperature: ") +> (hole 1) +> (chunk " high/") +> (hole 2) +> (chunk " low") :: HExp Text Double+>>> t+Today's Temperature: $1{} high/$2{} low++>>> plugAll t $ \_ -> \i -> if i == 1 then Just 91.2 else if i == 2 then Just 87.0 else Nothing +Just "Today's Temperature: 91.2 high/87.0 low"++The above is an example of an expression of type @HExp Text Double@ where+the first type is the type of constants which is what we are ultimately constructing a value of when all+holes are plugged, and the second type is the type of the filling we place in+the holes.++A second way we can write the same expression using @OverloadedStrings@ is:++>>> let t'' = "Today's Temperature: " <> (hole 1) <> " high/" <> (hole 2) <> " low" :: HExp Text Double+>>> t ==> t''+True++We can also add a filling to holes in an expression:++>>> "Today's Temperature: " <> (filled 1 92.2) <> " high/" <> (filled 2 91.2) <> " low" :: HExp Text Double+Today's Temperature: $1{92.2} high/$2{91.2} low++-}+module Data.HoleyExp.Text+(-- * Holey Expressions + -- | This module reexports the holey-expression base.+ module Data.HoleyExp.HExp+ -- * Text Combinators+ ,Data.Text.Text+ ,bracketHExp+ ,braceHExp+ -- ** Parsing+ ,Parser+ ,TParseError+ ,hExpParser+ ,parseHExp+ ,varParser + -- *** Helpers+ ,maybeParser+ ,doubleQuotedParser+ ,runParsecT+ -- * Text Helpers+ ,between+ ,braces+ ,brackets+ ,prettyList+ ,doubleQuote+ ,prettyDouble) where++import Data.HoleyExp.HExp++import Data.Text (Text)+import Data.Text qualified as DT+import Data.Void (Void)+import Data.NatMap (Natural)+import Data.String (IsString (fromString))+import Data.Char (isAsciiLower+ ,isAlphaNum+ ,isAscii)+import Data.Maybe (isNothing)+import Text.Megaparsec (ShowErrorComponent (..)+ ,Parsec+ ,ParseErrorBundle+ ,ParsecT+ ,MonadParsec (..)+ ,parse+ ,errorBundlePretty+ ,runParserT+ ,many+ ,choice+ ,satisfy+ ,customFailure+ ,some+ ,(<|>)+ ,atEnd+ ,skipCount)+import Text.Megaparsec.Char (string+ ,digitChar+ ,char+ ,space)+import Text.Megaparsec.Byte.Lexer (symbol)+import Text.Megaparsec qualified as MT+import Data.List qualified as L++-- | Combinator for running a `Parsec` parser with a `Text` input stream and+-- custom error messages.+runParsec :: ShowErrorComponent e => Parsec e Text b -> Text -> Either Text b+runParsec p s = case parse p "holey-expression" s of+ Left bundle -> Left . DT.pack $ errorBundlePretty bundle+ Right t -> Right t++-- | Combinator for running a `ParsecT` parser with a `Text` input stream and+-- custom error messages.+runParsecT + :: (Monad m, ShowErrorComponent e) + => (m (Either (ParseErrorBundle Text e) a) -> (Either (ParseErrorBundle Text e) a))+ -> ParsecT e Text m a+ -> Text+ -> Either Text a+runParsecT eval p s = + case eval (runParserT p "" s) of+ Left bundle -> Left . DT.pack $ errorBundlePretty bundle+ Right t -> Right t+ +instance HoleFilling Text Text where+ fillingToText :: Text -> Text+ fillingToText = id++ parseFilling :: Maybe (Text -> Either Text Text)+ parseFilling = Just $ runParsec textFillingParser+ where + textFillingParser = DT.pack <$> many charTextFillingParser++ charTextFillingParser :: Parsec TParseError Text Char+ charTextFillingParser = choice [+ satisfy (\c -> c /= '{' && c /= '}' && c /= '\\'),+ escapeCharTextFillingParser+ ]++ escapeCharTextFillingParser :: Parsec TParseError Text Char+ escapeCharTextFillingParser = do+ skip (string "\\")+ satisfy (`elem` ['{','}','\\'])++instance HoleFilling Text Int where+ fillingToText :: Int -> Text+ fillingToText = DT.show+ + parseFilling :: Maybe (Text -> Either Text Int)+ parseFilling = Just . runParsec @Void $ read <$> many digitChar++instance HoleFilling Text Double where+ fillingToText :: Double -> Text+ fillingToText = toText++ parseFilling :: Maybe (Text -> Either Text Double)+ parseFilling = Just . runParsec @Void $ p+ where+ p :: Parsec Void Text Double+ p = do d1 <- many digitChar + c <- string "." >>= pure . DT.unpack+ d2 <- many digitChar + pure . read $ d1 <> c <> d2++-- | Parses a variable as a string. Variables must begin with a lower-case ascii+-- letter, and then contain ascii alpha-numeric characters.+varParser :: Parser String+varParser = do+ -- Make sure we start with a lower-case ascii letter.+ c <- maybeParser . lookAhead $ takeWhile1P Nothing isAsciiLower+ if isNothing c+ then customFailure $ HFExpParseError "variables must begin with a lower-case letter"+ else DT.unpack <$> takeWhile1P Nothing (\c -> isAlphaNum c && isAscii c)++-- | Add brackets `[]` around the input expressions.+bracketHExp :: (ToHExp Text filling a) => a -> HExp Text filling+bracketHExp = betweenHExp (chunk "[") (chunk "]")++-- | Add braces `{}` around the input expressions.+braceHExp :: (ToHExp Text filling a) => a -> HExp Text filling+braceHExp = betweenHExp (chunk "{") (chunk "}")++-- | Parse a holey expression in t`Text`.+parseHExp :: HoleFilling Text filling => Text -> Either Text (HExp Text filling)+parseHExp s = + case parse hExpParser "holey-expression" s of+ Left bundle -> Left . DT.pack $ errorBundlePretty bundle+ Right t -> Right t++-- | Parse errors++data TParseError+ = HFExpParseError Text+ deriving (Eq,Ord,Show)++instance ShowErrorComponent TParseError where+ showErrorComponent :: TParseError -> String+ showErrorComponent err = "holy-expression-parser: " <> showErrorComponent' err+ where+ showErrorComponent' (HFExpParseError err) = DT.unpack err++-- | Type of the parsers that operate on a stream of t`Text`.+type Parser = Parsec TParseError Text ++-- | Parse a hole index (`Natural`).+holeIndexParser :: Parser Natural+holeIndexParser = do+ ds <- some digitChar+ pure . read $ ds++-- | Parser combinator that attempts to parse using the input parser, and if it+-- fails, returns @Nothing@.+maybeParser :: MonadParsec e s f => f a -> f (Maybe a)+maybeParser p = try (Just <$> p) <|> pure Nothing++-- | Parse a hole's filling which must be escaped properly.+holeFillingParser :: HoleFilling Text filling => Parser (Maybe filling)+holeFillingParser = maybe n p (parseFilling @Text)+ where+ -- If there is no filling, then skip the braces.+ n = (skip $ string "{}") >> pure Nothing++ p :: (Text -> Either Text filling) -> Parser (Maybe filling)+ p expParser = do+ f <- MT.between (char '{') (char '}') $ many $ hExpCharParser True+ if L.null f+ then pure Nothing + else do let e = expParser . DT.pack $ f+ case e of+ Left err -> customFailure $ HFExpParseError err+ Right f' -> pure . Just $ f'++-- | Parse a `Data.HExp.Hole`. That is, a pair of a hole index and a filling.+holeParser :: HoleFilling Text filling => Parser (Natural, Maybe filling)+holeParser = do+ skip (string "$")+ i <- holeIndexParser+ f <- holeFillingParser+ pure $ (i, f)++-- | Parse a `Chunk`.+chunkParser :: IsString text => Parser text+chunkParser = fromString <$> many (hExpCharParser False)++-- | Parse an expression either as a `Chunk` or a `Compose`.+hExpParser :: HoleFilling Text filling => Parser (HExp Text filling)+hExpParser = do+ mc <- chunkParser+ isEnd <- atEnd+ if isEnd+ then pure . Chunk $ mc+ else do h <- holeParser+ t <- hExpParser+ pure $ Compose mc h t++-- | Parse an expression character. These are any unicode character where the+-- characters +-- > ["$","{","}","\\"] +-- are escaped when parsing a hole's filling,+-- otherwise just @'$'@ needs to be escaped.+hExpCharParser :: Bool -> Parser Char+hExpCharParser filling = choice [+ satisfy (\c -> c /= '$' && c /= '\'' && (if filling then c /= '{' && c /= '}' else True) && c /= '\\'),+ escapedHExpCharParser+ ]++-- | Parsed an escaped character; one of, +-- > ["\\$"","\\{"","\\}","\\\\"]+-- .+escapedHExpCharParser :: Parser Char+escapedHExpCharParser = do+ skipCount 1 (char '\\')+ satisfy (\c -> c == '$' || c == '{' || c == '}' || c == '\'')++-- * Helper parsers++-- | Parse a double-quoted output of the input parser.+doubleQuotedParser :: Ord e => Parsec e Text a -> Parsec e Text a+doubleQuotedParser = MT.between (string "\"") (tok "\"")++-- * Textens++-- | Parse a Texten (unicode character)+-- Consumes whitespace *after* the parsed Texten.+tok :: Ord e => Text -> Parsec e Text Text+tok = symbol space++-- | Parse and throw away the symbol parsed by the input Texten+skip :: Parsec e Text Text -> Parsec e Text ()+skip = skipCount 1++-- | Add a prefix and a suffix to the input text.+between :: Text -> Text -> Text -> Text+between b a t = b <> t <> a++-- | Add braces around the input text.+braces :: Text -> Text+braces = between (DT.singleton '{') (DT.singleton '}')++-- | Add brackets around the input text.+brackets :: Text -> Text+brackets = between (DT.singleton '[') (DT.singleton ']')++-- | Convert the input list into a comma separated list in a human-readable+-- format. This is essentially `Data.Text.show`, but without the quoting of+-- literals.+prettyList :: (a -> Text) -> [a] -> Text+prettyList f = brackets . aux + where+ aux [] = DT.Empty+ aux [x] = f x+ aux (x:xs) = f x <> ", " <> aux xs++-- | Convert the input double into a human-readable format. This drops the+-- decimal point when the input is a whole number.+prettyDouble :: Double -> Text+prettyDouble (DT.show->n) = + case DT.break (=='.') n of+ (ds,".0") -> ds+ _ -> n++-- | Double quote the input text.+doubleQuote :: DT.Text -> DT.Text+doubleQuote = between (DT.singleton '\"') (DT.singleton '\"')
+ src/Data/NatMap.hs view
@@ -0,0 +1,114 @@+{-|+Module : NatMap+Description : Map with natural number keys+Copyright : (c) Harley Eades, 2026+ (c) W⋊B, 2026+Maintainer : harley.eades@gmail.com++This is a simple wrapper around `Data.IntMap.Lazy.IntMap` restricting the keys to the+natural numbers.+-}+module Data.NatMap (-- * Map type + NatMap+ -- * Natural numbers+ ,Natural+ ,naturalToInt+ ,intToNatural+ -- * Construction+ ,empty+ ,singleton+ -- ** From unordered lists+ ,fromList+ -- * Insertion+ ,insert+ -- * Deletion and updating+ ,delete+ -- * Query+ -- ** Lookup+ ,(!?)+ ,(!)+ -- ** Size+ ,null+ ,size+ -- * Combine+ -- ** Union+ ,union+ -- * Traversal+ -- ** Map+ ,Data.NatMap.map+ -- * Conversion + ,keys) where++import GHC.Natural (Natural)+import Data.IntMap.Lazy (IntMap)+import Data.IntMap.Lazy qualified as M+import Prelude hiding (null)++-- | A map of natural numbers to values @f@.+type NatMap f = IntMap f++-- | Convert a natural number into an integer (`Int`).+naturalToInt :: Natural -> Int+naturalToInt = fromInteger . toInteger++-- | Convert an integer (`Int`) into a natural number.+intToNatural :: Int -> Natural+intToNatural = fromInteger . toInteger++-- | Insert a new key/value pair in the map. If the key is already present in+-- the map, the associated value is replaced with the supplied value. See+-- `Data.IntMap.Lazy.insert`.+insert :: Natural -> f -> NatMap f -> NatMap f+insert (naturalToInt->k) = M.insert k++-- | Find the value at a key. Returns Nothing when the element can not be found.+-- See `(Data.IntMap.Lazy.!?)`.+(!?) :: NatMap f -> Natural -> Maybe f+m !? (naturalToInt->k) = m M.!? k++-- | Find the value at a key. Calls error when the element can not be found. See+-- `(Data.IntMap.Lazy.!)`.+(!) :: NatMap f -> Natural -> f+m ! (naturalToInt->k) = m M.! k++-- | The empty map. +-- See `Data.IntMap.Lazy.empty`.+empty :: NatMap f+empty = M.empty++-- | Is the map empty? +-- See `Data.IntMap.Lazy.null`.+null :: NatMap f -> Bool+null = M.null++-- | A map of one element. See `Data.IntMap.Lazy.singleton`.+singleton :: Natural -> f -> NatMap f+singleton (naturalToInt->k)= M.singleton k++-- | Delete a key and its value from the map. When the key is not a member of+-- the map, the original map is returned. See `Data.IntMap.Lazy.delete`.+delete :: Natural -> NatMap f -> NatMap f+delete (naturalToInt->k) = M.delete k++-- | Return all keys of the map in ascending order. +keys :: NatMap f -> [Natural]+keys = M.foldrWithKey (\k _ r -> intToNatural k : r) []++-- | Create a map from a list of key/value pairs.+fromList :: [(Natural, a)] -> IntMap a+fromList = M.fromList . Prelude.map (\(k,v) -> (naturalToInt k,v))++-- | The (left-biased) union of two maps. It prefers the first map when+-- duplicate keys are encountered.+-- See `Data.IntMap.Lazy.union`.+union :: NatMap a -> NatMap a -> NatMap a+union = M.union++-- | Map a function over all values in the map.+map :: (f1 -> f2) -> IntMap f1 -> IntMap f2+map = M.map++-- | Number of elements in the map.+-- See `Data.IntMap.Lazy.size`.+size :: NatMap f -> Int+size = M.size
+ test/Data/HoleyExp/HExpInternalSpec.hs view
@@ -0,0 +1,103 @@+{-|+Module : HExpInternalSpec+Description : Testing spec for the holey expressions API+Copyright : (c) Harley Eades, 2026+ (c) W⋊B, 2026+Maintainer : harley.eades@gmail.com++Various properties of the holey-expressions API.+-}+module Data.HoleyExp.HExpInternalSpec (spec) where++import Data.HoleyExp.HExpInternal+import Data.HoleyExp.Text+import Test.QuickCheck.HExp ()++import Test.Hspec +import Test.Helpers (parseTest)+import Test.QuickCheck (Property+ ,Testable (property))+import Test.Hspec.QuickCheck (prop)+import Test.Helpers (UnitTest(..)+ ,test_case)++spec :: Spec +spec = do+ describe "QuickCheck properties:" $ do + describe "composition" $ do+ prop "associativity" $+ prop_associativeCompose+ prop "identity" $+ prop_identityCompose+ describe "Unit Tests:" $ do+ describe "Parsing:" $ do+ describe "Holes:" $ do+ test_case "no index" test_parseFail1+ test_case "negative index" test_parseFail2+ test_case "no opening brace" test_parseFail3+ test_case "no closing brace" test_parseFail4+ test_case "non-escaped curly brace" test_parseFail5+ test_case "non-escaped backslash" test_parseFail6+ test_case "filling in unit hole" test_parseFail7++prop_associativeCompose + :: HExp Text Text+ -> HExp Text Text+ -> HExp Text Text+ -> Property+prop_associativeCompose t1 t2 t3 = property $ + t1 +> (t2 +> t3) == (t1 +> t2) +> t3++prop_identityCompose + :: HExp Text Text+ -> Property+prop_identityCompose t = property $ + (emptyExp +> t) == t && (t +> emptyExp) == t++testParseHExp :: Parser (HExp Text Text)+testParseHExp = hExpParser++testParseUnitHExp :: Parser (HExp Text ())+testParseUnitHExp = hExpParser++test_parseFail1 :: UnitTest (Maybe (HExp Text Text))+test_parseFail1 = UnitTest {+ test_result=parseTest testParseHExp "foo${a}"+ ,test_output=Nothing+ }++test_parseFail2 :: UnitTest (Maybe (HExp Text Text))+test_parseFail2 = UnitTest {+ test_result=parseTest testParseHExp "foo$-1{a}"+ ,test_output=Nothing+ }++test_parseFail3 :: UnitTest (Maybe (HExp Text Text))+test_parseFail3 = UnitTest {+ test_result=parseTest testParseHExp "foo$1a}bar"+ ,test_output=Nothing+ }++test_parseFail4 :: UnitTest (Maybe (HExp Text Text))+test_parseFail4 = UnitTest {+ test_result=parseTest testParseHExp "foo$1{abar"+ ,test_output=Nothing+ }++test_parseFail5 :: UnitTest (Maybe (HExp Text Text))+test_parseFail5 = UnitTest {+ test_result=parseTest testParseHExp "foo$1{{a}bar"+ ,test_output=Nothing+ }++test_parseFail6 :: UnitTest (Maybe (HExp Text Text))+test_parseFail6 = UnitTest {+ test_result=parseTest testParseHExp "foo$1{\\a}bar"+ ,test_output=Nothing+ }++test_parseFail7 :: UnitTest (Maybe (HExp Text ()))+test_parseFail7 = UnitTest {+ test_result=parseTest testParseUnitHExp "foo$1{aa}bar"+ ,test_output=Nothing+ }
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/Test/Helpers.hs view
@@ -0,0 +1,53 @@+{-|+Module : Helpers+Description : Useful helpers for unit testing+Copyright : (c) Harley Eades, 2026+ (c) W⋊B, 2026+Maintainer : harley.eades@gmail.com++-}+module Test.Helpers (UnitTest(..)+ ,test_case+ ,testParser + ,testParseFile+ ,parseTest) where++import Test.Hspec+import Text.Megaparsec (ParsecT+ ,ParseErrorBundle+ ,parse+ ,Parsec)+import Data.Maybe (isJust)+import Data.Either.Extra (eitherToMaybe)++-- | The type of a unit test corresponds to a pair of an output value and an+-- expected result.+data UnitTest a = UnitTest {+ test_output :: a -- ^ Output of a computation+ ,test_result :: a -- ^ Expected result of the test+}++parseTest :: Parsec e t a -> t -> Maybe a+parseTest p = eitherToMaybe . flip parse "" p++testParser :: (ParsecT e t m a -> t -> Either (ParseErrorBundle t e) a)+ -> ParsecT e t m a + -> t + -> Maybe a+testParser runParser p = eitherToMaybe . runParser p++-- | Simply, did it parse?+testParseFile :: (ParsecT e t m a -> t -> Either (ParseErrorBundle t e) a) + -> ParsecT e t m a + -> t + -> UnitTest Bool+testParseFile runParser p t = UnitTest {+ test_output = isJust $ testParser runParser p t+ ,test_result = True+ } ++test_case :: (Show a, Eq a) + => String + -> UnitTest a + -> SpecWith ()+test_case label t = it label $ (test_output t) `shouldBe` (test_result t)
+ test/Test/QuickCheck/HExp.hs view
@@ -0,0 +1,58 @@+{-|+Module : HExp+Description : Generation of random holey expressions+Copyright : (c) Harley Eades, 2026+ (c) W⋊B, 2026+Maintainer : harley.eades@gmail.com++Includes a generator for QuickCheck to randomly generate holey expressions to be+used for property-based testing.+-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeAbstractions #-}+{-# OPTIONS_GHC -Wno-orphans #-}+{-# OPTIONS_GHC -Wno-unused-imports #-}+module Test.QuickCheck.HExp+ (genHExp) where++import GHC.TypeLits (Natural)+import Test.QuickCheck (Gen+ ,Arbitrary (arbitrary)+ ,generate+ ,frequency+ ,sized)+import Test.QuickCheck.Instances.Text ()+import Test.QuickCheck.Instances.Natural ()+import Data.Functor.Identity (Identity)++import Data.HoleyExp.HExpInternal+import Data.Text (Text)+import qualified Data.IntMap as M+import Data.Maybe (isJust, isNothing)+import Data.IntMap (keys, IntMap)++genChunk :: Arbitrary text => Gen (HExp text filling)+genChunk = chunk <$> arbitrary++genHoleFilling :: Arbitrary filling => Gen (Maybe filling)+genHoleFilling @filling = sized $ \n -> + frequency+ [ (1, pure Nothing),+ (n, (arbitrary :: Gen filling) >>= (pure . Just))+ ]++genHExpNat :: (Arbitrary text, Arbitrary filling) => Natural -> Gen (HExp text filling)+genHExpNat 0 = genChunk+genHExpNat @text n = do (HExp t holeProps) <- genHExpNat $ n - 1+ h <- arbitrary :: Gen Natural+ f <- genHoleFilling+ c <- arbitrary :: Gen text+ let t' = ICompose c h t + pure $ HExp t' $ holeProps `updateFreshHolePropsWith` (h,f)++genHExp :: (Arbitrary text, Arbitrary filling) => Gen (HExp text filling)+genHExp = arbitrary >>= genHExpNat ++instance (Arbitrary text, Arbitrary filling) => Arbitrary (HExp text filling) where+ arbitrary :: Gen (HExp text filling)+ arbitrary = genHExp