Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Slimmed down dependencies

  • Loading branch information...
commit a18b2e737aa4301e4c881033c2effd1549c149c1 1 parent 4419cd5
Michael Snoyman authored August 31, 2010
113  Data/Time/Calendar/Hebrew.hs
@@ -17,10 +17,13 @@
17 17
 --
18 18
 ---------------------------------------------------------
19 19
 module Data.Time.Calendar.Hebrew
20  
-    ( HebrewDate (..)
  20
+    ( -- * Data types
  21
+      HebrewDate (..)
21 22
     , Month (..)
  23
+      -- * Conversions
22 24
     , fromHebrew
23 25
     , toHebrew
  26
+    , monthHebrew
24 27
       -- * Anniversaries
25 28
     , anniversaryInYear
26 29
     , nextAnniversary
@@ -30,17 +33,15 @@ module Data.Time.Calendar.Hebrew
30 33
 #endif
31 34
     ) where
32 35
 
33  
-import Control.Applicative ((<$>))
34  
-import Control.Arrow
35  
-import Control.Monad
36  
-import Data.Time.Calendar (Day (..), fromGregorian)
37  
-import Data.Time.Calendar.WeekDate (toWeekDate)
38 36
 import Data.Typeable (Typeable)
39  
-import Control.Exception (Exception)
40  
-import qualified Safe.Failure as SF
41  
-import Control.Failure
  37
+import Data.Data (Data)
  38
+import Control.Arrow
  39
+import Data.Time.Calendar (Day (..))
42 40
 
43 41
 #if TEST
  42
+import Control.Applicative ((<$>))
  43
+import Data.Time.Calendar.WeekDate (toWeekDate)
  44
+import Data.Time.Calendar (fromGregorian)
44 45
 import Test.Framework (testGroup, Test)
45 46
 import Test.Framework.Providers.HUnit
46 47
 import Test.Framework.Providers.QuickCheck (testProperty)
@@ -48,38 +49,31 @@ import Test.HUnit hiding (Test)
48 49
 import Test.QuickCheck
49 50
 #endif
50 51
 
51  
-import Data.Object
52  
-
53 52
 ------ data definitions
54 53
 data Month = Tishrei | Cheshvan | Kislev | Tevet | Shevat
55 54
            | Adar | Adar1 | Adar2
56 55
            | Nissan | Iyar | Sivan | Tammuz | Av | Elul
57  
-    deriving (Eq, Ord, Show, Enum, Read)
  56
+    deriving (Eq, Ord, Show, Enum, Read, Data, Typeable)
58 57
 data YearType = Chaser | Ksidran | Shlema
59 58
     deriving (Eq, Ord, Show, Enum)
60 59
 data YearLeap = Leap | NonLeap
61 60
     deriving (Eq, Ord, Show, Enum)
62 61
 
63  
-{- FIXME use some translation package
64  
-instance CanTranslate Month where
65  
-    tryTranslate x "en" = Just $ convertSuccess $ show x
66  
-    tryTranslate Tishrei "he" = Just "תשרי"
67  
-    tryTranslate Cheshvan "he" = Just "חשון"
68  
-    tryTranslate Kislev "he" = Just "כסלו"
69  
-    tryTranslate Tevet "he" = Just "טבת"
70  
-    tryTranslate Shevat "he" = Just "שבט"
71  
-    tryTranslate Adar "he" = Just "אדר"
72  
-    tryTranslate Adar1 "he" = Just "אדר א"
73  
-    tryTranslate Adar2 "he" = Just "אדר ב"
74  
-    tryTranslate Nissan "he" = Just "ניסן"
75  
-    tryTranslate Iyar "he" = Just "אייר"
76  
-    tryTranslate Sivan "he" = Just "סיון"
77  
-    tryTranslate Tammuz "he" = Just "תמוז"
78  
-    tryTranslate Av "he" = Just "אב"
79  
-    tryTranslate Elul "he" = Just "אלול"
80  
-
81  
-    defaultTranslate = convertSuccess . show
82  
--}
  62
+monthHebrew :: Month -> String
  63
+monthHebrew Tishrei = "תשרי"
  64
+monthHebrew Cheshvan = "חשון"
  65
+monthHebrew Kislev = "כסלו"
  66
+monthHebrew Tevet = "טבת"
  67
+monthHebrew Shevat = "שבט"
  68
+monthHebrew Adar = "אדר"
  69
+monthHebrew Adar1 = "אדר א"
  70
+monthHebrew Adar2 = "אדר ב"
  71
+monthHebrew Nissan = "ניסן"
  72
+monthHebrew Iyar = "אייר"
  73
+monthHebrew Sivan = "סיון"
  74
+monthHebrew Tammuz = "תמוז"
  75
+monthHebrew Av = "אב"
  76
+monthHebrew Elul = "אלול"
83 77
 
84 78
 ------ newtypes
85 79
 newtype Chalakim = Chalakim Integer
@@ -173,6 +167,18 @@ isLeapYear y =
173 167
                 _ -> NonLeap
174 168
     in res
175 169
 
  170
+monthsTilTishrei :: Years -> Months
  171
+monthsTilTishrei (Years i) = Months $ (235 * i - 234) `div` 19
  172
+
  173
+#if TEST
  174
+case_monthsTilTishrei :: Assertion
  175
+case_monthsTilTishrei = do
  176
+    0 @=? monthsTilTishrei 1
  177
+    12 @=? monthsTilTishrei 2
  178
+    24 @=? monthsTilTishrei 3
  179
+    37 @=? monthsTilTishrei 4
  180
+    235 @=? monthsTilTishrei 20
  181
+
176 182
 extraMonthCount :: Years -> Months
177 183
 extraMonthCount i =
178 184
     case i of
@@ -197,9 +203,6 @@ extraMonthCount i =
197 203
         18 -> 6
198 204
         _ -> error $ "extraMonthCount: " ++ show i
199 205
 
200  
-monthsTilTishrei :: Years -> Months
201  
-monthsTilTishrei (Years i) = Months $ (235 * i - 234) `div` 19
202  
-
203 206
 monthsTilTishreiLong :: Years -> Months
204 207
 monthsTilTishreiLong (Years y') =
205 208
     let (machzorim, y) = (y' - 1) `divMod` 19
@@ -207,15 +210,6 @@ monthsTilTishreiLong (Years y') =
207 210
         extra = extraMonthCount $ Years y
208 211
      in base + extra
209 212
 
210  
-#if TEST
211  
-case_monthsTilTishrei :: Assertion
212  
-case_monthsTilTishrei = do
213  
-    0 @=? monthsTilTishrei 1
214  
-    12 @=? monthsTilTishrei 2
215  
-    24 @=? monthsTilTishrei 3
216  
-    37 @=? monthsTilTishrei 4
217  
-    235 @=? monthsTilTishrei 20
218  
-
219 213
 prop_monthsTilTishrei :: Years -> Bool
220 214
 prop_monthsTilTishrei y = monthsTilTishrei y == monthsTilTishreiLong y
221 215
 #endif
@@ -271,14 +265,6 @@ monthLength _ Chaser Kislev = 29
271 265
 monthLength _ _ Kislev = 30
272 266
 
273 267
 ------ conversion functions
274  
-julianFromDate :: YearLeap -> YearType -> Month -> Date -> Julian
275  
-julianFromDate yl yt m d =
276  
-    let ml = monthLength yl yt
277  
-        months = case m of
278  
-            Tishrei -> []
279  
-            _ -> enumFromTo Tishrei (pred m)
280  
-     in d + sum (map ml months)
281  
-
282 268
 dateFromJulian :: YearLeap -> YearType -> Julian -> (Month, Date)
283 269
 dateFromJulian yl yt j' =
284 270
     let ml = monthLength yl yt
@@ -291,6 +277,14 @@ dateFromJulian yl yt j' =
291 277
      in helper Tishrei j'
292 278
 
293 279
 #if TEST
  280
+julianFromDate :: YearLeap -> YearType -> Month -> Date -> Julian
  281
+julianFromDate yl yt m d =
  282
+    let ml = monthLength yl yt
  283
+        months = case m of
  284
+            Tishrei -> []
  285
+            _ -> enumFromTo Tishrei (pred m)
  286
+     in d + sum (map ml months)
  287
+
294 288
 prop_dateToFromJulian :: YearLeap -> YearType -> Julian -> Bool
295 289
 prop_dateToFromJulian yl yt j =
296 290
     j == uncurry (julianFromDate yl yt) (dateFromJulian yl yt j)
@@ -326,14 +320,12 @@ roshHashana y = daysFromWeeks w + d + dechiyot
326 320
 #if TEST
327 321
 case_firstRoshHashana :: Assertion
328 322
 case_firstRoshHashana = roshHashana 1 @?= 1
329  
-#endif
330 323
 
331 324
 dayOfWeek :: TotalDays -> Weekday
332 325
 dayOfWeek t =
333 326
     let (_, w) = weeksFromDays t
334 327
      in w
335 328
 
336  
-#if TEST
337 329
 prop_validRoshHashanaDay :: Years -> Bool
338 330
 prop_validRoshHashanaDay = (`elem` [1, 2, 4, 6]) . dayOfWeek . roshHashana
339 331
 #endif
@@ -382,7 +374,7 @@ data HebrewDate = HebrewDate
382 374
     , month :: Month
383 375
     , date :: Int
384 376
     }
385  
-    deriving Eq
  377
+    deriving (Eq, Data, Typeable)
386 378
 instance Show HebrewDate where
387 379
     show (HebrewDate y m d) = show d ++ " " ++ show m ++ ", " ++ show y
388 380
 
@@ -488,7 +480,7 @@ caseAnniversaryInYear = do
488 480
 nextAnniversary :: HebrewDate -- ^ so to say current date
489 481
                 -> HebrewDate -- ^ date of event
490 482
                 -> HebrewDate -- ^ first anniversary of event after current
491  
-nextAnniversary (HebrewDate cy cm cd) hd@(HebrewDate y m d)
  483
+nextAnniversary (HebrewDate cy cm cd) hd@(HebrewDate _y m d)
492 484
     | cm > m || cm == m && cd > d = anniversaryInYear (cy + 1) hd
493 485
     | otherwise = anniversaryInYear cy hd
494 486
 
@@ -555,12 +547,3 @@ instance Arbitrary HebrewDate where
555 547
         day <- (+ 1) . (`mod` 29) <$> arbitrary
556 548
         return $! HebrewDate y m day
557 549
 #endif
558  
-
559  
------ Data.Object.Text instances
560  
-instance ConvertSuccess Month String where
561  
-    convertSuccess = show
562  
-instance ConvertAttempt String Month where
563  
-    convertAttempt s = wrapFailure (\_ -> InvalidHebrewMonth s) $ SF.read s
564  
-data InvalidHebrewMonth = InvalidHebrewMonth String
565  
-    deriving (Show, Typeable)
566  
-instance Exception InvalidHebrewMonth
9  hebrew-time.cabal
... ...
@@ -1,5 +1,5 @@
1 1
 name:            hebrew-time
2  
-version:         0.0.1
  2
+version:         0.1.0
3 3
 license:         BSD3
4 4
 license-file:    LICENSE
5 5
 author:          Michael Snoyman <michael@snoyman.com>
@@ -7,7 +7,7 @@ maintainer:      Michael Snoyman <michael@snoyman.com>
7 7
 synopsis:        Hebrew dates and prayer times.
8 8
 description:     Conversion to and from Hebrew dates.
9 9
 category:        Data
10  
-stability:       unstable
  10
+stability:       stable
11 11
 cabal-version:   >= 1.2
12 12
 build-type:      Simple
13 13
 homepage:        http://github.com/snoyberg/hebrew-time/tree/master
@@ -18,10 +18,7 @@ flag buildtests
18 18
 
19 19
 library
20 20
     build-depends:   base >= 4 && < 5,
21  
-                     time >= 1.1.3 && < 1.2,
22  
-                     data-object >= 0.2.0 && < 0.3,
23  
-                     failure >= 0.0.0 && < 0.1,
24  
-                     safe-failure >= 0.4.0 && < 0.5
  21
+                     time >= 1.1.3 && < 1.3
25 22
     exposed-modules: Data.Time.Calendar.Hebrew
26 23
     ghc-options:     -Wall
27 24
 

0 notes on commit a18b2e7

Please sign in to comment.
Something went wrong with that request. Please try again.