Support GHC 8.10.7

.gitignore

@@ -5,4 +5,5 @@ http/cql-http.cabal
 .DS_Store
 *.yaml#
 *.cql#
+dist-newstyle/
 

http/src/Api/Config/Environment.hs

@@ -18,6 +18,7 @@ GNU Affero General Public License for more details.
 You should have received a copy of the GNU Affero General Public License
 along with this program.  If not, see <https://www.gnu.org/licenses/>.
 -}
+{-# LANGUAGE DerivingStrategies #-}
 module Api.Config.Environment where
 
 -- wai
@@ -29,7 +30,7 @@ import           Network.Wai.Middleware.RequestLogger (logStdout, logStdoutDev)
 data Environment
   = Development
   | Production
-  deriving (Show, Read)
+  deriving stock (Show, Read)
 
 logger :: Environment -> Middleware
 logger Development = logStdoutDev

package.yaml

@@ -64,11 +64,14 @@ ghc-options:
 - -Wno-missing-export-lists
 - -Wno-missing-import-lists
 - -Wno-safe
+- -Wno-missing-safe-haskell-mode
 - -Wno-missing-local-signatures
 - -Wno-unsafe
 - -Wno-monomorphism-restriction
 - -Wno-unused-type-patterns
 - -Wno-name-shadowing
+- -Wno-prepositive-qualified-module
+- -Wno-unused-packages
 
 executables:
   cql:

src/Language/CQL/Collage.hs

@@ -21,22 +21,23 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 {-# LANGUAGE AllowAmbiguousTypes   #-}
 {-# LANGUAGE DataKinds             #-}
 {-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE ExplicitForAll        #-}
+
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE GADTs                 #-}
 {-# LANGUAGE ImpredicativeTypes    #-}
 {-# LANGUAGE IncoherentInstances   #-}
-{-# LANGUAGE InstanceSigs          #-}
+
 {-# LANGUAGE LiberalTypeSynonyms   #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE RankNTypes            #-}
+
 {-# LANGUAGE ScopedTypeVariables   #-}
-{-# LANGUAGE StandaloneDeriving    #-}
+
 {-# LANGUAGE TupleSections         #-}
 {-# LANGUAGE TypeOperators         #-}
-{-# LANGUAGE TypeSynonymInstances  #-}
+
 {-# LANGUAGE UndecidableInstances  #-}
+{-# LANGUAGE DerivingStrategies #-}
 
 module Language.CQL.Collage where
 
@@ -60,7 +61,7 @@ data Collage var ty sym en fk att gen sk
   , catts :: Map att (en  , ty)
   , cgens :: Map gen en
   , csks  :: Map sk ty
-  } deriving (Eq, Show)
+  } deriving stock (Eq, Show)
 
 --------------------------------------------------------------------------------
 
@@ -95,12 +96,12 @@ eqsAreGround col = Prelude.null [ x | x <- Set.toList $ ceqs col, not $ Map.null
 fksFrom :: Eq en => Collage var ty sym en fk att gen sk -> en -> [(fk,en)]
 fksFrom sch en' = f $ Map.assocs $ cfks sch
   where f []               = []
-        f ((fk,(en1,t)):l) = if en1 == en' then (fk,t) : (f l) else f l
+        f ((fk,(en1,t)):l) = if en1 == en' then (fk,t) : f l else f l
 
 attsFrom :: Eq en => Collage var ty sym en fk att gen sk -> en -> [(att,ty)]
 attsFrom sch en' = f $ Map.assocs $ catts sch
   where f []               = []
-        f ((fk,(en1,t)):l) = if en1 == en' then (fk,t) : (f l) else f l
+        f ((fk,(en1,t)):l) = if en1 == en' then (fk,t) : f l else f l
 
 -- TODO Carrier is duplicated here from Instance.Algebra (Carrier) because it is used in assembleGens.
 type Carrier en fk gen = Term Void Void Void en fk Void gen Void
@@ -176,23 +177,23 @@ typeOf' col _ (Sk s) = case Map.lookup s $ csks col of
 typeOf' col ctx xx@(Fk f a) = case Map.lookup f $ cfks col of
   Nothing     -> Left $ "Unknown foreign key: " ++ show f
   Just (s, t) -> do s' <- typeOf' col ctx a
-                    if (Right s) == s' then pure $ Right t else Left $ "Expected argument to have entity " ++
-                     show s ++ " but given " ++ show s' ++ " in " ++ (show xx)
+                    if Right s == s' then pure $ Right t else Left $ "Expected argument to have entity " ++
+                     show s ++ " but given " ++ show s' ++ " in " ++ show xx
 typeOf' col ctx xx@(Att f a) = case Map.lookup f $ catts col of
   Nothing -> Left $ "Unknown attribute: " ++ show f
   Just (s, t) -> do s' <- typeOf' col ctx a
-                    if (Right s) == s' then pure $ Left t else Left $ "Expected argument to have entity " ++
-                     show s ++ " but given " ++ show s' ++ " in " ++ (show xx)
+                    if Right s == s' then pure $ Left t else Left $ "Expected argument to have entity " ++
+                     show s ++ " but given " ++ show s' ++ " in " ++ show xx
 typeOf' col ctx xx@(Sym f a) = case Map.lookup f $ csyms col of
   Nothing -> Left $ "Unknown function symbol: " ++ show f
   Just (s, t) -> do s' <- mapM (typeOf' col ctx) a
                     if length s' == length s
                     then if (Left <$> s) == s'
                          then pure $ Left t
                          else Left $ "Expected arguments to have types " ++
-                     show s ++ " but given " ++ show s' ++ " in " ++ (show $ xx)
+                     show s ++ " but given " ++ show s' ++ " in " ++ show xx
                     else Left $ "Expected argument to have arity " ++
-                     show (length s) ++ " but given " ++ show (length s') ++ " in " ++ (show $ xx)
+                     show (length s) ++ " but given " ++ show (length s') ++ " in " ++ show xx
 
 typeOfEq'
   :: (MultiTyMap '[Show, Ord, NFData] '[var, ty, sym, en, fk, att, gen, sk])

src/Language/CQL/Common.hs

@@ -37,17 +37,17 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 {-# LANGUAGE TypeOperators         #-}
 {-# LANGUAGE TypeSynonymInstances  #-}
 {-# LANGUAGE UndecidableInstances  #-}
+{-# LANGUAGE DerivingStrategies #-}
 
 module Language.CQL.Common where
 
 import           Control.Arrow   (left)
 import           Data.Char
-import           Data.Foldable   as Foldable (foldl, toList)
+import           Data.Foldable   as Foldable (toList)
 import           Data.Kind
 import           Data.Map.Strict as Map hiding (foldl)
 import           Data.Maybe
 import           Data.Set        as Set (Set, empty, insert, member, singleton)
-import           Data.String     (lines)
 import           Data.Typeable
 
 split' :: [(a, Either b1 b2)] -> ([(a, b1)], [(a, b2)])
@@ -101,7 +101,7 @@ note :: b -> Maybe a -> Either b a
 note n = maybe (Left n) Right
 
 data Kind = CONSTRAINTS | TYPESIDE | SCHEMA | INSTANCE | MAPPING | TRANSFORM | QUERY | COMMAND | GRAPH | COMMENT | SCHEMA_COLIMIT
-  deriving (Show, Eq, Ord)
+  deriving stock (Show, Eq, Ord)
 
 type ID = Integer
 
@@ -153,7 +153,7 @@ mergeMaps = foldl Map.union Map.empty
 -- `(Show a, Show b, Show c)`
 -- The drawback of using this is that the compiler will treat this as a unique
 -- constraint, so it won't be able to detect specific unused constraints
-type family TyMap (f :: * -> Constraint) (xs :: [*]) :: Constraint
+type family TyMap (f :: Type -> Constraint) (xs :: [Type]) :: Constraint
 type instance TyMap f '[] = ()
 type instance TyMap f (t ': ts) = (f t, TyMap f ts)
 
@@ -163,6 +163,6 @@ type instance TyMap f (t ': ts) = (f t, TyMap f ts)
 -- `(Show a, Ord a, Show b, Ord b, Show c, Ord c)`
 -- The drawback of using this is that the compiler will treat this as a unique
 -- constraint, so it won't be able to detect specific unused constraints
-type family MultiTyMap (fs :: [* -> Constraint]) (xs :: [*]) :: Constraint
+type family MultiTyMap (fs :: [Type -> Constraint]) (xs :: [Type]) :: Constraint
 type instance MultiTyMap '[] _ = ()
 type instance MultiTyMap (f : fs) xs = (TyMap f xs, MultiTyMap fs xs)

src/Language/CQL/Graph.hs

@@ -18,12 +18,12 @@ GNU Affero General Public License for more details.
 You should have received a copy of the GNU Affero General Public License
 along with this program.  If not, see <https://www.gnu.org/licenses/>.
 -}
-
+{-# LANGUAGE DerivingStrategies #-}
 module Language.CQL.Graph where
 
 import           Prelude
 
-data Graph a = Graph { vertices :: [a], edges :: [(a, a)] } deriving Show
+data Graph a = Graph { vertices :: [a], edges :: [(a, a)] } deriving stock Show
 
 removeEdge :: (Eq a) => (a, a) -> Graph a -> Graph a
 removeEdge x (Graph v e) = Graph v (filter (/=x) e)

src/Language/CQL/Instance.hs

@@ -35,14 +35,16 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 {-# LANGUAGE TypeOperators         #-}
 {-# LANGUAGE TypeSynonymInstances  #-}
 {-# LANGUAGE UndecidableInstances  #-}
+{-# LANGUAGE DerivingStrategies #-}
 
 module Language.CQL.Instance where
 
 import           Control.DeepSeq
 import           Control.Monad
-import           Data.List             as List hiding (intercalate)
+import qualified Data.List             as List hiding (intercalate)
 import           Data.Map.Strict       (Map, member, unionWith, (!))
 import qualified Data.Map.Strict       as Map
+import           Data.Kind
 import           Data.Maybe
 import           Data.Set              (Set)
 import qualified Data.Set              as Set
@@ -90,7 +92,7 @@ instance TyMap NFData '[var, ty, sym, en, fk, att, gen, sk, x, y]
   rnf (Instance s0 p0 dp0 a0) = deepseq s0 $ deepseq p0 $ deepseq dp0 $ rnf a0
 
 -- | A dynamically typed instance.
-data InstanceEx :: * where
+data InstanceEx :: Type where
   InstanceEx
     :: forall var ty sym en fk att gen sk x y
     .  (MultiTyMap '[Show, Ord, Typeable, NFData] '[var, ty, sym, en, fk, att, gen, sk, x, y])
@@ -282,7 +284,7 @@ dedup
   :: (EQ var ty sym en fk att gen sk -> Bool)
   -> [Carrier en fk gen]
   -> [Carrier en fk gen]
-dedup dp' = nubBy (\x y -> dp' (EQ (upp x, upp y)))
+dedup dp' = List.nubBy (\x y -> dp' (EQ (upp x, upp y)))
 
 close1
   :: (MultiTyMap '[Show, Ord, NFData] '[var, ty, sym, en, fk, att, gen, sk])
@@ -313,7 +315,7 @@ data InstanceExp where
   InstanceRaw     :: InstExpRaw'                                     -> InstanceExp
   InstancePivot   :: InstanceExp                                     -> InstanceExp
 
-  deriving (Eq, Show)
+  deriving stock (Eq, Show)
 
 instance Deps InstanceExp where
   deps x = case x of
@@ -351,7 +353,7 @@ data InstExpRaw' =
   , instraw_oeqs    :: [(RawTerm, RawTerm)]
   , instraw_options :: [(String, String)]
   , instraw_imports :: [InstanceExp]
-} deriving (Eq, Show)
+} deriving stock (Eq, Show)
 
 type Gen = String
 type Sk  = String
@@ -457,7 +459,7 @@ emptyInstance ts'' =
       (const Set.empty) (const undefined) (const undefined)
       Set.empty)
 
--- | Pivot an instance. The returned schema will not have strings as fks etc, so it will be impossible to write a literal on it, at least for now. 
+-- | Pivot an instance. The returned schema will not have strings as fks etc, so it will be impossible to write a literal on it, at least for now.
 --   (Java CQL hacks around this by landing on String.)
 pivot
   :: forall var ty sym en fk att gen sk x y

src/Language/CQL/Instance/Algebra.hs

@@ -34,14 +34,14 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 {-# LANGUAGE TupleSections         #-}
 {-# LANGUAGE TypeOperators         #-}
 {-# LANGUAGE TypeSynonymInstances  #-}
+{-# LANGUAGE DerivingStrategies  #-}
 {-# LANGUAGE UndecidableInstances  #-}
 
 module Language.CQL.Instance.Algebra where
 
 import           Control.DeepSeq
 import           Control.Monad
 import qualified Data.Foldable         as Foldable
-import           Data.List             as List hiding (intercalate)
 import           Data.Map.Strict       (Map, (!))
 import qualified Data.Map.Strict       as Map
 import           Data.Set              (Set)
@@ -192,9 +192,9 @@ instance TyMap Show '[en, fk, att, gen, sk] => Show (TalgGen en fk att gen sk) w
   show (MkTalgGen (Left  x)) = show x
   show (MkTalgGen (Right x)) = show x
 
-deriving instance TyMap Ord '[en, fk, att, gen, sk] => Ord (TalgGen en fk att gen sk)
+deriving stock instance TyMap Ord '[en, fk, att, gen, sk] => Ord (TalgGen en fk att gen sk)
 
-deriving instance TyMap Eq '[fk, att, gen, sk] => Eq (TalgGen en fk att gen sk)
+deriving stock instance TyMap Eq '[fk, att, gen, sk] => Eq (TalgGen en fk att gen sk)
 
 ---------------------------------------------------------------------------------------------------------------
 -- Functorial data migration

src/Language/CQL/Internal.hs

@@ -26,22 +26,23 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
            , MultiParamTypeClasses
            , FunctionalDependencies
 #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE ImportQualifiedPost #-}
 module Language.CQL.Internal where
 
 import           Prelude                       hiding (abs, any)
 
 import           Control.Arrow
 import           Control.Monad
 import           Control.Monad.Trans.UnionFind (Point, UnionFindT, fresh)
-import qualified Control.Monad.Trans.UnionFind as U
+import Control.Monad.Trans.UnionFind qualified as U
 
-import qualified Data.List                     as L
+import Data.List qualified                     as L
 --import           Data.Sequence (Seq)
 import           Data.Foldable                 (traverse_)
 import           Data.Graph.Inductive          hiding (Graph)
 import           Data.Map                      (Map)
 import           Data.Maybe                    (fromJust)
-import           Data.Traversable              (traverse)
 
 
 
@@ -51,10 +52,10 @@ data Equation t
   =    Equal (Term t) (Term t)
   | NotEqual (Term t) (Term t)
 data Term t = Function t [Term t]
-  deriving (Eq, Ord)
+  deriving stock (Eq, Ord)
 
 data Satisfiability t = Satisfiable (Model t) | Unsatisfiable
-  deriving (Show, Eq)
+  deriving stock (Show, Eq)
 
 type Model t = Map (Term t) (Term t)
 

src/Language/CQL/Mapping.hs

@@ -36,15 +36,16 @@ along with this program.  If not, see <https://www.gnu.org/licenses/>.
 {-# LANGUAGE TypeOperators         #-}
 {-# LANGUAGE TypeSynonymInstances  #-}
 {-# LANGUAGE UndecidableInstances  #-}
+{-# LANGUAGE DerivingStrategies #-}
 
 module Language.CQL.Mapping where
 
 import           Control.DeepSeq
-import           Data.Map.Strict       (Map)
 import           Data.Map.Strict       as Map
 import           Data.Maybe
 import qualified Data.Set              as Set
 import           Data.Typeable
+import           Data.Kind
 import           Data.Void
 import           Language.CQL.Common
 import           Language.CQL.Morphism (Morphism(..), translate, translate')
@@ -149,7 +150,7 @@ data MappingExp where
   MappingId      :: SchemaExp                -> MappingExp
   MappingRaw     :: MappingExpRaw'           -> MappingExp
   MappingComp    :: MappingExp -> MappingExp -> MappingExp
-  deriving (Eq, Show)
+  deriving stock (Eq, Show)
 
 getOptionsMapping :: MappingExp -> [(String, String)]
 getOptionsMapping x = case x of
@@ -165,13 +166,13 @@ instance Deps MappingExp where
     MappingComp f g -> deps f ++ deps g
     MappingRaw (MappingExpRaw' s t _ _ _ _ i) -> deps s ++ deps t ++ concatMap deps i
 
-data MappingEx :: * where
+data MappingEx :: Type where
   MappingEx
     :: forall var ty sym en fk att en' fk' att' . (MultiTyMap '[Show, Ord, Typeable, NFData] '[var, ty, sym, en, fk, att, en', fk', att'])
     => Mapping var ty sym en fk att en' fk' att'
     -> MappingEx
 
-deriving instance Show MappingEx
+deriving stock instance Show MappingEx
 
 instance NFData MappingEx where
   rnf (MappingEx x) = rnf x
@@ -205,7 +206,7 @@ data MappingExpRaw' =
   , mapraw_atts    :: [(String, (String, Maybe String, RawTerm)+[String])]
   , mapraw_options :: [(String, String)]
   , mapraw_imports :: [MappingExp]
-} deriving (Eq, Show)
+} deriving stock (Eq, Show)
 
 -- | Does the hard work of @evalMappingRaw@.
 evalMappingRaw'