Add a YMD record and use this in date cases of IgcRecord, #249.

igc/library/Flight/Igc/Fix.hs

@@ -16,6 +16,8 @@ type Fix t a = (t, a)
 type Pos = (Lat, Lng, AltBaro, Maybe AltGps)
 type IgcFix = Fix HMS Pos
 
+-- |
+-- prop> igcEqOrEqOnTime x x == True
 igcEqOrEqOnTime :: IgcRecord -> IgcRecord -> Bool
 igcEqOrEqOnTime (B t0 _ _ _ _) (B t1 _ _ _ _) = t0 == t1
 igcEqOrEqOnTime a b = a == b
@@ -54,12 +56,12 @@ mark
     -> b
 mark _ Ignore _ = mempty
 mark _ B{} _ = mempty
-mark f (HFDTEDATE (Day dd) (Month mm) (Year yy) _) xs =
+mark f HFDTEDATE{ymd = YMD{year = Year yy, month = Month mm, day = Day dd}} xs =
     f Nothing ts
     where
         ys = catMaybes $ extract <$> xs
         ts = [stamp (dd, mm, yy) `first` y | y <- ys]
-mark f (HFDTE (Day dd) (Month mm) (Year yy)) xs =
+mark f (HFDTE YMD{year = Year yy, month = Month mm, day = Day dd}) xs =
     f Nothing ts
     where
         ys = catMaybes $ extract <$> xs

igc/library/Flight/Igc/Parse.hs

@@ -147,23 +147,30 @@ fix = do
 dateHFDTEDATE :: ParsecT Void String Identity IgcRecord
 dateHFDTEDATE = do
     _ <- string "HFDTEDATE:"
+
     dd <- Day <$> count 2 digitChar
     mm <- Month <$> count 2 digitChar
     yy <- Year <$> count 2 digitChar
+    let ymd = YMD {year = yy, month = mm, day = dd}
+
     _ <- string ","
     nn <- Nth <$> count 2 digitChar
-    return $ HFDTEDATE dd mm yy nn
+
+    return $ HFDTEDATE {ymd = ymd, nth = nn}
 
 -- |
 -- >>> parseTest dateHFDTE "HFDTE0301181"
 -- 2018-01-03
 dateHFDTE :: ParsecT Void String Identity IgcRecord
 dateHFDTE = do
     _ <- string "HFDTE"
+
     dd <- Day <$> count 2 digitChar
     mm <- Month <$> count 2 digitChar
     yy <- Year <$> count 2 digitChar
-    return $ HFDTE dd mm yy
+    let ymd = YMD {year = yy, month = mm, day = dd}
+
+    return $ HFDTE ymd
 
 ignore :: ParsecT Void String Identity IgcRecord
 ignore = do

igc/library/Flight/Igc/Record.hs

@@ -2,6 +2,7 @@ module Flight.Igc.Record
     (
     -- * Data
       IgcRecord(..)
+    , YMD(..)
     , HMS(..)
     , Lat(..)
     , Lng(..)
@@ -90,6 +91,13 @@ newtype Day = Day String
 newtype Nth = Nth String
     deriving (Eq, Ord)
 
+data YMD = YMD {year :: Year, month :: Month, day :: Day}
+    deriving (Eq, Ord)
+
+instance Show YMD where
+    show YMD{year = Year y, month = Month m, day = Day d} =
+        concat ["20", y, "-", m, "-", d]
+
 -- |
 -- The record types are:
 --
@@ -111,9 +119,9 @@ data IgcRecord
     -- | A location fix
     = B HMS Lat Lng AltBaro (Maybe AltGps)
     -- | The newer date header record
-    | HFDTEDATE Day Month Year Nth
+    | HFDTEDATE {ymd :: YMD, nth :: Nth}
     -- | The older date header record
-    | HFDTE Day Month Year
+    | HFDTE YMD
     -- | Any other record type is ignored
     | Ignore
     deriving (Eq, Ord)
@@ -127,10 +135,9 @@ instance Show IgcRecord where
          , show altB
          , "(" ++ show altG ++ ")"
          ]
-    show (HFDTEDATE (Day d) (Month m) (Year y) (Nth n)) =
-        concat ["20", y, "-", m, "-", d, ", ", n]
-    show (HFDTE (Day d) (Month m) (Year y)) =
-        concat ["20", y, "-", m, "-", d]
+    show (HFDTEDATE {ymd, nth = Nth n}) =
+        concat [show ymd, ", ", n]
+    show (HFDTE ymd) = show ymd
     show Ignore = ""
 
 instance Arbitrary Hour where
@@ -204,14 +211,16 @@ instance Arbitrary IgcRecord where
                      d <- Day <$> arbitrary
                      m <- Month <$> arbitrary
                      y <- Year <$> arbitrary
+                     let ymd = YMD {year = y, month = m, day = d}
                      n <- Nth <$> arbitrary
-                     return $ HFDTEDATE d m y n
+                     return $ HFDTEDATE {ymd = ymd, nth = n}
 
             d2 = do
                      d <- Day <$> arbitrary
                      m <- Month <$> arbitrary
                      y <- Year <$> arbitrary
-                     return $ HFDTE d m y
+                     let ymd = YMD {year = y, month = m, day = d}
+                     return $ HFDTE ymd
 
 -- |
 -- >>> addHoursHms (Hour "0") (HMS (Hour "0") (Minute "0") (Second "0"))

igc/test-suite-doctest/DocTest.hs

@@ -14,6 +14,7 @@ arguments =
     , "-XParallelListComp"
     , "-XScopedTypeVariables"
     , "-XDeriveGeneric"
+    , "-XNamedFieldPuns"
     ]
 
 main :: IO ()