Move functions mark and extract to flight-igc from flight-track, #249.

igc/flight-igc.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 1666739a67ca5c70d5828e33f6acef6445288227159b70fc3229cb2401e986f1
+-- hash: e9f03f53ff1d9c866df1effbc10c47999f2574758e98d64bd437dd7cbe5959ba
 
 name:           flight-igc
 version:        2.0.0
@@ -51,6 +51,7 @@ library
     , bytestring
     , flight-clip
     , megaparsec
+    , time
     , utf8-string
   default-language: Haskell2010
 
@@ -74,5 +75,6 @@ test-suite doctest
     , doctest
     , flight-clip
     , megaparsec
+    , time
     , utf8-string
   default-language: Haskell2010

igc/library/Flight/Igc.hs

@@ -40,6 +40,8 @@ module Flight.Igc
     -- * Fix Checking and Conversion
     , igcEqOrEqOnTime
     , igcBumpOver
+    , extract
+    , mark
     ) where
 
 import Flight.Igc.Record

igc/library/Flight/Igc/Fix.hs

@@ -1,11 +1,20 @@
 module Flight.Igc.Fix
     ( igcEqOrEqOnTime
     , igcBumpOver
+    , extract
+    , mark
     ) where
 
+import Data.Time.Clock (UTCTime(..), addUTCTime)
+import Data.Time.Calendar (fromGregorian)
+import Data.Maybe (catMaybes)
 import Flight.Igc.Record
 import Flight.Track.Range (asRollovers)
 
+type Fix t a = (t, a)
+type Pos = (Lat, Lng, AltBaro, Maybe AltGps)
+type IgcFix = Fix HMS Pos
+
 igcEqOrEqOnTime :: IgcRecord -> IgcRecord -> Bool
 igcEqOrEqOnTime (B t0 _ _ _ _) (B t1 _ _ _ _) = t0 == t1
 igcEqOrEqOnTime a b = a == b
@@ -34,3 +43,48 @@ bumpOver add ns xs =
     | n <- ns
     ]
 
+mark
+    :: Monoid b
+    => (Maybe a -> [(UTCTime, Pos)] -> b)
+    -> IgcRecord
+    -> [IgcRecord]
+    -> b
+mark _ Ignore _ = mempty
+mark _ B{} _ = mempty
+mark f (HFDTEDATE (Day dd) (Month mm) (Year yy) _) xs =
+    f Nothing ts
+    where
+        ys = catMaybes $ extract <$> xs
+        ts = [stamp (dd, mm, yy) y | y <- ys]
+mark f (HFDTE (Day dd) (Month mm) (Year yy)) xs =
+    f Nothing ts
+    where
+        ys = catMaybes $ extract <$> xs
+        ts = [stamp (dd, mm, yy) y | y <- ys]
+
+extract :: IgcRecord -> Maybe IgcFix
+extract Ignore = Nothing
+extract HFDTEDATE{} = Nothing
+extract HFDTE{} = Nothing
+extract (B hms lat lng alt altGps) = Just (hms, (lat, lng, alt, altGps))
+
+-- | Combines date with time of day to get a @UTCTime@.
+-- >>> stamp ("08", "07", "17") ((HMS (Hour "02") (Minute "37") (Second "56")), "")
+-- (2017-07-08 02:37:56 UTC,"")
+-- >>> stamp ("08", "07", "17") ((HMS (Hour "26") (Minute "37") (Second "56")), "")
+-- (2017-07-09 02:37:56 UTC,"")
+stamp :: (String, String, String) -> (HMS, a) -> (UTCTime, a)
+stamp (dd, mm, yy) (HMS (Hour hr) (Minute minute) (Second sec), a) =
+    (utc, a)
+    where
+        -- TODO: Test with an IGC file from the 20th Century.
+        y = read ("20" ++ yy) :: Integer
+        m = read mm :: Int
+        d = read dd :: Int
+        hr' = read hr :: Integer
+        minute' = read minute :: Integer
+        sec' = read sec :: Integer
+        utc =
+            (fromInteger $ 60 * ((60 * hr') + minute') + sec')
+            `addUTCTime`
+            (UTCTime (fromGregorian y m d) 0)

igc/package.dhall

@@ -18,7 +18,7 @@ in    defs
           defs.extra-source-files # [ "**/*.igc" ]
       , dependencies =
             defs.dependencies
-          # [ "megaparsec", "bytestring", "flight-clip", "utf8-string" ]
+          # [ "bytestring", "flight-clip", "megaparsec", "time", "utf8-string" ]
       , library =
           { source-dirs = "library", exposed-modules = "Flight.Igc" }
       , tests =

kml/library/Flight/Types.hs

@@ -14,8 +14,8 @@
     , fixToUtc
     ) where
 
-import Data.Time.Clock (UTCTime, addUTCTime, diffUTCTime)
-import Data.List (findIndex, findIndices)
+import Data.Time.Clock (UTCTime(..), addUTCTime, diffUTCTime)
+import Data.List (findIndex, findIndices, sort, nub)
 import GHC.Generics (Generic)
 import Data.Aeson (ToJSON(..), FromJSON(..))
 
@@ -138,6 +138,23 @@ data MarkedFixes =
         }
     deriving (Eq, Ord, Show, Generic, ToJSON, FromJSON)
 
+instance Monoid MarkedFixes where
+    mempty = MarkedFixes (UTCTime (toEnum 0) 0) []
+    mappend
+        mfx@MarkedFixes{mark0 = mx, fixes = xs}
+        mfy@MarkedFixes{mark0 = my, fixes = ys}
+          | mx == my = mfx{fixes = sort . nub $ xs ++ ys}
+          | xs == [] = mfy
+          | ys == [] = mfx
+          | otherwise =
+              let diff = my `diffUTCTime` mx
+                  xs' =
+                      (\x@Fix{fixMark = Seconds secs} ->
+                          x{fixMark = Seconds $ secs + round diff})
+                      <$> xs
+
+              in mfy{fixes = sort . nub $ xs' ++ ys}
+
 betweenFixMark :: FixMark a => Seconds -> Seconds -> a -> Bool
 betweenFixMark s0 s1 x =
     let s = mark x in s0 <= s && s <= s1

track/library/Flight/TrackLog.hs

@@ -18,7 +18,7 @@ import Prelude hiding (readFile)
 import Data.ByteString.UTF8 (toString)
 import Data.ByteString (readFile)
 import Data.Ratio ((%))
-import Data.Time.Clock (UTCTime(..), diffUTCTime, addUTCTime)
+import Data.Time.Clock (UTCTime(..), diffUTCTime)
 import Data.Time.Calendar
 import Data.Bifunctor (bimap)
 import Data.Maybe (catMaybes, listToMaybe)
@@ -39,8 +39,7 @@ import System.FilePath
 import qualified Flight.Kml as K
 import qualified Flight.Igc as I (parse)
 import Flight.Igc
-    ( Degree(..), Minute(..), Second(..)
-    , Year(..), Month(..), Day(..), Hour(..), HMS(..)
+    ( Degree(..), Minute(..)
     , Lat(..), Lng(..), Altitude(..), AltGps(..), AltBaro(..)
     , IgcRecord(..)
     , isMark, isFix
@@ -54,6 +53,7 @@ import Flight.Comp
     , IxTask(..)
     )
 import Flight.Igc (igcEqOrEqOnTime, igcBumpOver)
+import qualified Flight.Igc as Igc (mark)
 
 ixTasks :: [IxTask]
 ixTasks = IxTask <$> [ 1 .. ]
@@ -196,45 +196,7 @@ igcMarkedFixes xs =
         zs = nubBy igcEqOrEqOnTime ys
 
 mark :: IgcRecord -> [IgcRecord] -> K.MarkedFixes
-mark Ignore _ = nullMarkedFixes
-mark B{} _ = nullMarkedFixes
-mark (HFDTEDATE (Day dd) (Month mm) (Year yy) _) xs =
-    unStamp Nothing ts
-    where
-        ys = catMaybes $ extract <$> xs
-        ts = stamp (dd, mm, yy) <$> ys
-mark (HFDTE (Day dd) (Month mm) (Year yy)) xs =
-    unStamp Nothing ts
-    where
-        ys = catMaybes $ extract <$> xs
-        ts = stamp (dd, mm, yy) <$> ys
-
-extract :: IgcRecord -> Maybe (HMS, (Lat, Lng, AltBaro, Maybe AltGps))
-extract Ignore = Nothing
-extract HFDTEDATE{} = Nothing
-extract HFDTE{} = Nothing
-extract (B hms lat lng alt altGps) = Just (hms, (lat, lng, alt, altGps))
-
--- | Combines date with time of day to get a @UTCTime@.
--- >>> stamp ("08", "07", "17") ((HMS (Hour "02") (Minute "37") (Second "56")), "")
--- (2017-07-08 02:37:56 UTC,"")
--- >>> stamp ("08", "07", "17") ((HMS (Hour "26") (Minute "37") (Second "56")), "")
--- (2017-07-09 02:37:56 UTC,"")
-stamp :: (String, String, String) -> (HMS, a) -> (UTCTime, a)
-stamp (dd, mm, yy) (HMS (Hour hr) (Minute minute) (Second sec), a) =
-    (utc, a)
-    where
-        -- TODO: Test with an IGC file from the 20th Century.
-        y = read ("20" ++ yy) :: Integer
-        m = read mm :: Int
-        d = read dd :: Int
-        hr' = read hr :: Integer
-        minute' = read minute :: Integer
-        sec' = read sec :: Integer
-        utc =
-            (fromInteger $ 60 * ((60 * hr') + minute') + sec')
-            `addUTCTime`
-            (UTCTime (fromGregorian y m d) 0)
+mark = Igc.mark unStamp
 
 unStamp
     :: Maybe UTCTime