diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/calendar-recycling.cabal b/calendar-recycling.cabal new file mode 100644 --- /dev/null +++ b/calendar-recycling.cabal @@ -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 diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -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