calendar-recycling (empty) → 0.0
raw patch · 4 files changed
+183/−0 lines, 4 filesdep +basedep +containersdep +htmlsetup-changed
Dependencies added: base, containers, html, old-time, utility-ht
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- calendar-recycling.cabal +38/−0
- src/Main.hs +113/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2016, Henning Thielemann++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * 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.++ * Neither the name of Henning Thielemann nor the names of other+ 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+OWNER 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ calendar-recycling.cabal view
@@ -0,0 +1,38 @@+Name: calendar-recycling+Version: 0.0+Synopsis: List years with the same calendars+Description:+ Generate a partial HTML document grouping years+ by the pattern of the calender.+ The program respects the starting weekday of a year+ and the existence of a leap day,+ but it ignores the date of the Easter festival.+Homepage: http://hub.darcs.net/thielema/calendar-recycling+License: BSD3+License-File: LICENSE+Author: Henning Thielemann+Maintainer: haskell@henning-thielemann.de+Category: Math+Build-Type: Simple+Cabal-Version: >=1.10++Source-Repository this+ Tag: 0.0+ Type: darcs+ Location: http://hub.darcs.net/thielema/calendar-recycling++Source-Repository head+ Type: darcs+ Location: http://hub.darcs.net/thielema/calendar-recycling++Executable calendar-recycling+ Main-is: Main.hs+ Build-Depends:+ html >=1.0 && <1.1,+ old-time >=1.0 && <1.2,+ containers >=0.1 && <0.6,+ utility-ht >=0.0.11 && <0.1,+ base >=4.5 && <5+ Hs-Source-Dirs: src+ Default-Language: Haskell2010+ GHC-Options: -Wall
+ src/Main.hs view
@@ -0,0 +1,113 @@+module Main where++import System.Time (Day(Monday,Saturday))++import Text.Html(Html, (!), (+++), (<<), toHtml)+import qualified Text.Html as Html++import Data.Maybe (fromMaybe, )+import Data.List.HT (sliceVertical, )++import qualified Data.Map as Map++++type Year = Int++-- cf. HTam.NumberTheory+divides :: Int -> Year -> Bool+divides k n = mod n k == 0++isLeapYear :: Year -> Bool+isLeapYear year =+ (divides 4 year && not (divides 100 year)) || divides 400 year++{-+We want to know, which years share the same calendar.+That is we want to know, in which year we can re-use the calendar of this year.+There are 14 types of years, because of two parameters:+The starting weekday of the year and whether there is a leap day or not.+-}+type YearType = (Day, Bool)++succDay :: Day -> Day+succDay d = if d==maxBound then minBound else succ d++futureYearTypes :: [(Year, YearType)]+futureYearTypes =+ iterate+ (\(year,(day,leap)) ->+ let newYear = succ year+ startDay = succDay $+ if leap+ then succDay day+ else day+ in (newYear, (startDay, isLeapYear newYear)))+ (2001,(Monday,False))+++predDay :: Day -> Day+predDay d = if d==minBound then maxBound else pred d++pastYearTypes :: [(Year, YearType)]+pastYearTypes =+ iterate+ (\(year,(day,_)) ->+ let oldYear = pred year+ leap = isLeapYear oldYear+ startDay = predDay $+ if leap+ then predDay day+ else day+ in (oldYear, (startDay, leap)))+ (2000,(Saturday,True))+++-- compute equivalent years+exampleYearTypeMap :: Map.Map YearType [Year]+exampleYearTypeMap =+ let years = reverse (take 99 futureYearTypes) ++ take 101 pastYearTypes+ in Map.fromListWith (++) (map (\(year,yearType) -> (yearType,[year])) years)+++exampleYearTypeMapStr :: String+exampleYearTypeMapStr =+ let showYear ((day,leap),years) =+ show day ++ " " +++ (if leap then "(leap)" else " ") ++ "\t" +++ show years+ in unlines $ map showYear $ Map.toList exampleYearTypeMap+++weekdays :: [Day]+weekdays = [minBound..maxBound]++yearToHtml :: Year -> Html+yearToHtml = toHtml . show++exampleHtml :: Html+exampleHtml =+ let makeYearTable leap =+ Html.simpleTable [] []+ (map (\d -> (toHtml (show d) :) $+ map (\y -> Html.anchor (yearToHtml y) !+ [Html.name (show y)]) $+ fromMaybe (error "every weekday must exist") $+ Map.lookup (d,leap) exampleYearTypeMap) weekdays)+ ! [Html.border 1]+ in Html.simpleTable [] []+ (sliceVertical 20 $+ map (\y -> Html.anchor (yearToHtml y) ! [Html.href ('#':show y)])+ [1900..2099::Int])+ ! [Html.border 1]+ +++ Html.h2 << "Normale Jahre" +++ makeYearTable False+ +++ Html.h2 << "Schaltjahre" +++ makeYearTable True+ +++ foldl1 (+++) (replicate 30 Html.br)++++writeHtml :: IO ()+writeHtml = writeFile "CalendarTable.hsc" (show exampleHtml)++main :: IO ()+main = writeHtml