Skip to content

Commit 3743982

Browse files
marcoshmarcosh
committed
abbreviate repeated qualifiers #121 
1 parent 72557df commit 3743982

11 files changed

+299
-243
lines changed

‎src/Language/AQL.hs

+47-33
Original file line numberDiff line numberDiff line change
@@ -1,30 +1,45 @@
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)
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.Timeout
24-
import System.IO.Unsafe
25-
import Control.DeepSeq
26-
import Control.Concurrent
27-
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
42+
import System.Timeout
2843

2944
-- works
3045
timeout' :: (Show x, NFData x) => Integer -> Err x -> Err x
@@ -262,7 +277,7 @@ getKindCtx g v k = case k of
262277
MAPPING -> fmap ExpM $ n $ Map.lookup v $ mappings g
263278
TRANSFORM -> fmap ExpT $ n $ Map.lookup v $ transforms g
264279
QUERY -> fmap ExpQ $ n $ Map.lookup v $ queries g
265-
_ -> error "todo"
280+
_ -> error "todo"
266281
where
267282
n :: forall x. Maybe x -> Err x
268283
n x = note ("Undefined " ++ show k ++ ": " ++ v) x
@@ -322,19 +337,18 @@ evalTypeside p e (TypesideRaw r) = do
322337
x <- mapM (evalTypeside p e) $ tsraw_imports r
323338
evalTypesideRaw (other e) r x
324339
evalTypeside _ env (TypesideVar v) = case Map.lookup v $ typesides env of
325-
Nothing -> Left $ "Undefined typeside: " ++ show v
340+
Nothing -> Left $ "Undefined typeside: " ++ show v
326341
Just (TypesideEx e) -> Right $ TypesideEx e
327342
evalTypeside _ _ TypesideInitial = pure $ TypesideEx $ initialTypeside
328343

329-
convSchema :: (Typeable var1, Typeable ty1, Typeable sym1, Typeable en1, Typeable fk1, Typeable att1,
330-
Typeable var, Typeable ty, Typeable sym, Typeable en, Typeable fk, Typeable att)
331-
=> Schema var1 ty1 sym1 en1 fk1 att1 -> Schema var ty sym en fk att
344+
convSchema
345+
:: TyMap Typeable '[var1, ty1, sym1, en1, fk1, att1, var, ty, sym, en, fk, att]
346+
=> Schema var1 ty1 sym1 en1 fk1 att1 -> Schema var ty sym en fk att
332347
convSchema x = fromJust $ cast x
333348

334-
convInstance :: (Typeable var1, Typeable ty1, Typeable sym1, Typeable en1, Typeable fk1, Typeable att1,
335-
Typeable var, Typeable ty, Typeable sym, Typeable en, Typeable fk, Typeable att,
336-
Typeable gen, Typeable gen', Typeable sk, Typeable sk', Typeable x, Typeable x', Typeable y, Typeable y')
337-
=> Instance var1 ty1 sym1 en1 fk1 att1 gen' sk' x' y' -> Instance var ty sym en fk att gen sk x y
349+
convInstance
350+
:: TyMap Typeable '[var1, ty1, sym1, en1, fk1, att1, var, ty, sym, en, fk, att, gen, gen', sk, sk', x, x', y, y']
351+
=> Instance var1 ty1 sym1 en1 fk1 att1 gen' sk' x' y' -> Instance var ty sym en fk att gen sk x y
338352
convInstance x = fromJust $ cast x
339353

340354
evalTransform :: Prog -> Env -> TransformExp -> Err TransformEx

‎src/Language/Common.hs

+34-17
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)
13-
import Data.Char
22+
import Control.Arrow (left)
23+
import Control.DeepSeq
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)
30+
import Data.Typeable
1431

1532
showCtx :: (Show a1, Show a2) => Map a1 a2 -> [Char]
1633
showCtx m = intercalate " " $ Prelude.map (\(k,v) -> show k ++ " : " ++ show v) $ Map.toList m
@@ -97,10 +114,10 @@ type family TyMap (f :: * -> Constraint) (xs :: [*]) :: Constraint
97114
type instance TyMap f '[] = ()
98115
type instance TyMap f (t ': ts) = (f t, TyMap f ts)
99116

100-
type family ShowOrdN (xs :: [*]) :: Constraint
101-
type instance ShowOrdN '[] = ()
102-
type instance ShowOrdN (t ': ts) = (Show t, Ord t, NFData t, ShowOrdN ts)
117+
type family ShowOrdNFDataN (xs :: [*]) :: Constraint
118+
type instance ShowOrdNFDataN '[] = ()
119+
type instance ShowOrdNFDataN (t ': ts) = (Show t, Ord t, NFData t, ShowOrdNFDataN ts)
103120

104-
type family ShowOrdTypeableN (xs :: [*]) :: Constraint
105-
type instance ShowOrdTypeableN '[] = ()
106-
type instance ShowOrdTypeableN (t ': ts) = (Show t, Ord t, Typeable t, NFData t, ShowOrdTypeableN ts)
121+
type family ShowOrdTypeableNFDataN (xs :: [*]) :: Constraint
122+
type instance ShowOrdTypeableNFDataN '[] = ()
123+
type instance ShowOrdTypeableNFDataN (t ': ts) = (Show t, Ord t, Typeable t, NFData t, ShowOrdTypeableNFDataN ts)

0 commit comments

Comments
 (0)