betacalendars-calendar-layout (empty) → 0.1.0.0
raw patch · 20 files changed
+1094/−0 lines, 20 filesdep +basedep +betacalendars-calendar-layoutdep +time
Dependencies added: base, betacalendars-calendar-layout, time
Files
- CHANGELOG.md +6/−0
- CONTRIBUTING.md +14/−0
- LICENSE +21/−0
- README.md +132/−0
- SECURITY.md +6/−0
- betacalendars-calendar-layout.cabal +85/−0
- cabal.project +1/−0
- examples/Basic.hs +10/−0
- examples/Blank.hs +9/−0
- examples/Paper.hs +6/−0
- src/BetaCalendars/CalendarLayout.hs +36/−0
- src/BetaCalendars/CalendarLayout/Blank.hs +50/−0
- src/BetaCalendars/CalendarLayout/Boundary2027.hs +27/−0
- src/BetaCalendars/CalendarLayout/Civil.hs +141/−0
- src/BetaCalendars/CalendarLayout/Grid.hs +155/−0
- src/BetaCalendars/CalendarLayout/Paper.hs +151/−0
- src/BetaCalendars/CalendarLayout/Validation.hs +79/−0
- src/BetaCalendars/CalendarLayout/WeekStart.hs +46/−0
- src/BetaCalendars/CalendarLayout/Year2027.hs +47/−0
- test/Main.hs +72/−0
+ CHANGELOG.md view
@@ -0,0 +1,6 @@+# Changelog++## 0.1.0.0 — unreleased++- Initial calendar topology, grid, blank planner, paper geometry, 2027 fixtures,+ and validation APIs.
+ CONTRIBUTING.md view
@@ -0,0 +1,14 @@+# Contributing++Please open a GitHub issue before proposing a substantial API change. Keep+calendar arithmetic pure and deterministic, preserve explicit error results,+and add regression coverage for every behavior change.++Before submitting a change, run:++```sh+cabal check+cabal build all+cabal test all+cabal haddock all+```
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2026 Mateo Pedersen++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,132 @@+# BetaCalendars Calendar Layout Algebra++`betacalendars-calendar-layout` is a pure Haskell library for deterministic+Gregorian month topology, seven week origins, natural and fixed six-week grids,+undated planning grids, and physical print-layout measurements. It is useful+without any BetaCalendars service and performs no network access.++## Install++Add the package to a Cabal project:++```cabal+build-depends: betacalendars-calendar-layout+```++The runtime dependency surface is intentionally small: `base` and `time`.++## Quick start++```haskell+import BetaCalendars.CalendarLayout++januaryTopology :: MonthTopology+januaryTopology = monthTopology (Year 2027) January MondayStart++sundayJanuary :: MonthGrid+sundayJanuary = buildMonthGrid+ (Year 2027) January SundayStart FixedSixWeeks IncludeAdjacentDates+```++`NaturalRows` uses the actual four-to-six row month shape. `FixedSixWeeks`+always contains exactly 42 cells. Set `BlankAdjacentCells` to keep adjacent+dates out of the visible grid while retaining explicit `EmptyCell` semantics.++## Examples++January 2027 topology:++```haskell+monthTopology (Year 2027) January MondayStart+```++Compare week origins:++```haskell+monthTopology (Year 2027) January MondayStart+monthTopology (Year 2027) January SundayStart+```++Fixed 42-cell grid:++```haskell+length (gridCells (buildMonthGrid (Year 2027) January SundayStart+ FixedSixWeeks IncludeAdjacentDates)) == 42+```++A4 portrait metrics and an undated 6 × 7 planner:++```haskell+import BetaCalendars.CalendarLayout.Blank+import BetaCalendars.CalendarLayout.Paper++layoutMetrics (defaultLayoutSpec A4 Portrait 6)+blankGrid SixWeeks+```++Runnable versions of these examples are in `examples/`.++## Computed 2027 topology++The table is derived from the Gregorian calendar model. Weekday labels and row+counts are computed, not stored as hand-entered month data. “Printable+reference” links point to human-readable Beta Calendars pages.++| Month | Days | First weekday | Last weekday | Monday-first rows | Sunday-first rows | Printable reference |+|---|---:|---|---|---:|---:|+| January | 31 | Friday | Sunday | 5 | 6 | [January Calendar](https://www.betacalendars.com/january-calendar.html) |+| February | 28 | Monday | Sunday | 4 | 5 | [February Calendar](https://www.betacalendars.com/february-calendar.html) |+| March | 31 | Monday | Wednesday | 5 | 5 | [March Calendar](https://www.betacalendars.com/march-calendar.html) |+| April | 30 | Thursday | Friday | 5 | 5 | [April Calendar](https://www.betacalendars.com/april-calendar.html) |+| May | 31 | Saturday | Monday | 6 | 6 | [May Calendar](https://www.betacalendars.com/may-calendar.html) |+| June | 30 | Tuesday | Wednesday | 5 | 5 | [June Calendar](https://www.betacalendars.com/june-calendar.html) |+| July | 31 | Thursday | Saturday | 5 | 5 | [July Calendar](https://www.betacalendars.com/july-calendar.html) |+| August | 31 | Sunday | Tuesday | 6 | 5 | [August Calendar](https://www.betacalendars.com/august-calendar.html) |+| September | 30 | Wednesday | Thursday | 5 | 5 | [September Calendar](https://www.betacalendars.com/september-calendar.html) |+| October | 31 | Friday | Sunday | 5 | 6 | [October Calendar](https://www.betacalendars.com/october-calendar.html) |+| November | 30 | Monday | Tuesday | 5 | 5 | [November Calendar](https://www.betacalendars.com/november-calendar.html) |+| December | 31 | Wednesday | Friday | 5 | 5 | [December Calendar](https://www.betacalendars.com/december-calendar.html) |++## Human-readable 2027 calendar references++The library calculates calendar topology independently from Gregorian civil+rules. The following Beta Calendars pages are human-readable printable+references for visual comparison with the computed month structures.++- [Beta Calendars](https://www.betacalendars.com/)+- [Blank Calendar](https://www.betacalendars.com/blank-calendar)+- [January Calendar](https://www.betacalendars.com/january-calendar.html)+- [February Calendar](https://www.betacalendars.com/february-calendar.html)+- [March Calendar](https://www.betacalendars.com/march-calendar.html)+- [April Calendar](https://www.betacalendars.com/april-calendar.html)+- [May Calendar](https://www.betacalendars.com/may-calendar.html)+- [June Calendar](https://www.betacalendars.com/june-calendar.html)+- [July Calendar](https://www.betacalendars.com/july-calendar.html)+- [August Calendar](https://www.betacalendars.com/august-calendar.html)+- [September Calendar](https://www.betacalendars.com/september-calendar.html)+- [October Calendar](https://www.betacalendars.com/october-calendar.html)+- [November Calendar](https://www.betacalendars.com/november-calendar.html)+- [December Calendar](https://www.betacalendars.com/december-calendar.html)++## Modules++- `BetaCalendars.CalendarLayout`: curated high-level API.+- `.Civil`: Gregorian year, month, date and weekday operations.+- `.WeekStart`: week-origin rotation and offsets.+- `.Grid`: natural/fixed month grids and topology signatures.+- `.Paper`: millimetres, paper sizes, margins and layout metrics.+- `.Blank`: undated 5 × 7 and 6 × 7 planning grids.+- `.Year2027`: computed January–December 2027 fixtures.+- `.Boundary2027`: November 2026 through February 2027 fixtures.+- `.Validation`: structured validation diagnostics and the 1900–2100 matrix.++## Validation++Run `cabal check`, `cabal build all`, `cabal test all`, and `cabal haddock all`.+The deterministic test suite checks every month from 1900 through 2100 for all+seven week starts and both grid modes, along with leap-year boundaries,+paper-size/orientation combinations, blank grids, and the 2026–2027 boundary.++## License++MIT. See [LICENSE](LICENSE).
+ SECURITY.md view
@@ -0,0 +1,6 @@+# Security policy++This library performs local, pure calendar and physical-layout calculations;+it does not make network requests or process untrusted files. Please report+potential security issues privately to the maintainer email listed in the+Cabal metadata rather than publishing exploit details in an issue.
+ betacalendars-calendar-layout.cabal view
@@ -0,0 +1,85 @@+cabal-version: 2.4+name: betacalendars-calendar-layout+version: 0.1.0.0+synopsis: Pure calendar-grid topology and physical print-layout algebra+description:+ A deterministic Haskell library for Gregorian month topology, all seven+ week origins, natural and fixed six-week grids, undated planning grids,+ paper geometry, and structured validation.+category: Data, Time+license: MIT+license-file: LICENSE+author: Mateo Pedersen+maintainer: betamateopedersen@gmail.com+homepage: https://www.betacalendars.com/+bug-reports: https://github.com/mateopedersen/haskell-betacalendars-calendar-layout/issues+build-type: Simple+extra-doc-files: README.md CHANGELOG.md CONTRIBUTING.md SECURITY.md+extra-source-files: cabal.project+ examples/Basic.hs+ examples/Paper.hs+ examples/Blank.hs++library+ hs-source-dirs: src+ exposed-modules:+ BetaCalendars.CalendarLayout+ BetaCalendars.CalendarLayout.Civil+ BetaCalendars.CalendarLayout.WeekStart+ BetaCalendars.CalendarLayout.Grid+ BetaCalendars.CalendarLayout.Paper+ BetaCalendars.CalendarLayout.Blank+ BetaCalendars.CalendarLayout.Year2027+ BetaCalendars.CalendarLayout.Boundary2027+ BetaCalendars.CalendarLayout.Validation+ build-depends:+ base >=4.16 && <5+ , time >=1.11 && <2+ default-language: Haskell2010+ ghc-options: -Wall++test-suite calendar-layout-tests+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ build-depends:+ base >=4.16 && <5+ , betacalendars-calendar-layout+ default-language: Haskell2010+ ghc-options: -Wall++executable example-basic+ hs-source-dirs: examples+ main-is: Basic.hs+ build-depends:+ base >=4.16 && <5+ , betacalendars-calendar-layout+ default-language: Haskell2010+ ghc-options: -Wall++executable example-paper+ hs-source-dirs: examples+ main-is: Paper.hs+ build-depends:+ base >=4.16 && <5+ , betacalendars-calendar-layout+ default-language: Haskell2010+ ghc-options: -Wall++executable example-blank+ hs-source-dirs: examples+ main-is: Blank.hs+ build-depends:+ base >=4.16 && <5+ , betacalendars-calendar-layout+ default-language: Haskell2010+ ghc-options: -Wall++source-repository head+ type: git+ location: https://github.com/mateopedersen/haskell-betacalendars-calendar-layout++source-repository this+ type: git+ location: https://github.com/mateopedersen/haskell-betacalendars-calendar-layout+ tag: v0.1.0.0
+ cabal.project view
@@ -0,0 +1,1 @@+packages: .
+ examples/Basic.hs view
@@ -0,0 +1,10 @@+module Main (main) where++import BetaCalendars.CalendarLayout+import BetaCalendars.CalendarLayout.Year2027 (year2027Topologies)++main :: IO ()+main = do+ print (monthTopology (Year 2027) January MondayStart)+ print (length (gridCells (buildMonthGrid (Year 2027) January SundayStart FixedSixWeeks IncludeAdjacentDates)))+ print (length year2027Topologies)
+ examples/Blank.hs view
@@ -0,0 +1,9 @@+module Main (main) where++import BetaCalendars.CalendarLayout.Blank+import BetaCalendars.CalendarLayout.Paper++main :: IO ()+main = do+ print (length (blankCells (blankGrid SixWeeks)))+ print (blankLayout A4 Portrait SixWeeks)
+ examples/Paper.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import BetaCalendars.CalendarLayout.Paper++main :: IO ()+main = print (layoutMetrics (defaultLayoutSpec A4 Portrait 6))
+ src/BetaCalendars/CalendarLayout.hs view
@@ -0,0 +1,36 @@+-- | High-level API for deterministic civil calendar grids and print geometry.+-- The project homepage is <https://www.betacalendars.com/>.+module BetaCalendars.CalendarLayout+ ( Year (..)+ , Month (..)+ , allMonths+ , CivilDate+ , civilDate+ , dateYear+ , dateMonth+ , dateDay+ , Weekday (..)+ , WeekStart (..)+ , allWeekStarts+ , GridMode (..)+ , AdjacentPolicy (..)+ , CellRelation (..)+ , GridCell (..)+ , MonthGrid (..)+ , MonthTopology (..)+ , buildMonthGrid+ , monthTopology+ , Millimeters (..)+ , PaperSize (..)+ , Orientation (..)+ , Margins (..)+ , LayoutSpec (..)+ , LayoutError (..)+ , LayoutMetrics (..)+ , layoutMetrics+ ) where++import BetaCalendars.CalendarLayout.Civil+import BetaCalendars.CalendarLayout.Grid+import BetaCalendars.CalendarLayout.Paper+import BetaCalendars.CalendarLayout.WeekStart
+ src/BetaCalendars/CalendarLayout/Blank.hs view
@@ -0,0 +1,50 @@+-- | Undated planning grids; blank cells deliberately carry no civil dates.+-- See the [printable blank calendar](https://www.betacalendars.com/blank-calendar).+module BetaCalendars.CalendarLayout.Blank+ ( BlankRows (..)+ , BlankCell (..)+ , BlankGrid (..)+ , blankGrid+ , blankLayout+ , blankWritingArea+ , compareBlankLayouts+ ) where++import BetaCalendars.CalendarLayout.Paper++-- | Supported undated planner heights.+data BlankRows = FiveWeeks | SixWeeks+ deriving (Eq, Ord, Show, Read)++-- | A blank position with zero-based row and column coordinates.+data BlankCell = BlankCell+ { blankRow :: Int -- ^ Row, starting at zero.+ , blankColumn :: Int -- ^ Column, starting at zero.+ } deriving (Eq, Ord, Show, Read)++-- | A date-free rectangular planner grid.+data BlankGrid = BlankGrid+ { blankRows :: BlankRows -- ^ Five or six week rows.+ , blankColumns :: Int -- ^ Seven weekday columns.+ , blankCells :: [BlankCell] -- ^ Cells in row-major order.+ } deriving (Eq, Show)++-- | Create an undated grid with seven columns and the requested row count.+blankGrid :: BlankRows -> BlankGrid+blankGrid rows = BlankGrid rows 7 [BlankCell r c | r <- [0 .. rowCount - 1], c <- [0 .. 6]]+ where rowCount = case rows of FiveWeeks -> 5; SixWeeks -> 6++-- | Compute paper metrics for an undated grid.+blankLayout :: PaperSize -> Orientation -> BlankRows -> Either LayoutError LayoutMetrics+blankLayout paper orientation rows = layoutMetrics (defaultLayoutSpec paper orientation rowCount)+ where rowCount = case rows of FiveWeeks -> 5; SixWeeks -> 6++-- | Usable writing area in square millimetres.+blankWritingArea :: LayoutMetrics -> Rational+blankWritingArea = writingArea++-- | Signed ratio of usable writing areas; zero is returned for a zero baseline.+compareBlankLayouts :: LayoutMetrics -> LayoutMetrics -> Rational+compareBlankLayouts a b+ | writingArea b == 0 = 0+ | otherwise = writingArea a / writingArea b
+ src/BetaCalendars/CalendarLayout/Boundary2027.hs view
@@ -0,0 +1,27 @@+-- | Computed regression fixtures spanning the 2026–2027 year boundary.+-- Printable comparisons: [November](https://www.betacalendars.com/november-calendar.html),+-- [December](https://www.betacalendars.com/december-calendar.html),+-- [January](https://www.betacalendars.com/january-calendar.html), and+-- [February](https://www.betacalendars.com/february-calendar.html).+module BetaCalendars.CalendarLayout.Boundary2027+ ( boundary2027Months+ , boundary2027Grids+ ) where++import BetaCalendars.CalendarLayout.Civil+import BetaCalendars.CalendarLayout.Grid+import BetaCalendars.CalendarLayout.WeekStart++-- | November and December 2026 followed by January and February 2027.+boundary2027Months :: [(Year, Month)]+boundary2027Months =+ [ (Year 2026, November)+ , (Year 2026, December)+ , (Year 2027, January)+ , (Year 2027, February)+ ]++-- | Monday-first natural month grids for 'boundary2027Months'.+boundary2027Grids :: [MonthGrid]+boundary2027Grids =+ [buildMonthGrid y m MondayStart NaturalRows IncludeAdjacentDates | (y, m) <- boundary2027Months]
+ src/BetaCalendars/CalendarLayout/Civil.hs view
@@ -0,0 +1,141 @@+-- | Proleptic Gregorian civil dates and month boundaries. No time zone or+-- timestamp semantics are involved.+module BetaCalendars.CalendarLayout.Civil+ ( Year (..)+ , Month (..)+ , allMonths+ , CivilDate+ , civilDate+ , civilDateDay+ , dateYear+ , dateMonth+ , dateDay+ , Weekday (..)+ , weekdayOf+ , isLeapYear+ , daysInMonth+ , firstDate+ , lastDate+ , firstWeekday+ , lastWeekday+ , nextCivilDate+ , previousCivilDate+ ) where++import Data.Time.Calendar (Day, addDays, dayOfWeek, fromGregorian, fromGregorianValid, toGregorian)+import qualified Data.Time.Calendar.WeekDate as W++-- | A Gregorian calendar year. 'Integer' avoids an artificial machine-year limit.+newtype Year = Year+ { unYear :: Integer -- ^ Numeric Gregorian year.+ }+ deriving (Eq, Ord, Show)++-- | The twelve Gregorian months, in calendar order. The constructor order is+-- January through December and is used by 'allMonths'.+data Month = January | February | March | April | May | June+ | July | August | September | October | November | December+ deriving (Eq, Ord, Enum, Bounded, Show, Read)++-- | Months in chronological order from January to December.+allMonths :: [Month]+allMonths = [minBound .. maxBound]++-- | A valid Gregorian civil date, represented internally by @time@'s 'Day'.+newtype CivilDate = CivilDate+ { civilDateDay :: Day -- ^ Underlying day value.+ }+ deriving (Eq, Ord, Show)++-- | Construct a date, returning 'Nothing' for an invalid month day.+civilDate :: Year -> Month -> Int -> Maybe CivilDate+civilDate (Year y) m d = CivilDate <$> fromGregorianValid y (monthNumber m) d++-- | Year component of a valid civil date.+dateYear :: CivilDate -> Year+dateYear (CivilDate d) = let (y, _, _) = toGregorian d in Year y++-- | Month component of a valid civil date.+dateMonth :: CivilDate -> Month+dateMonth (CivilDate d) = let (_, m, _) = toGregorian d in monthFromNumber m++-- | Day-of-month component, in the range 1–31.+dateDay :: CivilDate -> Int+dateDay (CivilDate d) = let (_, _, day) = toGregorian d in day++-- | Monday-based weekday names, ordered Monday through Sunday.+data Weekday = Monday | Tuesday | Wednesday | Thursday | Friday | Saturday | Sunday+ deriving (Eq, Ord, Enum, Bounded, Show, Read)++-- | Weekday of a valid civil date.+weekdayOf :: CivilDate -> Weekday+weekdayOf (CivilDate d) = case dayOfWeek d of+ W.Monday -> Monday+ W.Tuesday -> Tuesday+ W.Wednesday -> Wednesday+ W.Thursday -> Thursday+ W.Friday -> Friday+ W.Saturday -> Saturday+ W.Sunday -> Sunday++-- | Gregorian leap-year rule, including century exceptions.+isLeapYear :: Year -> Bool+isLeapYear (Year y) = y `mod` 4 == 0 && (y `mod` 100 /= 0 || y `mod` 400 == 0)++-- | Number of days in a month.+daysInMonth :: Year -> Month -> Int+daysInMonth y m = case m of+ January -> 31+ February -> if isLeapYear y then 29 else 28+ March -> 31+ April -> 30+ May -> 31+ June -> 30+ July -> 31+ August -> 31+ September -> 30+ October -> 31+ November -> 30+ December -> 31++-- | First civil date in a month.+firstDate :: Year -> Month -> CivilDate+firstDate y m = CivilDate (fromGregorian (unYear y) (monthNumber m) 1)++-- | Last civil date in a month.+lastDate :: Year -> Month -> CivilDate+lastDate y m = CivilDate (fromGregorian (unYear y) (monthNumber m) (daysInMonth y m))++-- | Weekday of the first date in a month.+firstWeekday :: Year -> Month -> Weekday+firstWeekday year month = weekdayOf (firstDate year month)++-- | Weekday of the last date in a month.+lastWeekday :: Year -> Month -> Weekday+lastWeekday year month = weekdayOf (lastDate year month)++-- | Following civil day.+nextCivilDate :: CivilDate -> CivilDate+nextCivilDate (CivilDate d) = CivilDate (addDays 1 d)++-- | Previous civil day.+previousCivilDate :: CivilDate -> CivilDate+previousCivilDate (CivilDate d) = CivilDate (addDays (-1) d)++monthNumber :: Month -> Int+monthNumber = (+ 1) . fromEnum++monthFromNumber :: Int -> Month+monthFromNumber n = case n of+ 1 -> January+ 2 -> February+ 3 -> March+ 4 -> April+ 5 -> May+ 6 -> June+ 7 -> July+ 8 -> August+ 9 -> September+ 10 -> October+ 11 -> November+ _ -> December
+ src/BetaCalendars/CalendarLayout/Grid.hs view
@@ -0,0 +1,155 @@+-- | Pure month-grid construction and descriptive topology values.+module BetaCalendars.CalendarLayout.Grid+ ( GridMode (..)+ , AdjacentPolicy (..)+ , CellRelation (..)+ , GridCell (..)+ , MonthGrid (..)+ , MonthTopology (..)+ , TopologySignature (..)+ , buildMonthGrid+ , monthTopology+ , naturalRowCount+ , leadingCellCount+ , trailingCellCount+ , gridOccupancy+ , topologySignature+ ) where++import BetaCalendars.CalendarLayout.Civil+import BetaCalendars.CalendarLayout.WeekStart++-- | Use the month’s natural shape or a fixed 6 × 7 page grid.+data GridMode = NaturalRows | FixedSixWeeks+ deriving (Eq, Ord, Show, Read)++-- | Whether out-of-month grid positions show dates or remain undated blanks.+data AdjacentPolicy = IncludeAdjacentDates | BlankAdjacentCells+ deriving (Eq, Ord, Show, Read)++-- | Semantic relation of a cell to the requested month.+data CellRelation = PreviousMonth | CurrentMonth | NextMonth | EmptyCell+ deriving (Eq, Ord, Show, Read)++-- | One month-grid position and its date, if one is shown.+data GridCell = GridCell+ { cellDate :: Maybe CivilDate -- ^ No date for an intentionally blank cell.+ , cellRelation :: CellRelation -- ^ Position’s semantic relation.+ } deriving (Eq, Show)++-- | A row-major rectangular month grid with its construction parameters.+data MonthGrid = MonthGrid+ { gridYear :: Year -- ^ Requested civil year.+ , gridMonth :: Month -- ^ Requested month.+ , gridWeekStart :: WeekStart -- ^ First weekday in each row.+ , gridMode :: GridMode -- ^ Natural or fixed six-week shape.+ , gridAdjacentPolicy :: AdjacentPolicy -- ^ Visibility of adjacent dates.+ , gridRows :: Int -- ^ Number of rows in the result.+ , gridCells :: [GridCell] -- ^ Cells in row-major order.+ } deriving (Eq, Show)++-- | Week-origin-specific structure of a Gregorian month.+data MonthTopology = MonthTopology+ { topologyDays :: Int -- ^ Number of dates in the month.+ , topologyFirstWeekday :: Weekday -- ^ Weekday of its first date.+ , topologyLastWeekday :: Weekday -- ^ Weekday of its last date.+ , topologyLeadingCells :: Int -- ^ Cells before the first date.+ , topologyTrailingCells :: Int -- ^ Cells after the last date in a natural grid.+ , topologyNaturalRows :: Int -- ^ Natural row count, from four through six.+ , topologyFixedCells :: Int -- ^ Fixed grid size, always 42.+ } deriving (Eq, Show)++-- | Library-specific summary; not a standardized calendar metric.+data TopologySignature = TopologySignature+ { signatureDays :: Int -- ^ Current-month cell count.+ , signatureStartOffset :: Int -- ^ Leading-cell count.+ , signatureNaturalRows :: Int -- ^ Natural row count.+ , signatureTrailingCapacity :: Int -- ^ Trailing cells in the natural grid.+ } deriving (Eq, Ord, Show, Read)++-- | Build a deterministic month grid for any week origin and adjacent policy.+buildMonthGrid :: Year -> Month -> WeekStart -> GridMode -> AdjacentPolicy -> MonthGrid+buildMonthGrid year month weekStart mode policy = MonthGrid+ { gridYear = year+ , gridMonth = month+ , gridWeekStart = weekStart+ , gridMode = mode+ , gridAdjacentPolicy = policy+ , gridRows = rows+ , gridCells = map makeCell offsets+ }+ where+ leading = leadingCellCount year month weekStart+ count = daysInMonth year month+ naturalCells = leading + count+ rows = case mode of+ NaturalRows -> (naturalCells + 6) `div` 7+ FixedSixWeeks -> 6+ size = rows * 7+ first = firstDate year month+ offsets = [-leading .. size - leading - 1]+ makeCell n =+ let date = shiftDate first n+ relation = relationTo year month date+ visibleDate = case (policy, relation) of+ (BlankAdjacentCells, CurrentMonth) -> Just date+ (BlankAdjacentCells, _) -> Nothing+ (IncludeAdjacentDates, _) -> Just date+ in GridCell visibleDate (if visibleDate == Nothing then EmptyCell else relation)++-- | Describe the month’s topology for one configured week origin.+monthTopology :: Year -> Month -> WeekStart -> MonthTopology+monthTopology year month start = MonthTopology+ { topologyDays = daysInMonth year month+ , topologyFirstWeekday = firstWeekday year month+ , topologyLastWeekday = lastWeekday year month+ , topologyLeadingCells = leading+ , topologyTrailingCells = naturalRows * 7 - leading - daysInMonth year month+ , topologyNaturalRows = naturalRows+ , topologyFixedCells = 42+ }+ where+ leading = leadingCellCount year month start+ naturalRows = naturalRowCount year month start++-- | Natural row count, which is always four, five, or six.+naturalRowCount :: Year -> Month -> WeekStart -> Int+naturalRowCount year month start = (leadingCellCount year month start + daysInMonth year month + 6) `div` 7++-- | Number of cells before the first day under the selected week origin.+leadingCellCount :: Year -> Month -> WeekStart -> Int+leadingCellCount year month start = offsetFromWeekStart start (firstWeekday year month)++-- | Number of cells after the last day in a natural grid.+trailingCellCount :: Year -> Month -> WeekStart -> Int+trailingCellCount year month start = naturalRowCount year month start * 7 - leadingCellCount year month start - daysInMonth year month++-- | Fraction of the grid occupied by current-month dates; empty grids yield 0.+gridOccupancy :: MonthGrid -> Rational+gridOccupancy grid+ | null (gridCells grid) = 0+ | otherwise = fromIntegral current / fromIntegral (length (gridCells grid))+ where current = length (filter ((== CurrentMonth) . cellRelation) (gridCells grid))++-- | Convert a topology to this library’s descriptive signature value.+topologySignature :: MonthTopology -> TopologySignature+topologySignature t = TopologySignature+ (topologyDays t) (topologyLeadingCells t) (topologyNaturalRows t) (topologyTrailingCells t)++shiftDate :: CivilDate -> Int -> CivilDate+shiftDate date n = case civilDate (dateYear date) (dateMonth date) (dateDay date + n) of+ Just result -> result+ Nothing -> shiftAcrossMonth date n++-- Calendar arithmetic through adjacent month boundaries without partial functions.+shiftAcrossMonth :: CivilDate -> Int -> CivilDate+shiftAcrossMonth date n+ | n < 0 = shiftAcrossMonth (previousCivilDate date) (n + 1)+ | n > 0 = shiftAcrossMonth (nextCivilDate date) (n - 1)+ | otherwise = date++relationTo :: Year -> Month -> CivilDate -> CellRelation+relationTo y m date+ | dateYear date == y && dateMonth date == m = CurrentMonth+ | date < firstDate y m = PreviousMonth+ | otherwise = NextMonth
+ src/BetaCalendars/CalendarLayout/Paper.hs view
@@ -0,0 +1,151 @@+-- | Physical paper dimensions and deterministic printable-grid geometry.+-- Printable comparisons: [blank](https://www.betacalendars.com/blank-calendar),+-- [January](https://www.betacalendars.com/january-calendar.html),+-- [July](https://www.betacalendars.com/july-calendar.html), and+-- [December](https://www.betacalendars.com/december-calendar.html).+module BetaCalendars.CalendarLayout.Paper+ ( Millimeters (..)+ , PaperSize (..)+ , Orientation (..)+ , Margins (..)+ , LayoutSpec (..)+ , LayoutError (..)+ , LayoutMetrics (..)+ , paperDimensions+ , layoutMetrics+ , defaultLayoutSpec+ ) where++-- | Exact physical distance in millimetres, represented as a rational number.+newtype Millimeters = Millimeters+ { unMillimeters :: Rational -- ^ Exact distance; this is not a CSS pixel value.+ }+ deriving (Eq, Ord, Show, Read)++-- | Standard page sizes or a custom width and height.+data PaperSize+ = A4 -- ^ ISO 216 A4, 210 × 297 mm.+ | A5 -- ^ ISO 216 A5, 148 × 210 mm.+ | Letter -- ^ US Letter, 215.9 × 279.4 mm.+ | Legal -- ^ US Legal, 215.9 × 355.6 mm.+ | CustomPaper Millimeters Millimeters -- ^ Custom width followed by height.+ deriving (Eq, Ord, Show, Read)++-- | Page orientation; landscape swaps the width and height.+data Orientation = Portrait | Landscape+ deriving (Eq, Ord, Show, Read)++-- | Distances between printable content and the four page edges.+data Margins = Margins+ { marginTop :: Millimeters -- ^ Top edge margin.+ , marginRight :: Millimeters -- ^ Right edge margin.+ , marginBottom :: Millimeters -- ^ Bottom edge margin.+ , marginLeft :: Millimeters -- ^ Left edge margin.+ } deriving (Eq, Ord, Show, Read)++-- | Inputs defining a rectangular grid and reserved title/header/notes bands.+data LayoutSpec = LayoutSpec+ { layoutPaper :: PaperSize -- ^ Physical sheet.+ , layoutOrientation :: Orientation -- ^ Portrait or landscape.+ , layoutMargins :: Margins -- ^ Edge clearances.+ , layoutTitleHeight :: Millimeters -- ^ Height reserved for a title.+ , layoutWeekdayHeaderHeight :: Millimeters -- ^ Height reserved for weekday labels.+ , layoutNotesHeight :: Millimeters -- ^ Height reserved for notes.+ , layoutRows :: Int -- ^ Positive number of grid rows.+ , layoutColumns :: Int -- ^ Positive number of grid columns.+ } deriving (Eq, Show, Read)++-- | Reasons a proposed paper layout cannot produce positive cell geometry.+data LayoutError+ = InvalidPaperDimensions -- ^ Page width or height is not positive.+ | InvalidMargins -- ^ At least one edge margin is negative.+ | InvalidGridDimensions -- ^ Row or column count is not positive.+ | InvalidReservedArea -- ^ A reserved band has negative height.+ | ReservedAreaOverflow -- ^ Reserved bands leave no room for the grid.+ | NonPositivePrintableArea -- ^ Margins leave no positive printable rectangle.+ | NonPositiveCellGeometry -- ^ Computed cell width or height is not positive.+ deriving (Eq, Ord, Show, Read)++-- | Derived page, printable region, grid, and cell measurements.+data LayoutMetrics = LayoutMetrics+ { pageWidth :: Millimeters -- ^ Oriented page width.+ , pageHeight :: Millimeters -- ^ Oriented page height.+ , printableWidth :: Millimeters -- ^ Width after left/right margins.+ , printableHeight :: Millimeters -- ^ Height after top/bottom margins.+ , gridWidth :: Millimeters -- ^ Width occupied by the grid.+ , gridHeight :: Millimeters -- ^ Height occupied by the grid.+ , cellWidth :: Millimeters -- ^ Width of each equal grid column.+ , cellHeight :: Millimeters -- ^ Height of each equal grid row.+ , cellArea :: Rational -- ^ Area of one cell in square millimetres.+ , writingArea :: Rational -- ^ Grid area in square millimetres.+ } deriving (Eq, Show, Read)++-- | Exact dimensions for standard and custom paper sizes, before orientation.+paperDimensions :: PaperSize -> (Millimeters, Millimeters)+paperDimensions size = case size of+ A4 -> (mm 210, mm 297)+ A5 -> (mm 148, mm 210)+ Letter -> (mmFraction 2159 10, mmFraction 2794 10)+ Legal -> (mmFraction 2159 10, mmFraction 3556 10)+ CustomPaper w h -> (w, h)++-- | A useful default with 12 mm margins, 18 mm title, 8 mm weekday band,+-- and 20 mm notes band, using seven columns.+defaultLayoutSpec :: PaperSize -> Orientation -> Int -> LayoutSpec+defaultLayoutSpec paper orientation rows = LayoutSpec+ { layoutPaper = paper+ , layoutOrientation = orientation+ , layoutMargins = Margins (mm 12) (mm 12) (mm 12) (mm 12)+ , layoutTitleHeight = mm 18+ , layoutWeekdayHeaderHeight = mm 8+ , layoutNotesHeight = mm 20+ , layoutRows = rows+ , layoutColumns = 7+ }++-- | Validate a layout and compute exact dimensions, or return a domain error.+layoutMetrics :: LayoutSpec -> Either LayoutError LayoutMetrics+layoutMetrics spec+ | width <= 0 || height <= 0 = Left InvalidPaperDimensions+ | any (< 0) margins = Left InvalidMargins+ | layoutRows spec <= 0 || layoutColumns spec <= 0 = Left InvalidGridDimensions+ | any (< 0) reserved = Left InvalidReservedArea+ | printableW <= 0 || printableH <= 0 = Left NonPositivePrintableArea+ | gridH <= 0 = Left ReservedAreaOverflow+ | cellW <= 0 || cellH <= 0 = Left NonPositiveCellGeometry+ | otherwise = Right LayoutMetrics+ { pageWidth = Millimeters pageW+ , pageHeight = Millimeters pageH+ , printableWidth = Millimeters printableW+ , printableHeight = Millimeters printableH+ , gridWidth = Millimeters printableW+ , gridHeight = Millimeters gridH+ , cellWidth = Millimeters cellW+ , cellHeight = Millimeters cellH+ , cellArea = cellW * cellH+ , writingArea = printableW * gridH+ }+ where+ (paperW, paperH) = paperDimensions (layoutPaper spec)+ (width, height) = case layoutOrientation spec of+ Portrait -> (unMillimeters paperW, unMillimeters paperH)+ Landscape -> (unMillimeters paperH, unMillimeters paperW)+ (top, right, bottom, left) = toTuple (layoutMargins spec)+ pageW = width+ pageH = height+ margins = [top, right, bottom, left]+ printableW = width - right - left+ printableH = height - top - bottom+ reserved = [unMillimeters (layoutTitleHeight spec), unMillimeters (layoutWeekdayHeaderHeight spec), unMillimeters (layoutNotesHeight spec)]+ gridH = printableH - sum reserved+ cellW = printableW / fromIntegral (layoutColumns spec)+ cellH = gridH / fromIntegral (layoutRows spec)++mm :: Integer -> Millimeters+mm = Millimeters . fromInteger++mmFraction :: Integer -> Integer -> Millimeters+mmFraction n d = Millimeters (fromInteger n / fromInteger d)++toTuple :: Margins -> (Rational, Rational, Rational, Rational)+toTuple m = (unMillimeters (marginTop m), unMillimeters (marginRight m), unMillimeters (marginBottom m), unMillimeters (marginLeft m))
+ src/BetaCalendars/CalendarLayout/Validation.hs view
@@ -0,0 +1,79 @@+-- | Diagnostic validators for grids, finite date ranges and paper geometry.+module BetaCalendars.CalendarLayout.Validation+ ( ValidationIssue (..)+ , validateMonthGrid+ , validateDateCompleteness+ , validateFixedGrid+ , validatePaperLayout+ , validateYear+ , validateBoundaryFixture+ , validateFiniteRange+ ) where++import BetaCalendars.CalendarLayout.Boundary2027 (boundary2027Grids)+import BetaCalendars.CalendarLayout.Civil+import BetaCalendars.CalendarLayout.Grid+import BetaCalendars.CalendarLayout.Paper+import BetaCalendars.CalendarLayout.WeekStart++-- | Structured failure details returned by the reusable validators.+data ValidationIssue+ = WrongCellCount Int Int+ | WrongRowCount Int Int+ | MissingCurrentDates [Int]+ | DuplicateCurrentDates [Int]+ | InvalidNaturalRows Int+ | WrongBoundaryFixtureLength Int Int+ deriving (Eq, Show)++-- | Check row count, cell count, current-date completeness, and mode invariants.+validateMonthGrid :: MonthGrid -> [ValidationIssue]+validateMonthGrid grid = validateDateCompleteness grid ++ rowIssues ++ fixedIssues+ where+ expectedRows = case gridMode grid of+ NaturalRows -> naturalRowCount (gridYear grid) (gridMonth grid) (gridWeekStart grid)+ FixedSixWeeks -> 6+ expectedCells = expectedRows * 7+ rowIssues =+ [WrongRowCount expectedRows (gridRows grid) | gridRows grid /= expectedRows]+ ++ [WrongCellCount expectedCells (length (gridCells grid)) | length (gridCells grid) /= expectedCells]+ ++ [InvalidNaturalRows (gridRows grid) | gridMode grid == NaturalRows && not (gridRows grid >= 4 && gridRows grid <= 6)]+ fixedIssues = [WrongCellCount 42 (length (gridCells grid)) | gridMode grid == FixedSixWeeks && length (gridCells grid) /= 42]++-- | Verify every current-month date occurs exactly once.+validateDateCompleteness :: MonthGrid -> [ValidationIssue]+validateDateCompleteness grid = missingIssue ++ duplicateIssue+ where+ observed = [dateDay d | cell <- gridCells grid, cellRelation cell == CurrentMonth, Just d <- [cellDate cell]]+ expected = [1 .. daysInMonth (gridYear grid) (gridMonth grid)]+ missing = filter (`notElem` observed) expected+ duplicates = [d | d <- expected, length (filter (== d) observed) > 1]+ missingIssue = [MissingCurrentDates missing | not (null missing)]+ duplicateIssue = [DuplicateCurrentDates duplicates | not (null duplicates)]++-- | Check the 42-cell invariant when the supplied grid is fixed mode.+validateFixedGrid :: MonthGrid -> [ValidationIssue]+validateFixedGrid grid+ | gridMode grid /= FixedSixWeeks = []+ | length (gridCells grid) == 42 && gridRows grid == 6 = validateDateCompleteness grid+ | otherwise = [WrongCellCount 42 (length (gridCells grid))]++-- | Validate paper geometry and return computed metrics on success.+validatePaperLayout :: LayoutSpec -> Either LayoutError LayoutMetrics+validatePaperLayout = layoutMetrics++-- | Validate all months, week origins, and both grid modes for one year.+validateYear :: Year -> [ValidationIssue]+validateYear y = concat+ [validateMonthGrid (buildMonthGrid y m start mode IncludeAdjacentDates)+ | m <- allMonths, start <- allWeekStarts, mode <- [NaturalRows, FixedSixWeeks]]++-- | Validate the four-month fixture spanning the 2026–2027 year boundary.+validateBoundaryFixture :: [ValidationIssue]+validateBoundaryFixture+ | length boundary2027Grids == 4 = concatMap validateMonthGrid boundary2027Grids+ | otherwise = [WrongBoundaryFixtureLength 4 (length boundary2027Grids)]++-- | Validate every month from 1900 through 2100 for all seven origins and modes.+validateFiniteRange :: [ValidationIssue]+validateFiniteRange = concatMap validateYear [Year y | y <- [1900 .. 2100]]
+ src/BetaCalendars/CalendarLayout/WeekStart.hs view
@@ -0,0 +1,46 @@+-- | Week-origin arithmetic for all seven possible first weekdays.+module BetaCalendars.CalendarLayout.WeekStart+ ( WeekStart (..)+ , allWeekStarts+ , weekdayIndex+ , relativeWeekdayIndex+ , offsetFromWeekStart+ , rotateWeekOrigin+ ) where++import BetaCalendars.CalendarLayout.Civil (Weekday (..))++-- | Configurable first weekday for a displayed week.+data WeekStart = MondayStart | TuesdayStart | WednesdayStart | ThursdayStart+ | FridayStart | SaturdayStart | SundayStart+ deriving (Eq, Ord, Enum, Bounded, Show, Read)++-- | All seven week origins in Monday-to-Sunday order.+allWeekStarts :: [WeekStart]+allWeekStarts = [minBound .. maxBound]++-- | Monday is 0 and Sunday is 6.+-- | Monday-based zero-index of a weekday.+weekdayIndex :: Weekday -> Int+weekdayIndex = fromEnum++-- | Index of a weekday in a week whose first day is the given origin.+-- | Zero-index of a weekday relative to a selected week origin.+relativeWeekdayIndex :: WeekStart -> Weekday -> Int+relativeWeekdayIndex origin weekday = (weekdayIndex weekday - startIndex origin) `mod` 7++-- | Number of leading cells before the first day of a month.+-- | Leading-cell count for a date with the given weekday.+offsetFromWeekStart :: WeekStart -> Weekday -> Int+offsetFromWeekStart = relativeWeekdayIndex++-- | Rotate weekdays so that the configured origin appears first.+-- | Monday-to-Sunday weekdays rotated to start at the selected origin.+rotateWeekOrigin :: WeekStart -> [Weekday]+rotateWeekOrigin origin = take 7 (drop start (weekdays ++ weekdays))+ where+ weekdays = [Monday .. Sunday]+ start = startIndex origin++startIndex :: WeekStart -> Int+startIndex = fromEnum
+ src/BetaCalendars/CalendarLayout/Year2027.hs view
@@ -0,0 +1,47 @@+-- | Computed structural fixtures for the 2027 calendar year.+-- Printable comparisons: [Beta Calendars](https://www.betacalendars.com/),+-- [January](https://www.betacalendars.com/january-calendar.html),+-- [February](https://www.betacalendars.com/february-calendar.html),+-- [March](https://www.betacalendars.com/march-calendar.html),+-- [April](https://www.betacalendars.com/april-calendar.html),+-- [May](https://www.betacalendars.com/may-calendar.html),+-- [June](https://www.betacalendars.com/june-calendar.html),+-- [July](https://www.betacalendars.com/july-calendar.html),+-- [August](https://www.betacalendars.com/august-calendar.html),+-- [September](https://www.betacalendars.com/september-calendar.html),+-- [October](https://www.betacalendars.com/october-calendar.html),+-- [November](https://www.betacalendars.com/november-calendar.html),+-- [December](https://www.betacalendars.com/december-calendar.html).+module BetaCalendars.CalendarLayout.Year2027+ ( year2027Topologies+ , mondayFirst2027+ , sundayFirst2027+ , fixedGridOccupancy2027+ ) where++import BetaCalendars.CalendarLayout.Civil+import BetaCalendars.CalendarLayout.Grid+import BetaCalendars.CalendarLayout.WeekStart++-- | Monday-first computed topology for each month of 2027.+year2027Topologies :: [(Month, MonthTopology)]+year2027Topologies = [(m, monthTopology year2027 m MondayStart) | m <- allMonths]++-- | Natural grids for every 2027 month, starting weeks on Monday.+mondayFirst2027 :: [MonthGrid]+mondayFirst2027 = grids MondayStart NaturalRows++-- | Natural grids for every 2027 month, starting weeks on Sunday.+sundayFirst2027 :: [MonthGrid]+sundayFirst2027 = grids SundayStart NaturalRows++-- | Current-month occupancy fractions for fixed six-week 2027 grids.+fixedGridOccupancy2027 :: [(Month, Rational)]+fixedGridOccupancy2027 =+ [(m, gridOccupancy (buildMonthGrid year2027 m MondayStart FixedSixWeeks IncludeAdjacentDates)) | m <- allMonths]++year2027 :: Year+year2027 = Year 2027++grids :: WeekStart -> GridMode -> [MonthGrid]+grids start mode = [buildMonthGrid year2027 m start mode IncludeAdjacentDates | m <- allMonths]
+ test/Main.hs view
@@ -0,0 +1,72 @@+module Main (main) where++import BetaCalendars.CalendarLayout.Blank+import BetaCalendars.CalendarLayout.Boundary2027+import BetaCalendars.CalendarLayout.Civil+import BetaCalendars.CalendarLayout.Grid+import BetaCalendars.CalendarLayout.Paper+import BetaCalendars.CalendarLayout.Validation+import BetaCalendars.CalendarLayout.WeekStart+import System.Exit (exitFailure)++main :: IO ()+main = do+ let finite =+ [ (show y ++ "/" ++ show m ++ "/" ++ show start ++ "/" ++ show mode,+ let grid = buildMonthGrid y m start mode IncludeAdjacentDates+ firstCurrent = case [i | (i, cell) <- zip [0 ..] (gridCells grid), cellRelation cell == CurrentMonth] of+ i : _ -> i+ [] -> -1+ expectedOffset = offsetFromWeekStart start (firstWeekday y m)+ in null (validateMonthGrid grid)+ && firstCurrent == expectedOffset+ && (mode /= FixedSixWeeks || length (gridCells grid) == 42))+ | y <- [Year n | n <- [1900 .. 2100]]+ , m <- allMonths+ , start <- allWeekStarts+ , mode <- [NaturalRows, FixedSixWeeks]+ ]+ leaps =+ [ ("1900 common", not (isLeapYear (Year 1900)))+ , ("2000 leap", isLeapYear (Year 2000))+ , ("2024 leap", isLeapYear (Year 2024))+ , ("2027 common", not (isLeapYear (Year 2027)))+ , ("2100 common", not (isLeapYear (Year 2100)))+ , ("2400 leap", isLeapYear (Year 2400))+ ]+ papers =+ [ (show paper ++ " " ++ show orientation,+ case layoutMetrics (defaultLayoutSpec paper orientation 6) of+ Right metrics -> unMillimeters (cellWidth metrics) > 0+ && unMillimeters (cellHeight metrics) > 0 && cellArea metrics > 0+ Left _ -> False)+ | paper <- [A4, A5, Letter, Legal]+ , orientation <- [Portrait, Landscape]+ ]+ blankChecks =+ [ ("blank five weeks", length (blankCells (blankGrid FiveWeeks)) == 35)+ , ("blank six weeks", length (blankCells (blankGrid SixWeeks)) == 42)+ , ("blank adjacent dates", all ((== EmptyCell) . cellRelation)+ (take 4 (gridCells (buildMonthGrid (Year 2027) January MondayStart NaturalRows BlankAdjacentCells))))+ ]+ boundaryChecks =+ [ ("Nov 2026 has 30 days", daysInMonth (Year 2026) November == 30)+ , ("Dec 2026 has 31 days", daysInMonth (Year 2026) December == 31)+ , ("Feb 2027 has 28 days", daysInMonth (Year 2027) February == 28)+ , ("year transition", dateYear (nextCivilDate (lastDate (Year 2026) December)) == Year 2027)+ , ("boundary fixture validation", null validateBoundaryFixture && length boundary2027Grids == 4)+ ]+ invalidLayout = (defaultLayoutSpec A4 Portrait 6)+ { layoutMargins = Margins (Millimeters (-1)) (Millimeters 12) (Millimeters 12) (Millimeters 12) }+ overflowLayout = (defaultLayoutSpec A4 Portrait 6) { layoutNotesHeight = Millimeters 1000 }+ invalidChecks =+ [ ("negative margin rejected", case layoutMetrics invalidLayout of Left InvalidMargins -> True; _ -> False)+ , ("reserved-area overflow rejected", case layoutMetrics overflowLayout of Left ReservedAreaOverflow -> True; _ -> False)+ ]+ assertions = leaps ++ papers ++ blankChecks ++ boundaryChecks ++ invalidChecks ++ finite+ failures = filter (not . snd) assertions+ if null failures+ then putStrLn ("PASS: " ++ show (length assertions) ++ " deterministic assertions")+ else do+ mapM_ (putStrLn . ("FAIL: " ++) . fst) failures+ exitFailure