reindent using ormolu

2024-10-30 21:03:11 +00:00 · 2024-10-30 21:03:11 +00:00 · aa1f69f3d4
commit aa1f69f3d4
parent 31ba15f5a9
3 changed files with 158 additions and 119 deletions
--- a/default.nix
+++ b/default.nix
@ -7,6 +7,7 @@ let
        [
          cabal-install
          hlint
+          ormolu
        ]);
  };
 in haskellEnv.overrideAttrs(o: {
--- a/lib/Track.hs
+++ b/lib/Track.hs
@ -1,41 +1,47 @@
 {-# LANGUAGE OverloadedStrings #-}

-module Track (
-  Track,
-  Pos(..),
-  pos,
-  elevation,
-  cadence,
-  power,
-  time,
-  parse,
-  Track.length
-             ) where
+module Track
+  ( Track,
+    Pos (..),
+    pos,
+    elevation,
+    cadence,
+    power,
+    time,
+    parse,
+    Track.length,
+  )
+where
+
+import Control.Exception
+import Data.List as List
+import Data.List qualified
+import Data.Map as Map
+import Data.Text qualified
+import Data.Text.Lazy as T
 import Data.Time
-import qualified Data.Time.ISO8601
-import qualified Data.List
+import Data.Time.ISO8601 qualified
+import Debug.Trace (trace, traceShow)
 import Text.XML
 import Text.XML.Cursor as Cursor
-import qualified Data.Text
-import Data.Text.Lazy as T
-import Debug.Trace (trace, traceShow)
-import Data.List as List
-import Data.Map as Map
-import Control.Exception

 data Pos = Pos Float Float deriving (Show, Eq)
+
 type Power = Maybe Int
+
 type Cadence = Maybe Int
+
 type HeartRate = Maybe Int

-data Point = Point {
-  pos :: Pos,
-  elevation :: Maybe Float,
-  time :: UTCTime,
-  cadence :: Cadence,
-  power :: Power,
-  heartRate :: HeartRate
-} deriving (Show)
+data Point = Point
+  { pos :: Pos,
+    elevation :: Maybe Float,
+    time :: UTCTime,
+    cadence :: Cadence,
+    power :: Power,
+    heartRate :: HeartRate
+  }
+  deriving (Show)

 -- TODO do we even need this type?
 type Track = [Point]
@ -50,7 +56,7 @@ mkPoint pos =
  Point
    pos
    Nothing
-    (UTCTime (toEnum  60631) 43200)
+    (UTCTime (toEnum 60631) 43200)
    Nothing
    Nothing
    Nothing
@ -59,36 +65,47 @@ elToPoint :: Cursor -> Point
 elToPoint c =
  case node c of
    NodeElement (Element _ attrs _) ->
-      let
-        lat = getAttr "lat"
-        lon = getAttr "lon"
-        ele = child c >>= element (gpxNS "ele") >>= child >>= content
-        ts = child c >>= element (gpxNS "time") >>= child >>= content
-        gpxtpx = child c >>=
-          element (gpxNS "extensions")
-          >>= child
-          >>= element (tpxNS "TrackPointExtension") >>= child
-        cadence = gpxtpx >>= element (tpxNS "cad")
-          >>= child >>= content
-        power = gpxtpx >>= element (Name "PowerInWatts" (Just "http://www.garmin.com/xmlschemas/PowerExtension/v1") Nothing)
-          >>= child >>= content
-      in Point (Pos lat lon)
-         (case ele of
-             [e] -> Just $ asFloat e
-             _ -> Nothing)
-         (case ts of
-             [e] -> case Data.Time.ISO8601.parseISO8601 (Data.Text.unpack e) of
-                      Just utime -> utime
-                      _ -> UTCTime (toEnum 0) 0
-             _ -> UTCTime (toEnum 0) 0)
-         (case cadence of
-             [e] -> Just (asInt e)
-             _ -> Nothing)
-         (case power of
-             [e] -> Just (asInt e)
-             _ -> Nothing)
-         Nothing
-
+      let lat = getAttr "lat"
+          lon = getAttr "lon"
+          ele = child c >>= element (gpxNS "ele") >>= child >>= content
+          ts = child c >>= element (gpxNS "time") >>= child >>= content
+          gpxtpx =
+            child c
+              >>= element (gpxNS "extensions")
+              >>= child
+              >>= element (tpxNS "TrackPointExtension")
+              >>= child
+          cadence =
+            gpxtpx
+              >>= element (tpxNS "cad")
+              >>= child
+              >>= content
+          power =
+            gpxtpx
+              >>= element (Name "PowerInWatts" (Just "http://www.garmin.com/xmlschemas/PowerExtension/v1") Nothing)
+              >>= child
+              >>= content
+       in Point
+            (Pos lat lon)
+            ( case ele of
+                [e] -> Just $ asFloat e
+                _ -> Nothing
+            )
+            ( case ts of
+                [e] -> case Data.Time.ISO8601.parseISO8601 (Data.Text.unpack e) of
+                  Just utime -> utime
+                  _ -> UTCTime (toEnum 0) 0
+                _ -> UTCTime (toEnum 0) 0
+            )
+            ( case cadence of
+                [e] -> Just (asInt e)
+                _ -> Nothing
+            )
+            ( case power of
+                [e] -> Just (asInt e)
+                _ -> Nothing
+            )
+            Nothing
      where
        asFloat v = (read (Data.Text.unpack v) :: Float)
        asInt v = (read (Data.Text.unpack v) :: Int)
@ -100,13 +117,13 @@ elToPoint c =

 getPoints :: Cursor -> [Point]
 getPoints c =
-  let
-    trkpts =
-      element (gpxNS "gpx") c >>= child >>=
-      element (gpxNS "trk") >>= descendant >>=
-      element (gpxNS "trkpt")
-  in
-    List.map elToPoint trkpts
+  let trkpts =
+        element (gpxNS "gpx") c
+          >>= child
+          >>= element (gpxNS "trk")
+          >>= descendant
+          >>= element (gpxNS "trkpt")
+   in List.map elToPoint trkpts

 parse :: String -> Either SomeException [Point]
 parse str = do
--- a/tests/UnitTest.hs
+++ b/tests/UnitTest.hs
@ -2,17 +2,17 @@

 module Main where

-import qualified Track
-
-import Text.RawString.QQ(r)
-import Test.HUnit
-import qualified System.Exit as Exit
 import Control.Exception
-import Debug.Trace (trace, traceShow)
-import qualified Data.Time
 import Data.Either
+import Data.Time qualified
+import Debug.Trace (trace, traceShow)
+import System.Exit qualified as Exit
+import Test.HUnit
+import Text.RawString.QQ (r)
+import Track qualified

-preamble = [r|
+preamble =
+  [r|
 <?xml version="1.0" encoding="UTF-8"?>
 <gpx
 version="1.1"
@ -27,16 +27,20 @@ xmlns:cluetrust="http://www.cluetrust.com/Schemas/"
 xmlns:pwr="http://www.garmin.com/xmlschemas/PowerExtension/v1"
 xsi:schemaLocation="http://www.topografix.com/GPX/1/1 http://www.topografix.com/GPX/1/1/gpx.xsd http://www.topografix.com/GPX/Private/TopoGrafix/0/1 http://www.topografix.com/GPX/Private/TopoGrafix/0/1/topografix.xsd http://www.garmin.com/xmlschemas/TrackPointExtension/v2 https://www8.garmin.com/xmlschemas/TrackPointExtensionv2.xsd http://www.garmin.com/xmlschemas/PowerExtension/v1 https://www8.garmin.com/xmlschemas/PowerExtensionv1.xsd http://www.garmin.com/xmlschemas/TrackStatsExtension/v1 http://www.cluetrust.com/Schemas http://www.cluetrust.com/Schemas/gpxdata10.xsd http://opentracksapp.com/xmlschemas/v1 http://opentracksapp.com/xmlschemas/OpenTracks_v1.xsd">
 |]
+
 wrap x = preamble ++ x ++ "</gpx>"

-
-onepoint = wrap [r|
+onepoint =
+  wrap
+    [r|
 <trk> <trkseg>
 <trkpt lat="51" lon="-0.1"> </trkpt>
 </trkseg> </trk>
 |]

-onepointWithAttrs = wrap [r|
+onepointWithAttrs =
+  wrap
+    [r|
 <trk>
 <trkseg>
  <trkpt lat="51" lon="-0.1">
@ -55,55 +59,72 @@ onepointWithAttrs = wrap [r|
 </trk>
 |]

-test1 = TestCase $
-        either
-        (assertFailure . displayException)
-        (\ t -> assertEqual "empty track has no elements"
-                0 (Track.length t))
-        (Track.parse (wrap ""))
+test1 =
+  TestCase $
+    either
+      (assertFailure . displayException)
+      ( \t ->
+          assertEqual
+            "empty track has no elements"
+            0
+            (Track.length t)
+      )
+      (Track.parse (wrap ""))

-testMalformed = TestCase $
-                let trk = Track.parse (wrap "<dgdsfg>>")
-                in assertBool "catches syntax error" (isLeft trk)
+testMalformed =
+  TestCase $
+    let trk = Track.parse (wrap "<dgdsfg>>")
+     in assertBool "catches syntax error" (isLeft trk)

-test2 = TestCase $
-        either
-        (assertFailure . displayException)
-        (\ (p:_) ->
-           assertEqual "matches lat/lon"
-           (Track.Pos 51.0 (-0.1))
-           (Track.pos p))
-        (Track.parse onepoint)
+test2 =
+  TestCase $
+    either
+      (assertFailure . displayException)
+      ( \(p : _) ->
+          assertEqual
+            "matches lat/lon"
+            (Track.Pos 51.0 (-0.1))
+            (Track.pos p)
+      )
+      (Track.parse onepoint)

-test3 = TestCase $
-        either
-        (assertFailure . displayException)
-        (\ (p:_) ->
-           assertEqual "handles missing attributes"
-             (Nothing, Nothing) (Track.elevation p, Track.cadence p))
-        (Track.parse onepoint)
+test3 =
+  TestCase $
+    either
+      (assertFailure . displayException)
+      ( \(p : _) ->
+          assertEqual
+            "handles missing attributes"
+            (Nothing, Nothing)
+            (Track.elevation p, Track.cadence p)
+      )
+      (Track.parse onepoint)

-test4 = TestCase $
-        either
-        (assertFailure . displayException)
-        (\ (p:_) ->
-           assertEqual "handles attributes"
-             (Just 25.2, Just 128, Just 55, Data.Time.UTCTime (toEnum 60606) 27299.779)
-             (Track.elevation p, Track.cadence p, Track.power p, Track.time p))
-        (Track.parse onepointWithAttrs)
+test4 =
+  TestCase $
+    either
+      (assertFailure . displayException)
+      ( \(p : _) ->
+          assertEqual
+            "handles attributes"
+            (Just 25.2, Just 128, Just 55, Data.Time.UTCTime (toEnum 60606) 27299.779)
+            (Track.elevation p, Track.cadence p, Track.power p, Track.time p)
+      )
+      (Track.parse onepointWithAttrs)

 tests :: Test
-tests = TestList [
-  test1,
-  testMalformed,
-  test2,
-  test3,
-  test4
-  ]
+tests =
+  TestList
+    [ test1,
+      testMalformed,
+      test2,
+      test3,
+      test4
+    ]

 main :: IO ()
 main = do
-    result <- runTestTT tests
-    if (failures result > 0) || (errors result > 0)
-      then Exit.exitFailure
-      else Exit.exitSuccess
+  result <- runTestTT tests
+  if (failures result > 0) || (errors result > 0)
+    then Exit.exitFailure
+    else Exit.exitSuccess