diff --git a/igc/library/Flight/Igc/Fix.hs b/igc/library/Flight/Igc/Fix.hs index 3382db4da..d6b4bd431 100644 --- a/igc/library/Flight/Igc/Fix.hs +++ b/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 diff --git a/igc/library/Flight/Igc/Parse.hs b/igc/library/Flight/Igc/Parse.hs index 22dfcc9fd..29422f45b 100644 --- a/igc/library/Flight/Igc/Parse.hs +++ b/igc/library/Flight/Igc/Parse.hs @@ -147,12 +147,16 @@ 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" @@ -160,10 +164,13 @@ dateHFDTEDATE = do 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 diff --git a/igc/library/Flight/Igc/Record.hs b/igc/library/Flight/Igc/Record.hs index a081119a1..90ec75070 100644 --- a/igc/library/Flight/Igc/Record.hs +++ b/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")) diff --git a/igc/test-suite-doctest/DocTest.hs b/igc/test-suite-doctest/DocTest.hs index 9b00a956f..9868a7eea 100644 --- a/igc/test-suite-doctest/DocTest.hs +++ b/igc/test-suite-doctest/DocTest.hs @@ -14,6 +14,7 @@ arguments = , "-XParallelListComp" , "-XScopedTypeVariables" , "-XDeriveGeneric" + , "-XNamedFieldPuns" ] main :: IO ()