keep up with GHC and singletons

regexp/ChangeLog.md

@@ -1,3 +1,7 @@
+October 2018: 0.2.0.1
+   - Bump stack to nightly-2018-10-08 (GHC 8.6.1)
+   - update to singletons-2.5
+
 September 2017: 0.2.0.0
    - Convert to stack (nightly)
    - Use GHC.Records instead of HasField (GHC 8.2 required)
@@ -7,5 +11,5 @@ September 2017: 0.2.0.0
    - More haddocks
    - Renamed R to RE (for clarity)
 
-January 2071: 0.1.0.0
+January 2017: 0.1.0.0
    Initial version

regexp/Example.hs

@@ -29,7 +29,7 @@ x = getField @"base" dict
 y = getField @"dir" dict
 z = getField @"ext" dict
 
--- w = getField @"f" dict
+--w = getField @"f" dict
 
 
 
@@ -87,3 +87,4 @@ d = entry1 :> entry3 :> entry2 :> Nil
 ------------------------------------
 --
 --
+

regexp/dependent-regexp.cabal

@@ -10,7 +10,7 @@ name:                dependent-regexp
 -- PVP summary:      +-+------- breaking API changes
 --                   | | +----- non-breaking API additions
 --                   | | | +--- code changes with no API change
-version:             0.2.0.0
+version:             0.2.0.1
 
 -- A short (one-line) description of the package.
 synopsis:            A type system for regular expressions.
@@ -59,11 +59,11 @@ library
   other-extensions:    InstanceSigs, GADTs, DataKinds, KindSignatures, MultiParamTypeClasses, FlexibleInstances, TypeFamilies, RankNTypes, ScopedTypeVariables, TypeInType, TypeApplications, AllowAmbiguousTypes, TypeOperators, FlexibleContexts, PolyKinds, UndecidableInstances, GeneralizedNewtypeDeriving, TemplateHaskell, FunctionalDependencies, TypeSynonymInstances, ConstraintKinds, PatternSynonyms, ViewPatterns, TypeFamilyDependencies, GADTSyntax, StandaloneDeriving, QuasiQuotes, OverloadedStrings, PartialTypeSignatures
 
   -- Other library packages from which modules are imported.
-  build-depends:       base >=4.9 && <4.11,
-                       singletons >=2.3 && <2.4,
-                       QuickCheck >=2.8 && <2.11,
-                       containers >=0.5 && <0.6,
-                       template-haskell >=2.11 && <2.13,
+  build-depends:       base >=4.12,
+                       singletons >=2.5,
+                       QuickCheck >=2.11,
+                       containers >=0.6,
+                       template-haskell >=2.13,
                        th-lift-instances >=0.1 && <0.2,
                        parsec >=3.1 && <3.2,
                        HUnit >=1.3 && <1.7,

regexp/src/OccDict.hs

@@ -4,10 +4,8 @@
     TypeFamilyDependencies,
     TemplateHaskell, AllowAmbiguousTypes,
     FlexibleContexts, TypeSynonymInstances, FlexibleInstances,
-    MultiParamTypeClasses, FunctionalDependencies #-}
+    MultiParamTypeClasses, FunctionalDependencies,EmptyCase,StandaloneDeriving #-}
 
-
-{-# OPTIONS_GHC -fdefer-type-errors #-}
 {-# OPTIONS_GHC -fprint-expanded-synonyms #-}
 {-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
 
@@ -25,7 +23,7 @@ module OccDict(
 
 import Data.Kind(Type)
 import GHC.Records
-import GHC.TypeLits
+import GHC.TypeLits (ErrorMessage(..),TypeError)
 import Data.Singletons.TH
 import Data.Singletons.Prelude
 import Data.Singletons.TypeLits (Sing(..),
@@ -39,7 +37,7 @@ $(singletons [d|
   data Occ = Once | Opt | Many deriving (Eq, Ord, Show)
   |])
 -- We use the 'singletons' library to automatically give us
--- a Singleton type for Occ, plus definitions for Eq, Ord, Show.
+-- a Singleton type for Occ, plus definitions for Eq, Ord, and Show.
 
 
 -- | The static description of a dictionary: a mapping of
@@ -96,8 +94,8 @@ type family Merge (a :: OccMap) (b :: OccMap) :: OccMap where
    Merge s  '[] = s
    Merge '[] s  = s
    Merge ('(n1,o1):t1) ('(n2,o2):t2) =
-     If (n1 :== n2) ('(n1, 'Many) : Merge t1 t2)
-        (If (n1 :<= n2) ('(n1, o1) : Merge t1 ('(n2,o2):t2))
+     If (n1 == n2) ('(n1, 'Many) : Merge t1 t2)
+        (If (n1 <= n2) ('(n1, o1) : Merge t1 ('(n2,o2):t2))
                         ('(n2, o2) : Merge ('(n1,o1):t1) t2))
 
 -- | Combine two (sorted) symbol maps
@@ -108,8 +106,8 @@ type family Alt (a :: OccMap) (b :: OccMap) :: OccMap where
    Alt ( '(n1,o1) : t1)  '[] = '(n1, Max Opt o1) : Alt t1 '[]
    Alt '[] ( '(n2,o2) : t2)  = '(n2, Max Opt o2) : Alt '[] t2
    Alt ('(n1,o1):t1) ('(n2,o2):t2) =
-     If (n1 :== n2) ('(n1, Max o1 o2) : Alt t1 t2)
-        (If (n1 :<= n2) ('(n1, Max Opt o1) : Alt t1 ('(n2,o2):t2))
+     If (n1 == n2) ('(n1, Max o1 o2) : Alt t1 t2)
+        (If (n1 <= n2) ('(n1, Max Opt o1) : Alt t1 ('(n2,o2):t2))
                         ('(n2, Max Opt o2) : Alt ('(n1,o1):t1) t2))
 
 -- | Convert all occurrences to 'Many'
@@ -174,7 +172,7 @@ type family FindH (n :: Symbol) (s :: OccMap) (s2 :: OccMap) :: Index n o s wher
   FindH n ('(n,o): s) s2 = DH
   FindH n ('(t,p): s) s2 = DT (FindH n s s2)
   FindH n '[]         s2 =
-     TypeError (Text "Hey Comcast!  I couldn't find a capture group named '" :<>:
+     TypeError (Text "Hey Haskell eXchange!  I couldn't find a capture group named '" :<>:
                 Text n :<>: Text "' in" :$$:
                 Text "    {" :<>: ShowOccMap s2 :<>: Text "}")
 
@@ -186,11 +184,13 @@ class Get (p :: Index n o s) | n s -> o where
 -- The entry we want is here!
 instance Get DH where
   getp (E v :> _ ) = v
-
+  {-# INLINE getp #-}
+
 -- Need to keep looking
 instance (Get l) => Get (DT l) where
   getp ( _ :> xs) = getp @_ @_ @_ @l xs
-
+  {-# INLINE getp #-}
+
 -- Instance for the Dictionary: if we can find the name
 -- without producing a type error, then type class
 -- resolution for Get will generate the correct accessor
@@ -199,25 +199,7 @@ instance (Get l) => Get (DT l) where
 instance (Get (Find n s :: Index n o s),
          t ~ OccType o) => HasField n (Dict s) t where
   getField = getp @_ @_ @_ @(Find n s)
-
-
-{-
-class GetField (x :: Symbol) r a | x r -> a where
-  gets :: Dict r -> a
-
-instance GetField x xs a => HasField x (Dict xs) a where
-  getField = gets
-
-instance {-# OVERLAPPING #-} (t ~ OccType o) => GetField n ('(n,o):s) t where
-  gets (E v :> _) = v
-
-instance {-# OVERLAPPING #-} (GetField n s t) => GetField n ('(m,o):s) t where
-  gets (_ :> xs) = gets @n xs
-
-instance TypeError (Text "Cannot find name ") => GetField n '[] t where
-  gets = error "unreachable"
--}
-
+  {-# INLINE getField #-}
 
 -- | Alternate interface that turns everything into a [String]
 getValues :: forall n s o.
@@ -261,12 +243,13 @@ showData SOpt  = show
 showData SMany = show
 
 -- Show a singleton Symbol Occurrence Map
+{-
 instance Show (Sing (s :: OccMap)) where
   show r = "[" ++ show' r where
     show' :: Sing (ss :: OccMap) -> String
     show' SNil = "]"
     show' (SCons (STuple2 sn so) ss) = showSym sn ++ "," ++ show' ss
-
+-}
 
 ------------------------------------------------------
 -- Operations on dictionaries (mostly used in extract, see below)
@@ -279,7 +262,7 @@ combine SNil _ Nil b = b
 combine _ SNil b Nil = b
 combine s1@(SCons (STuple2 ps so1) r1)  s2@(SCons (STuple2 pt so2) r2)
         (e1@(E ss) :> t1)              (e2@(E ts) :> t2) =
-  case ps %:== pt of
+  case ps %== pt of
    STrue  -> E (toMany so1 ss ++ toMany so2 ts) :> combine r1 r2 t1 t2
      where
        -- note that 'OccType Many' is [String]
@@ -289,7 +272,7 @@ combine s1@(SCons (STuple2 ps so1) r1)  s2@(SCons (STuple2 pt so2) r2)
        toMany SOpt  Nothing  = []
        toMany SMany ss       = ss
 
-   SFalse -> case ps %:<= pt of
+   SFalse -> case ps %<= pt of
      STrue  -> e1 :> combine r1 s2 t1 (e2 :> t2)
      SFalse -> e2 :> combine s1 r2 (e1 :> t1) t2
 
@@ -340,10 +323,10 @@ glueLeft (SCons (STuple2 ps so) t) SNil Nil =
   E (defOcc so) :> glueLeft t SNil Nil
 glueLeft (SCons e1@(STuple2 ps so1)  t1)
          (s2@(SCons (STuple2 pt so2) st2))(e2@(E ts) :> t2) =
-  case ps %:== pt of
+  case ps %== pt of
    STrue -> E tocc :> glueLeft t1 st2 t2 where
               tocc = glueOccLeft so1 so2 ts
-   SFalse -> case ps %:<= pt of
+   SFalse -> case ps %<= pt of
      STrue  -> E tocc :> glueLeft t1 s2 (e2 :> t2) where
                  tocc = defOcc so1
      SFalse -> E tocc :> glueLeft (SCons e1 t1) st2 t2 where
@@ -359,10 +342,10 @@ glueRight SNil Nil (SCons (STuple2 ps so) t) =
   E  (defOcc so) :> glueRight SNil Nil t
 glueRight s1@(SCons (STuple2 ps so1) st1) (e1@(E ss) :> t1)
           (SCons e2@(STuple2 pt so2) t2) =
-  case ps %:== pt of
+  case ps %== pt of
     STrue  -> E tocc :> glueRight st1 t1 t2 where
                 tocc = glueOccRight so1 ss so2
-    SFalse -> case ps %:<= pt of
+    SFalse -> case ps %<= pt of
       STrue  -> E tocc :> glueRight st1 t1 (SCons e2 t2) where
                   tocc = glueOccLeft SOpt so1 ss
       SFalse -> E tocc :> glueRight s1 (e1 :> t1) t2 where

regexp/src/Regexp.hs

@@ -304,6 +304,8 @@ instance Show RE  where
   show (Rnot cs) = "[^" ++ show cs ++ "]"
 
 -------------------------------------------------------------------------
+instance Semigroup Dict where
+  (<>)  = combine
 instance Monoid Dict where
   mempty  = Nil
   mappend = combine

regexp/stack.yaml

@@ -15,7 +15,12 @@
 # resolver:
 #  name: custom-snapshot
 #  location: "./custom-snapshot.yaml"
-resolver: nightly-2017-09-20
+# resolver: nightly-2017-09-20
+## GHC 8.2.2 version that works
+# resolver: lts-11.22 
+## trying GHC 8.4.3 version
+resolver: nightly-2018-10-08
+
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.