packages feed

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 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