Merge pull request #220 from noinia/fixlseq

fix compile issues on 9.4
noinia · Dec 18, 2022 · f8cdbc0 · f8cdbc0
2 parents ddc7d45 + e2b4c97
commit f8cdbc0
Show file tree

Hide file tree

Showing 6 changed files with 23 additions and 10 deletions.
diff --git a/.github/workflows/cabal.yml b/.github/workflows/cabal.yml
@@ -11,7 +11,7 @@ jobs:
     runs-on: ${{ matrix.os }}
     strategy:
       matrix:
-        ghc: ['8.10','9.2']
+        ghc: ['9.2','9.4']
         os: [ubuntu-latest, macOS-latest]
     name: GHC ${{ matrix.ghc }} / ${{ matrix.os }}
     steps:

diff --git a/cabal.project b/cabal.project
@@ -17,3 +17,9 @@ package miso
   flags: +jsaddle
 package reanimate
   flags: +no-hgeometry
+
+allow-newer:
+  vector-circular:base,vector-circular:template-haskell,
+  reanimate:aeson,
+  geojson:text,
+  hexpat:text
diff --git a/hgeometry-combinatorial/hgeometry-combinatorial.cabal b/hgeometry-combinatorial/hgeometry-combinatorial.cabal
@@ -66,7 +66,7 @@ common setup
                     , DerivingStrategies
 
   build-depends:
-                base                    >= 4.11      &&     < 5
+                base                    >= 4.16      &&     < 5
               , array                   >= 0.4
               , bifunctors              >= 4.1
               , bytestring              >= 0.10

diff --git a/hgeometry-combinatorial/src/Data/LSeq.hs b/hgeometry-combinatorial/src/Data/LSeq.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE BangPatterns #-}
 --------------------------------------------------------------------------------
 -- |
@@ -47,7 +48,7 @@ import           Control.DeepSeq
 import           Control.Lens ((%~), (&), (<&>), (^?!), bimap)
 import           Control.Lens.At (Ixed(..), Index, IxValue)
 import           Data.Aeson
-import           Data.Coerce(coerce)
+import           Data.Coerce (coerce)
 import qualified Data.Foldable as F
 import           Data.Functor.Apply
 import qualified Data.List.NonEmpty as NonEmpty
@@ -56,6 +57,7 @@ import           Data.Semigroup.Foldable
 import           Data.Semigroup.Traversable
 import qualified Data.Sequence as S
 import qualified Data.Traversable as Tr
+import           Data.Type.Ord
 import           GHC.Generics (Generic)
 import           GHC.TypeLits
 import           Prelude hiding (drop,take,head,last,tail,init,zipWith,reverse)
@@ -259,8 +261,13 @@ data ViewL n a where
 
 infixr 5 :<
 
-instance Semigroup (ViewL n a) where
-  (x :< xs) <> (y :< ys) = x :< LSeq (toSeq xs <> (y S.<| toSeq ys))
+instance (n ~ 1 + n0) => Semigroup (ViewL n a) where
+  (<>) = combineL
+
+-- | implementation of <> for viewL
+combineL                     :: forall n a. ViewL (1+n) a -> ViewL (1+n) a -> ViewL (1+n) a
+combineL (x :< xs) (y :< ys) = x :< promise @n (LSeq (toSeq xs <> (y S.<| toSeq ys)))
+
 
 deriving instance Show a => Show (ViewL n a)
 instance Functor (ViewL n) where
@@ -327,8 +334,8 @@ data ViewR n a where
 
 infixl 5 :>
 
-instance Semigroup (ViewR n a) where
-  (xs :> x) <> (ys :> y) = LSeq ((toSeq xs S.|> x) <> toSeq ys) :> y
+instance (n ~ 1+n0) => Semigroup (ViewR n a) where
+  (xs :> x) <> (ys :> y) = promise @n0 (LSeq ((toSeq xs S.|> x) <> toSeq ys)) :> y
 
 deriving instance Show a => Show (ViewR n a)
 instance Functor (ViewR n) where

diff --git a/hgeometry-ipe/stack-haddock.yaml b/hgeometry-ipe/stack-haddock.yaml
@@ -1,4 +1,4 @@
-resolver: lts-18.25
+resolver: lts-20.04
 
 allow-newer: false
 
@@ -7,5 +7,4 @@ packages:
 - ../hgeometry-combinatorial
 - ../hgeometry
 
-extra-deps:
-- vector-circular-0.1.4
+# extra-deps:
diff --git a/hgeometry/src/Geometry/RangeTree.hs b/hgeometry/src/Geometry/RangeTree.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE UndecidableSuperClasses #-}
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  Geometry.RangeTree