diff --git a/.gitignore b/.gitignore index 75ec279..e0e98e5 100644 --- a/.gitignore +++ b/.gitignore @@ -5,4 +5,5 @@ http/cql-http.cabal .DS_Store *.yaml# *.cql# +dist-newstyle/ diff --git a/http/src/Api/Config/Environment.hs b/http/src/Api/Config/Environment.hs index 7f98317..a196d6b 100644 --- a/http/src/Api/Config/Environment.hs +++ b/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 . -} +{-# 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 diff --git a/package.yaml b/package.yaml index c11310b..f3c5020 100644 --- a/package.yaml +++ b/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: diff --git a/src/Language/CQL/Collage.hs b/src/Language/CQL/Collage.hs index 3b89be6..ce65f15 100644 --- a/src/Language/CQL/Collage.hs +++ b/src/Language/CQL/Collage.hs @@ -21,22 +21,23 @@ along with this program. If not, see . {-# 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,13 +177,13 @@ 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 @@ -190,9 +191,9 @@ typeOf' col ctx xx@(Sym f a) = case Map.lookup f $ csyms col of 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]) diff --git a/src/Language/CQL/Common.hs b/src/Language/CQL/Common.hs index 554674a..9bed7c7 100644 --- a/src/Language/CQL/Common.hs +++ b/src/Language/CQL/Common.hs @@ -37,17 +37,17 @@ along with this program. If not, see . {-# 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) diff --git a/src/Language/CQL/Graph.hs b/src/Language/CQL/Graph.hs index e495a31..7d23562 100644 --- a/src/Language/CQL/Graph.hs +++ b/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 . -} - +{-# 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) diff --git a/src/Language/CQL/Instance.hs b/src/Language/CQL/Instance.hs index 6b66b79..70140dd 100644 --- a/src/Language/CQL/Instance.hs +++ b/src/Language/CQL/Instance.hs @@ -35,14 +35,16 @@ along with this program. If not, see . {-# 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 diff --git a/src/Language/CQL/Instance/Algebra.hs b/src/Language/CQL/Instance/Algebra.hs index 72e71b0..eb3bb9c 100644 --- a/src/Language/CQL/Instance/Algebra.hs +++ b/src/Language/CQL/Instance/Algebra.hs @@ -34,6 +34,7 @@ along with this program. If not, see . {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE UndecidableInstances #-} module Language.CQL.Instance.Algebra where @@ -41,7 +42,6 @@ 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 diff --git a/src/Language/CQL/Internal.hs b/src/Language/CQL/Internal.hs index e15178d..d9f32d0 100644 --- a/src/Language/CQL/Internal.hs +++ b/src/Language/CQL/Internal.hs @@ -26,6 +26,8 @@ along with this program. If not, see . , MultiParamTypeClasses , FunctionalDependencies #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE ImportQualifiedPost #-} module Language.CQL.Internal where import Prelude hiding (abs, any) @@ -33,15 +35,14 @@ 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) diff --git a/src/Language/CQL/Mapping.hs b/src/Language/CQL/Mapping.hs index 9c927ce..20db22f 100644 --- a/src/Language/CQL/Mapping.hs +++ b/src/Language/CQL/Mapping.hs @@ -36,15 +36,16 @@ along with this program. If not, see . {-# 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' diff --git a/src/Language/CQL/Options.hs b/src/Language/CQL/Options.hs index d19a4cc..0099a8c 100644 --- a/src/Language/CQL/Options.hs +++ b/src/Language/CQL/Options.hs @@ -19,6 +19,7 @@ You should have received a copy of the GNU Affero General Public License along with this program. If not, see . -} {-# LANGUAGE EmptyDataDeriving #-} +{-# LANGUAGE DerivingStrategies #-} module Language.CQL.Options where @@ -150,7 +151,7 @@ data BoolOption = -- | Eval_Approx_Sql_Unsafe -- | Eval_Sql_PersistentIndices -- | Coproduct_Allow_Collisions - deriving (Eq, Ord, Show, Enum) + deriving stock (Eq, Ord, Show, Enum) data StringOption = -- Csv_File_Extension @@ -159,7 +160,7 @@ data StringOption = -- | Jdbc_Default_String -- | Completion_Precedence Prover - deriving (Eq, Ord, Show, Enum) + deriving stock (Eq, Ord, Show, Enum) -- | Accessor due to namespace colision. prover_name :: StringOption @@ -175,10 +176,10 @@ data IntOption = -- | Gui_Max_String_Size -- | Gui_Rows_To_Display -- | Eval_Max_Plan_Depth - deriving (Eq, Ord, Show, Enum) + deriving stock (Eq, Ord, Show, Enum) type CharOption = Void --data CharOption = -- Csv_Escape_Char -- Csv_Quote_Char - -- deriving (Eq, Ord, Show, Enum) + -- deriving stock (Eq, Ord, Show, Enum) diff --git a/src/Language/CQL/Parser/Parser.hs b/src/Language/CQL/Parser/Parser.hs index 3f5a2de..07a88a5 100644 --- a/src/Language/CQL/Parser/Parser.hs +++ b/src/Language/CQL/Parser/Parser.hs @@ -25,7 +25,7 @@ import Language.CQL.Parser.ReservedWords -- base import Data.Char -import Data.Functor (($>), (<$)) +import Data.Functor (($>)) -- megaparsec import Text.Megaparsec diff --git a/src/Language/CQL/Parser/Program.hs b/src/Language/CQL/Parser/Program.hs index 7e1c376..0b19ee6 100644 --- a/src/Language/CQL/Parser/Program.hs +++ b/src/Language/CQL/Parser/Program.hs @@ -21,7 +21,7 @@ along with this program. If not, see . module Language.CQL.Parser.Program where -import Data.List +import qualified Data.List as List import Data.Map as Map hiding ((\\)) import Data.Maybe import Language.CQL.Common as C @@ -37,10 +37,10 @@ import Text.Megaparsec parseProgram :: String -> Err Prog parseProgram s = case runParser parseProgram' "" s of - Left err -> Left $ "Parse error: " ++ parseErrorPretty err - Right (opts, prog) -> if length (fst $ unzip prog) == length (nub $ fst $ unzip prog) + Left err -> Left $ "Parse error: " ++ errorBundlePretty err + Right (opts, prog) -> if length (fst $ unzip prog) == length (List.nub $ fst $ unzip prog) then Right $ toProg opts prog - else Left $ "Duplicate definition: " ++ show (nub (fmap fst prog \\ nub (fmap fst prog))) + else Left $ "Duplicate definition: " ++ show (List.nub (fmap fst prog List.\\ List.nub (fmap fst prog))) -- | Returns a list of config option key-value paired with programs. parseProgram' :: Parser ([(String, String)], [(String, Exp)]) diff --git a/src/Language/CQL/Program.hs b/src/Language/CQL/Program.hs index 8ea1b3b..6613085 100644 --- a/src/Language/CQL/Program.hs +++ b/src/Language/CQL/Program.hs @@ -34,6 +34,7 @@ along with this program. If not, see . {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE UndecidableInstances #-} module Language.CQL.Program where @@ -67,7 +68,7 @@ data Val | ValM MappingEx | ValT TransformEx | ValQ QueryEx - deriving Show + deriving stock Show instance NFData Val where rnf v = case v of diff --git a/src/Language/CQL/Prover.hs b/src/Language/CQL/Prover.hs index 5999d03..bb76d5a 100644 --- a/src/Language/CQL/Prover.hs +++ b/src/Language/CQL/Prover.hs @@ -33,12 +33,13 @@ along with this program. If not, see . {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE UndecidableInstances #-} module Language.CQL.Prover where import Control.DeepSeq -import Data.List +import Data.List (elemIndex) import Data.Map import Data.Maybe import Data.Rewriting.CriticalPair as CP @@ -67,7 +68,7 @@ import Language.CQL.Internal (Term) -- Theorem proving ------------------------------------------------ data ProverName = Free | Congruence | Orthogonal | Completion | Auto - deriving Show + deriving stock Show proverStringToName :: Options -> Err ProverName proverStringToName m = case sOps m prover_name of @@ -183,7 +184,7 @@ data Constant x = Constant , con_arity :: !Int , con_size :: !Int , con_bonus :: !(Maybe (Maybe Bool)) - } deriving (Eq, Ord) + } deriving stock (Eq, Ord) instance Sized (Constant x) where size (Constant _ _ _ y _) = y @@ -207,7 +208,7 @@ instance EqualsBonus (Constant x) where isFalse = fromJust . fromJust . con_bonus data Precedence = Precedence !Bool !(Maybe Int) !Int - deriving (Eq, Ord) + deriving stock (Eq, Ord) prec :: (MultiTyMap '[Show, Ord, Typeable, NFData] '[var, ty, sym, en, fk, att, gen, sk]) diff --git a/src/Language/CQL/Query.hs b/src/Language/CQL/Query.hs index ff611a9..863bbe4 100644 --- a/src/Language/CQL/Query.hs +++ b/src/Language/CQL/Query.hs @@ -35,6 +35,7 @@ along with this program. If not, see . {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE UndecidableInstances #-} module Language.CQL.Query where @@ -42,6 +43,7 @@ import Control.DeepSeq import Data.Map.Strict as Map import Data.Set as Set import Data.Typeable +import Data.Kind import Data.Void import Language.CQL.Common import Language.CQL.Schema @@ -74,7 +76,7 @@ instance (NFData var, NFData ty, NFData sym, NFData en, NFData fk, NFData att, N => NFData (Query var ty sym en fk att en' fk' att') where rnf (Query s t e f a) = deepseq s $ deepseq t $ deepseq e $ deepseq f $ rnf a -data QueryEx :: * where +data QueryEx :: Type where QueryEx :: forall var ty sym en fk att en' fk' att' . (MultiTyMap '[Show, Ord, Typeable, NFData] '[var, ty, sym, en, fk, att, en', fk', att']) @@ -83,13 +85,13 @@ data QueryEx :: * where instance NFData QueryEx where rnf (QueryEx x) = rnf x -deriving instance Show QueryEx +deriving stock instance Show QueryEx data QueryExp where QueryVar :: String -> QueryExp QueryId :: SchemaExp -> QueryExp QueryRaw :: QueryExpRaw' -> QueryExp - deriving (Eq) + deriving stock (Eq) instance Show QueryExp where show _ = error "todo" @@ -115,7 +117,7 @@ data QueryExpRaw' = QueryExpRaw' , qraw_atts :: [(String, RawTerm)] , qraw_options :: [(String, String)] , qraw_imports :: [QueryExp] -} deriving (Eq, Show) +} deriving stock (Eq, Show) typecheckQuery :: Query var ty sym en fk att en' fk' att' diff --git a/src/Language/CQL/Schema.hs b/src/Language/CQL/Schema.hs index 3a59c9c..11ca83d 100644 --- a/src/Language/CQL/Schema.hs +++ b/src/Language/CQL/Schema.hs @@ -36,6 +36,7 @@ along with this program. If not, see . {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE DerivingStrategies #-} module Language.CQL.Schema where @@ -45,6 +46,7 @@ import Data.Bifunctor (second) import Data.List (nub) import Data.Map.Strict as Map import Data.Maybe +import Data.Kind import Data.Set as Set import Data.Typeable import Data.Void @@ -159,7 +161,7 @@ data SchemaExp where SchemaRaw :: SchemaExpRaw' -> SchemaExp -- hold off for now, causes cyclic import -- SchemaPivot :: InstanceExp -> SchemaExp - deriving (Eq,Show) + deriving stock (Eq,Show) getOptionsSchema :: SchemaExp -> [(String, String)] getOptionsSchema x = case x of @@ -175,7 +177,7 @@ instance Deps SchemaExp where SchemaCoProd a b -> deps a ++ deps b SchemaRaw (SchemaExpRaw' t _ _ _ _ _ _ i) -> deps t ++ concatMap deps i -data SchemaEx :: * where +data SchemaEx :: Type where SchemaEx :: forall var ty sym en fk att . (MultiTyMap '[Show, Ord, Typeable, NFData] '[var, ty, sym, en, fk, att]) => Schema var ty sym en fk att @@ -200,7 +202,7 @@ data SchemaExpRaw' = SchemaExpRaw' , schraw_oeqs :: [(String, Maybe String, RawTerm, RawTerm)] , schraw_options :: [(String, String)] , schraw_imports :: [SchemaExp] -} deriving (Eq, Show) +} deriving stock (Eq, Show) -- | Type of entities for literal schemas. type En = String diff --git a/src/Language/CQL/Term.hs b/src/Language/CQL/Term.hs index 07115d8..88066c4 100644 --- a/src/Language/CQL/Term.hs +++ b/src/Language/CQL/Term.hs @@ -35,6 +35,7 @@ along with this program. If not, see . {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE UndecidableInstances #-} module Language.CQL.Term where @@ -76,11 +77,11 @@ data Head ty sym en fk att gen sk | HAtt att | HGen gen | HSk sk - deriving (Eq, Ord) + deriving stock (Eq, Ord) -deriving instance TyMap Eq '[var, sym, fk, att, gen, sk] => Eq (Term var ty sym en fk att gen sk) +deriving stock instance TyMap Eq '[var, sym, fk, att, gen, sk] => Eq (Term var ty sym en fk att gen sk) -deriving instance TyMap Ord '[var, ty, sym, en, fk, att, gen, sk] => Ord (Term var ty sym en fk att gen sk) +deriving stock instance TyMap Ord '[var, ty, sym, en, fk, att, gen, sk] => Ord (Term var ty sym en fk att gen sk) instance TyMap NFData '[var, ty, sym, en, fk, att, gen, sk] => NFData (Term var ty sym en fk att gen sk) where rnf x = case x of @@ -271,9 +272,9 @@ instance Functor EQF where instance (Show a) => Show (EQF a) where show (EQ (lhs, rhs)) = show lhs ++ " = " ++ show rhs -deriving instance (Ord a) => Ord (EQF a) +deriving stock instance (Ord a) => Ord (EQF a) -deriving instance (Eq a) => Eq (EQF a) +deriving stock instance (Eq a) => Eq (EQF a) instance TyMap NFData '[var, ty, sym, en, fk, att, gen, sk] => NFData (EQ var ty sym en fk att gen sk) where rnf (EQ (x, y)) = deepseq x $ rnf y @@ -392,7 +393,7 @@ instance Up y (x + y) where -------------------------------------------------------------------------------- data RawTerm = RawApp String [RawTerm] - deriving Eq + deriving stock Eq instance Show RawTerm where show (RawApp sym az) = show sym ++ "(" ++ (intercalate "," . fmap show $ az) ++ ")" diff --git a/src/Language/CQL/Transform.hs b/src/Language/CQL/Transform.hs index 2246d3c..7bff987 100644 --- a/src/Language/CQL/Transform.hs +++ b/src/Language/CQL/Transform.hs @@ -35,6 +35,7 @@ along with this program. If not, see . {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE UndecidableInstances #-} module Language.CQL.Transform where @@ -42,6 +43,7 @@ module Language.CQL.Transform where import Control.DeepSeq import Data.Map (Map, mapWithKey) import qualified Data.Map.Strict as Map +import Data.Kind import Data.Maybe import qualified Data.Set as Set import Data.Typeable @@ -132,7 +134,7 @@ toMorphism (Transform src' dst' gens' sks') = ------------------------------------------------------------------------------------------------------------ -- Expressions -data TransformEx :: * where +data TransformEx :: Type where TransformEx :: forall var ty sym en fk att gen sk x y gen' sk' x' y' . (MultiTyMap '[Show, Ord, Typeable, NFData] '[var, ty, sym, en, fk, att, gen, sk, x, y, gen', sk', x', y']) @@ -142,7 +144,7 @@ data TransformEx :: * where instance NFData TransformEx where rnf (TransformEx x) = rnf x -deriving instance Show TransformEx +deriving stock instance Show TransformEx data TransformExp where TransformComp :: TransformExp -> TransformExp -> TransformExp @@ -160,7 +162,7 @@ data TransformExp where TransformCoEval :: QueryExp -> TransformExp -> TransformExp TransformEval :: QueryExp -> TransformExp -> TransformExp TransformRaw :: TransExpRaw' -> TransformExp - deriving Show + deriving stock Show instance Deps TransformExp where deps x = case x of @@ -268,7 +270,7 @@ data TransExpRaw' , transraw_gens :: [(String, RawTerm)] , transraw_options :: [(String, String)] , transraw_imports :: [TransformExp] -} deriving Show +} deriving stock Show -- | Evaluates a literal into a transform. evalTransformRaw diff --git a/src/Language/CQL/Typeside.hs b/src/Language/CQL/Typeside.hs index 142b061..5d8d44b 100644 --- a/src/Language/CQL/Typeside.hs +++ b/src/Language/CQL/Typeside.hs @@ -35,6 +35,7 @@ along with this program. If not, see . {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE UndecidableInstances #-} module Language.CQL.Typeside where @@ -47,6 +48,7 @@ import Data.Set (Set) import qualified Data.Set as Set import Data.Typeable import Data.Void +import Data.Kind import Language.CQL.Collage (Collage(..), typeOfCol) import Language.CQL.Common import Language.CQL.Options @@ -95,7 +97,7 @@ tsToCol (Typeside tys syms eqs _) = where leftify = Set.map (first (fmap Left)) -data TypesideEx :: * where +data TypesideEx :: Type where TypesideEx :: forall var ty sym. (MultiTyMap '[Show, Ord, Typeable, NFData] '[var, ty, sym]) => Typeside var ty sym @@ -121,7 +123,7 @@ data TypesideRaw' = TypesideRaw' , tsraw_eqs :: [([(String, Maybe String)], RawTerm, RawTerm)] , tsraw_options :: [(String, String)] , tsraw_imports :: [TypesideExp] - } deriving (Eq, Show) + } deriving stock (Eq, Show) evalTypesideRaw :: Options -> TypesideRaw' -> [TypesideEx] -> Err TypesideEx @@ -221,8 +223,8 @@ data TypesideExp where TypesideRaw :: TypesideRaw' -> TypesideExp TypesideSql :: TypesideExp -deriving instance Eq TypesideExp -deriving instance Show TypesideExp +deriving stock instance Eq TypesideExp +deriving stock instance Show TypesideExp instance Deps TypesideExp where deps x = case x of diff --git a/stack.yaml b/stack.yaml index ea9ec5a..445b976 100644 --- a/stack.yaml +++ b/stack.yaml @@ -37,7 +37,7 @@ # # resolver: ./custom-snapshot.yaml # resolver: https://example.com/snapshots/2018-01-01.yaml -resolver: lts-12.0 +resolver: lts-18.28 # User packages to be built. # Various formats can be used as shown in the example below. @@ -53,13 +53,26 @@ resolver: lts-12.0 # - auto-update # - wai packages: -- . -- http + - . + - http # Dependency packages to be pulled from upstream that are not in the resolver # using the same syntax as the packages field. # (e.g., acme-missiles-0.3) -extra-deps: [multiset-0.3.4, union-find-array-0.1.0.2, term-rewriting-0.2.1.1, jukebox-0.3.7, twee-lib-2.1.5, minisat-0.1.2, PropLogic-0.9.0.4, fgl-5.6.0.0] - +extra-deps: + [ + binary-0.8.9.1, + text-1.2.5.0, + Cabal-3.6.3.0, + parsec-3.1.15.1, + containers-0.5.11.0, + multiset-0.3.4, + union-find-array-0.1.0.2, + term-rewriting-0.4.0.2, + jukebox-0.3.7, + twee-lib-2.1.5, + minisat-0.1.2, + PropLogic-0.9.0.4, + ] # Override default flag values for local packages and extra-deps # flags: {} diff --git a/stack.yaml.lock b/stack.yaml.lock new file mode 100644 index 0000000..f773dc6 --- /dev/null +++ b/stack.yaml.lock @@ -0,0 +1,96 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: +- completed: + hackage: binary-0.8.9.1@sha256:81f468c1c75fd6535152ab69b2d32ac6cfcc03e345267b069abe4da56ec95801,6523 + pantry-tree: + sha256: 956ecd662408f69615977b87a92e042abcdc447b7824b8aabf5788c4393c10c5 + size: 1976 + original: + hackage: binary-0.8.9.1 +- completed: + hackage: text-1.2.5.0@sha256:791f0f6c97ed96113f17ab520cf0efe1a3a4f883a8c85910a5660567c8241c40,7895 + pantry-tree: + sha256: f41504ec5c04a3f3358ef104362f02fdef29cbce4e5e4e6dbd6b6db70c40d4bf + size: 7395 + original: + hackage: text-1.2.5.0 +- completed: + hackage: Cabal-3.6.3.0@sha256:ff97c442b0c679c1c9876acd15f73ac4f602b973c45bde42b43ec28265ee48f4,12459 + pantry-tree: + sha256: b250a53bdb56844f047a2927833bb565b936a289abfa85dfc2a63148d776368a + size: 19757 + original: + hackage: Cabal-3.6.3.0 +- completed: + hackage: parsec-3.1.15.1@sha256:8c7a36aaadff12a38817fc3c4ff6c87e3352cffd1a58df640de7ed7a97ad8fa3,4601 + pantry-tree: + sha256: 147ad21b8aa90273721903a6b294cc4ecd660d229d88c4e84c6275bc5d630ae6 + size: 2630 + original: + hackage: parsec-3.1.15.1 +- completed: + hackage: containers-0.5.11.0@sha256:1af9da3baaddc4f4aaea016b07d4c38ddbf702ce3f0df31120531950837996b8,17308 + pantry-tree: + sha256: febf797e5b9c013e0390cffbec266b46c68de56cd3745df6ee45d4bcff1e7cb2 + size: 4849 + original: + hackage: containers-0.5.11.0 +- completed: + hackage: multiset-0.3.4@sha256:a82739a88411afb4a8b0d4d24a89038e7e6f7291e5721816bfbfa8138498fd54,1209 + pantry-tree: + sha256: 9392bdec27f49d0426bbc7d739ab252e6fdc4e3c947977177142b99300a26b34 + size: 430 + original: + hackage: multiset-0.3.4 +- completed: + hackage: union-find-array-0.1.0.2@sha256:38c2dfbae3de48d8962f202ec5c4d6323ac767d6838b85e8d340c3608d6c0f21,1406 + pantry-tree: + sha256: e2f321041a1a777752f31bfe8d3bcf5f68d2d3ead2263560883e9610af719437 + size: 482 + original: + hackage: union-find-array-0.1.0.2 +- completed: + hackage: term-rewriting-0.4.0.2@sha256:5412f6aa29c5756634ee30e8df923c83ab9f012a4b8797c460af3d7078466764,2740 + pantry-tree: + sha256: 15a74c023b9caebbea2bda44141a060e78d46673c5768101c14fcd332c2408a0 + size: 3012 + original: + hackage: term-rewriting-0.4.0.2 +- completed: + hackage: jukebox-0.3.7@sha256:5cbddff1dd58ab34128fbc0689cadeb03df135e28f8c3e6bfa8ced3c91acffdd,2225 + pantry-tree: + sha256: eb56f51a67d919dbb63d8c6b1e34dcd09b32567b4fe55f789523fa825c558eec + size: 2236 + original: + hackage: jukebox-0.3.7 +- completed: + hackage: twee-lib-2.1.5@sha256:cd96a632c304dfc68ed4a44c357b97cd3761a50dc194860e0528121fa74157a1,2421 + pantry-tree: + sha256: 4377aa01c14110ca7ac698a256070860781882af17542d11f16db836e0195219 + size: 1533 + original: + hackage: twee-lib-2.1.5 +- completed: + hackage: minisat-0.1.2@sha256:1ab39be6c6cdbf35f6c98f64ddb39bf078e77814c0e086d73a14ff2e703a8942,1145 + pantry-tree: + sha256: 5e2b851845b28189d32ce13fb3281fdac1b9041af40d86734096824c433061fe + size: 1994 + original: + hackage: minisat-0.1.2 +- completed: + hackage: PropLogic-0.9.0.4@sha256:445319a0ceb4e94520d7eff11b2e049e507795246bdbbdf593457bd11ec69cc4,1072 + pantry-tree: + sha256: bcc092944daafb1458f1d0a26f09ef90b4fdfb7ea1437524668fe9bb231108b1 + size: 599 + original: + hackage: PropLogic-0.9.0.4 +snapshots: +- completed: + sha256: 428ec8d5ce932190d3cbe266b9eb3c175cd81e984babf876b64019e2cbe4ea68 + size: 590100 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/28.yaml + original: lts-18.28