Skip to content

Commit b6b3195

Browse files
marcoshepost
marcosh
authored and
epost
committed
Abbreviate repeated qualifiers #121 (#125)
* Abbreviate repeated qualifiers. #121 * Introduce TyMap, MultiTyMap. #121
1 parent 28fda18 commit b6b3195

11 files changed

+287
-243
lines changed

‎src/Language/AQL.hs

+40-25
Original file line numberDiff line numberDiff line change
@@ -1,29 +1,44 @@
1-
{-# LANGUAGE ExplicitForAll, StandaloneDeriving, DuplicateRecordFields, ScopedTypeVariables, InstanceSigs, KindSignatures, GADTs, FlexibleContexts, RankNTypes, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, AllowAmbiguousTypes, TypeOperators
2-
,LiberalTypeSynonyms, ImpredicativeTypes, UndecidableInstances, FunctionalDependencies #-}
1+
{-# LANGUAGE AllowAmbiguousTypes #-}
2+
{-# LANGUAGE DataKinds #-}
3+
{-# LANGUAGE DuplicateRecordFields #-}
4+
{-# LANGUAGE ExplicitForAll #-}
5+
{-# LANGUAGE FlexibleContexts #-}
6+
{-# LANGUAGE FlexibleInstances #-}
7+
{-# LANGUAGE FunctionalDependencies #-}
8+
{-# LANGUAGE GADTs #-}
9+
{-# LANGUAGE ImpredicativeTypes #-}
10+
{-# LANGUAGE InstanceSigs #-}
11+
{-# LANGUAGE LiberalTypeSynonyms #-}
12+
{-# LANGUAGE MultiParamTypeClasses #-}
13+
{-# LANGUAGE RankNTypes #-}
14+
{-# LANGUAGE ScopedTypeVariables #-}
15+
{-# LANGUAGE TypeOperators #-}
16+
{-# LANGUAGE TypeSynonymInstances #-}
17+
{-# LANGUAGE UndecidableInstances #-}
318

419
module Language.AQL where
520

6-
import Prelude hiding (EQ,exp)
7-
import qualified Data.Map.Strict as Map
8-
import Language.Graph
9-
import Language.Common as C
10-
import Language.Term as Term
11-
import Language.Schema as S
12-
import Language.Instance as I
13-
import Language.Mapping as M
14-
import Language.Typeside as T
15-
import Language.Transform as Tr
16-
import Language.Query as Q
17-
import Data.List (nub)
18-
import Data.Maybe
19-
import Language.Parser (parseAqlProgram)
20-
import Language.Program as P
21-
import Data.Typeable
22-
import Language.Options
23-
import System.IO.Unsafe
24-
import Control.DeepSeq
25-
import Control.Concurrent
26-
import Control.Exception
21+
import Control.Concurrent
22+
import Control.DeepSeq
23+
import Control.Exception
24+
import Data.List (nub)
25+
import qualified Data.Map.Strict as Map
26+
import Data.Maybe
27+
import Data.Typeable
28+
import Language.Common as C
29+
import Language.Graph
30+
import Language.Instance as I
31+
import Language.Mapping as M
32+
import Language.Options
33+
import Language.Parser (parseAqlProgram)
34+
import Language.Program as P
35+
import Language.Query as Q
36+
import Language.Schema as S
37+
import Language.Term as Term
38+
import Language.Transform as Tr
39+
import Language.Typeside as T
40+
import Prelude hiding (EQ)
41+
import System.IO.Unsafe
2742

2843
-- | Timesout a computation after @i@ microseconds.
2944
timeout' :: NFData x => Integer -> Err x -> Err x
@@ -258,7 +273,7 @@ getKindCtx g v k = case k of
258273
MAPPING -> fmap ExpM $ n $ Map.lookup v $ mappings g
259274
TRANSFORM -> fmap ExpT $ n $ Map.lookup v $ transforms g
260275
QUERY -> fmap ExpQ $ n $ Map.lookup v $ queries g
261-
_ -> error "todo"
276+
_ -> error "todo"
262277
where
263278
n :: forall x. Maybe x -> Err x
264279
n x = note ("Undefined " ++ show k ++ ": " ++ v) x
@@ -333,7 +348,7 @@ evalTypeside p e (TypesideRaw r) = do
333348
evalTypesideRaw (other e) r x
334349

335350
evalTypeside _ env (TypesideVar v) = case Map.lookup v $ typesides env of
336-
Nothing -> Left $ "Undefined typeside: " ++ show v
351+
Nothing -> Left $ "Undefined typeside: " ++ show v
337352
Just (TypesideEx e) -> Right $ TypesideEx e
338353

339354
evalTypeside _ _ TypesideSql = pure $ TypesideEx $ sqlTypeside

‎src/Language/Common.hs

+42-18
Original file line numberDiff line numberDiff line change
@@ -1,16 +1,33 @@
1-
{-# LANGUAGE ExplicitForAll, StandaloneDeriving, DuplicateRecordFields, ScopedTypeVariables, InstanceSigs, KindSignatures, GADTs, FlexibleContexts, RankNTypes, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, AllowAmbiguousTypes, TypeOperators
2-
,LiberalTypeSynonyms, ImpredicativeTypes, UndecidableInstances, FunctionalDependencies, ConstraintKinds, TypeFamilies, DataKinds #-}
1+
{-# LANGUAGE AllowAmbiguousTypes #-}
2+
{-# LANGUAGE ConstraintKinds #-}
3+
{-# LANGUAGE DataKinds #-}
4+
{-# LANGUAGE DuplicateRecordFields #-}
5+
{-# LANGUAGE ExplicitForAll #-}
6+
{-# LANGUAGE FlexibleContexts #-}
7+
{-# LANGUAGE FlexibleInstances #-}
8+
{-# LANGUAGE GADTs #-}
9+
{-# LANGUAGE ImpredicativeTypes #-}
10+
{-# LANGUAGE InstanceSigs #-}
11+
{-# LANGUAGE KindSignatures #-}
12+
{-# LANGUAGE LiberalTypeSynonyms #-}
13+
{-# LANGUAGE MultiParamTypeClasses #-}
14+
{-# LANGUAGE RankNTypes #-}
15+
{-# LANGUAGE ScopedTypeVariables #-}
16+
{-# LANGUAGE TypeFamilies #-}
17+
{-# LANGUAGE TypeOperators #-}
18+
{-# LANGUAGE TypeSynonymInstances #-}
19+
{-# LANGUAGE UndecidableInstances #-}
320

421
module Language.Common where
5-
import Data.Map.Strict as Map hiding (foldl)
6-
import Data.Foldable as Foldable (foldl, toList)
7-
import Data.Kind
8-
import Data.Typeable
9-
import Control.DeepSeq
10-
import Control.Arrow (left)
11-
import Data.Maybe
12-
import Data.Set as Set (Set, empty, member, insert, singleton)
13-
import Data.Char
22+
23+
import Control.Arrow (left)
24+
import Data.Char
25+
import Data.Foldable as Foldable (foldl, toList)
26+
import Data.Kind
27+
import Data.Map.Strict as Map hiding (foldl)
28+
import Data.Maybe
29+
import Data.Set as Set (Set, empty, insert, member, singleton)
30+
import Data.Typeable
1431

1532
split' :: [(a, Either b1 b2)] -> ([(a, b1)], [(a, b2)])
1633
split' [] = ([],[])
@@ -101,14 +118,21 @@ member' k m = elem' k (Map.keys m)
101118
mergeMaps :: Ord k => [Map k v] -> Map k v
102119
mergeMaps = foldl Map.union Map.empty
103120

121+
-- | Allows to set a constraint for multiple type variables at the same time.
122+
-- For example you could use `TyMap Show '[a, b, c]` instead of
123+
-- `(Show a, Show b, Show c)`
124+
-- The drawback of using this is that the compiler will treat this as a unique
125+
-- constraint, so it won't be able to detect specific unused constraints
104126
type family TyMap (f :: * -> Constraint) (xs :: [*]) :: Constraint
105127
type instance TyMap f '[] = ()
106128
type instance TyMap f (t ': ts) = (f t, TyMap f ts)
107129

108-
type family ShowOrdN (xs :: [*]) :: Constraint
109-
type instance ShowOrdN '[] = ()
110-
type instance ShowOrdN (t ': ts) = (Show t, Ord t, NFData t, ShowOrdN ts)
111-
112-
type family ShowOrdTypeableN (xs :: [*]) :: Constraint
113-
type instance ShowOrdTypeableN '[] = ()
114-
type instance ShowOrdTypeableN (t ': ts) = (Show t, Ord t, Typeable t, NFData t, ShowOrdTypeableN ts)
130+
-- | Allows to set multiple contraints for multiple type variables at the same
131+
-- time.
132+
-- For example you could use `MultiTyMap '[Show, Ord] '[a, b, c]` insted of
133+
-- `(Show a, Ord a, Show b, Ord b, Show c, Ord c)`
134+
-- The drawback of using this is that the compiler will treat this as a unique
135+
-- constraint, so it won't be able to detect specific unused constraints
136+
type family MultiTyMap (fs :: [* -> Constraint]) (xs :: [*]) :: Constraint
137+
type instance MultiTyMap '[] _ = ()
138+
type instance MultiTyMap (f : fs) xs = (TyMap f xs, MultiTyMap fs xs)

0 commit comments

Comments
 (0)