Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add new Dhall.Map module #612

Merged
merged 13 commits into from
Oct 6, 2018
Merged

Add new Dhall.Map module #612

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
13 commits
Select commit Hold shift + click to select a range
45db573
Add new `Dhall.Map` module
Gabriella439 Oct 1, 2018
5ca53a2
Rename `nub` to `nubOrd`
Gabriella439 Oct 1, 2018
5233ab7
Remove `Semigroup`/`Monoid` instances for `Dhall.Map`
Gabriella439 Oct 1, 2018
26fe69b
Fix `Monoid` instance for `Process` for GHC 8.2
Gabriella439 Oct 1, 2018
c76c749
Inlinable and Logic Optimisations (#614)
FintanH Oct 2, 2018
2cdb43b
Revert "Remove `Semigroup`/`Monoid` instances for `Dhall.Map`"
Gabriella439 Oct 3, 2018
77e1bd2
Fix lts builds (#616)
FintanH Oct 3, 2018
d537a82
Add benchmark for `Dhall.Map.union` performance
Gabriella439 Oct 4, 2018
8aba491
Add comment to explain why Functor is hand-written (#620)
FintanH Oct 4, 2018
db51b99
Merge branch 'master' into gabriel/new_map_2
Gabriella439 Oct 6, 2018
6ee4780
Add `mapMaybe`, `filter`, and `difference`
Gabriella439 Oct 6, 2018
3c5c908
Additional `INLINABLE` annotations
Gabriella439 Oct 6, 2018
f59b0a1
Add doctests for `Dhall.Map`
Gabriella439 Oct 6, 2018
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
9 changes: 3 additions & 6 deletions dhall.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -182,9 +182,7 @@ Library
directory >= 1.2.7.1 && < 1.4 ,
exceptions >= 0.8.3 && < 0.11,
filepath >= 1.4 && < 1.5 ,
hashable < 1.3 ,
haskeline >= 0.7.3.0 && < 0.8 ,
insert-ordered-containers >= 0.2.1.0 && < 0.3 ,
lens-family-core >= 1.0.0 && < 1.3 ,
megaparsec >= 7.0.0 && < 7.1 ,
memory >= 0.14 && < 0.15,
Expand Down Expand Up @@ -221,10 +219,11 @@ Library
Dhall.Hash,
Dhall.Import,
Dhall.Lint,
Dhall.Main
Dhall.Main,
Dhall.Map,
Dhall.Parser,
Dhall.Pretty,
Dhall.Repl
Dhall.Repl,
Dhall.TH,
Dhall.Tutorial,
Dhall.TypeCheck
Expand Down Expand Up @@ -270,8 +269,6 @@ Test-Suite tasty
containers ,
deepseq >= 1.2.0.1 && < 1.5 ,
dhall ,
hashable ,
insert-ordered-containers == 0.2.1.0 ,
prettyprinter ,
QuickCheck >= 2.10 && < 2.13,
quickcheck-instances >= 0.3.12 && < 0.4 ,
Expand Down
80 changes: 40 additions & 40 deletions src/Dhall.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -114,7 +114,6 @@ import qualified Control.Monad.Trans.State.Strict as State
import qualified Data.Foldable
import qualified Data.Functor.Compose
import qualified Data.Functor.Product
import qualified Data.HashMap.Strict.InsOrd
import qualified Data.Scientific
import qualified Data.Sequence
import qualified Data.Set
Expand All @@ -126,6 +125,7 @@ import qualified Dhall.Binary
import qualified Dhall.Context
import qualified Dhall.Core
import qualified Dhall.Import
import qualified Dhall.Map
import qualified Dhall.Parser
import qualified Dhall.Pretty.Internal
import qualified Dhall.TypeCheck
Expand Down Expand Up @@ -708,10 +708,10 @@ unit :: Type ()
unit = Type extractOut expectedOut
where
extractOut (RecordLit fields)
| Data.HashMap.Strict.InsOrd.null fields = return ()
| Data.Foldable.null fields = return ()
extractOut _ = Nothing

expectedOut = Record Data.HashMap.Strict.InsOrd.empty
expectedOut = Record mempty

{-| Decode a `String`

Expand All @@ -731,13 +731,13 @@ pair :: Type a -> Type b -> Type (a, b)
pair l r = Type extractOut expectedOut
where
extractOut (RecordLit fields) =
(,) <$> ( Data.HashMap.Strict.InsOrd.lookup "_1" fields >>= extract l )
<*> ( Data.HashMap.Strict.InsOrd.lookup "_2" fields >>= extract r )
(,) <$> ( Dhall.Map.lookup "_1" fields >>= extract l )
<*> ( Dhall.Map.lookup "_2" fields >>= extract r )
extractOut _ = Nothing

expectedOut =
Record
(Data.HashMap.Strict.InsOrd.fromList
(Dhall.Map.fromList
[ ("_1", expected l)
, ("_2", expected r)
]
Expand Down Expand Up @@ -864,7 +864,7 @@ instance GenericInterpret V1 where
where
extract _ = Nothing

expected = Union Data.HashMap.Strict.InsOrd.empty
expected = Union mempty

instance (Constructor c1, Constructor c2, GenericInterpret f1, GenericInterpret f2) => GenericInterpret (M1 C c1 f1 :+: M1 C c2 f2) where
genericAutoWith options@(InterpretOptions {..}) = pure (Type {..})
Expand All @@ -885,7 +885,7 @@ instance (Constructor c1, Constructor c2, GenericInterpret f1, GenericInterpret
extract _ = Nothing

expected =
Union (Data.HashMap.Strict.InsOrd.fromList [(nameL, expectedL), (nameR, expectedR)])
Union (Dhall.Map.fromList [(nameL, expectedL), (nameR, expectedR)])

Type extractL expectedL = evalState (genericAutoWith options) 1
Type extractR expectedR = evalState (genericAutoWith options) 1
Expand All @@ -904,7 +904,7 @@ instance (Constructor c, GenericInterpret (f :+: g), GenericInterpret h) => Gene
extract _ = Nothing

expected =
Union (Data.HashMap.Strict.InsOrd.insert name expectedR expectedL)
Union (Dhall.Map.insert name expectedR expectedL)

Type extractL (Union expectedL) = evalState (genericAutoWith options) 1
Type extractR expectedR = evalState (genericAutoWith options) 1
Expand All @@ -923,7 +923,7 @@ instance (Constructor c, GenericInterpret f, GenericInterpret (g :+: h)) => Gene
extract _ = Nothing

expected =
Union (Data.HashMap.Strict.InsOrd.insert name expectedL expectedR)
Union (Dhall.Map.insert name expectedL expectedR)

Type extractL expectedL = evalState (genericAutoWith options) 1
Type extractR (Union expectedR) = evalState (genericAutoWith options) 1
Expand All @@ -933,7 +933,7 @@ instance (GenericInterpret (f :+: g), GenericInterpret (h :+: i)) => GenericInte
where
extract e = fmap L1 (extractL e) <|> fmap R1 (extractR e)

expected = Union (Data.HashMap.Strict.InsOrd.union expectedL expectedR)
expected = Union (Dhall.Map.union expectedL expectedR)

Type extractL (Union expectedL) = evalState (genericAutoWith options) 1
Type extractR (Union expectedR) = evalState (genericAutoWith options) 1
Expand All @@ -948,7 +948,7 @@ instance GenericInterpret U1 where
where
extract _ = Just U1

expected = Record (Data.HashMap.Strict.InsOrd.fromList [])
expected = Record (Dhall.Map.fromList [])

instance (GenericInterpret f, GenericInterpret g) => GenericInterpret (f :*: g) where
genericAutoWith options = do
Expand All @@ -959,7 +959,7 @@ instance (GenericInterpret f, GenericInterpret g) => GenericInterpret (f :*: g)
pure
(Type
{ extract = liftA2 (liftA2 (:*:)) extractL extractR
, expected = Record (Data.HashMap.Strict.InsOrd.union ktsL ktsR)
, expected = Record (Dhall.Map.union ktsL ktsR)
}
)

Expand All @@ -975,11 +975,11 @@ instance (Selector s, Interpret a) => GenericInterpret (M1 S s (K1 i a)) where
name <- getSelName n
let extract (RecordLit m) = do
let name' = fieldModifier (Data.Text.pack name)
e <- Data.HashMap.Strict.InsOrd.lookup name' m
e <- Dhall.Map.lookup name' m
fmap (M1 . K1) (extract' e)
extract _ = Nothing
let expected =
Record (Data.HashMap.Strict.InsOrd.fromList [(key, expected')])
Record (Dhall.Map.fromList [(key, expected')])
where
key = fieldModifier (Data.Text.pack name)
pure (Type {..})
Expand Down Expand Up @@ -1117,9 +1117,9 @@ instance Inject Double where
instance Inject () where
injectWith _ = InputType {..}
where
embed = const (RecordLit Data.HashMap.Strict.InsOrd.empty)
embed = const (RecordLit mempty)

declared = Record Data.HashMap.Strict.InsOrd.empty
declared = Record mempty

instance Inject a => Inject (Maybe a) where
injectWith options = InputType embedOut declaredOut
Expand Down Expand Up @@ -1173,13 +1173,13 @@ instance (Constructor c1, Constructor c2, GenericInject f1, GenericInject f2) =>
genericInjectWith options@(InterpretOptions {..}) = pure (InputType {..})
where
embed (L1 (M1 l)) =
UnionLit keyL (embedL l) (Data.HashMap.Strict.InsOrd.singleton keyR declaredR)
UnionLit keyL (embedL l) (Dhall.Map.singleton keyR declaredR)

embed (R1 (M1 r)) =
UnionLit keyR (embedR r) (Data.HashMap.Strict.InsOrd.singleton keyL declaredL)
UnionLit keyR (embedR r) (Dhall.Map.singleton keyL declaredL)

declared =
Union (Data.HashMap.Strict.InsOrd.fromList [(keyL, declaredL), (keyR, declaredR)])
Union (Dhall.Map.fromList [(keyL, declaredL), (keyR, declaredR)])

nL :: M1 i c1 f1 a
nL = undefined
Expand All @@ -1197,7 +1197,7 @@ instance (Constructor c, GenericInject (f :+: g), GenericInject h) => GenericInj
genericInjectWith options@(InterpretOptions {..}) = pure (InputType {..})
where
embed (L1 l) =
UnionLit keyL valL (Data.HashMap.Strict.InsOrd.insert keyR declaredR ktsL')
UnionLit keyL valL (Dhall.Map.insert keyR declaredR ktsL')
where
UnionLit keyL valL ktsL' = embedL l
embed (R1 (M1 r)) = UnionLit keyR (embedR r) ktsL
Expand All @@ -1207,7 +1207,7 @@ instance (Constructor c, GenericInject (f :+: g), GenericInject h) => GenericInj

keyR = constructorModifier (Data.Text.pack (conName nR))

declared = Union (Data.HashMap.Strict.InsOrd.insert keyR declaredR ktsL)
declared = Union (Dhall.Map.insert keyR declaredR ktsL)

InputType embedL (Union ktsL) = evalState (genericInjectWith options) 1
InputType embedR declaredR = evalState (genericInjectWith options) 1
Expand All @@ -1217,7 +1217,7 @@ instance (Constructor c, GenericInject f, GenericInject (g :+: h)) => GenericInj
where
embed (L1 (M1 l)) = UnionLit keyL (embedL l) ktsR
embed (R1 r) =
UnionLit keyR valR (Data.HashMap.Strict.InsOrd.insert keyL declaredL ktsR')
UnionLit keyR valR (Dhall.Map.insert keyL declaredL ktsR')
where
UnionLit keyR valR ktsR' = embedR r

Expand All @@ -1226,7 +1226,7 @@ instance (Constructor c, GenericInject f, GenericInject (g :+: h)) => GenericInj

keyL = constructorModifier (Data.Text.pack (conName nL))

declared = Union (Data.HashMap.Strict.InsOrd.insert keyL declaredL ktsR)
declared = Union (Dhall.Map.insert keyL declaredL ktsR)

InputType embedL declaredL = evalState (genericInjectWith options) 1
InputType embedR (Union ktsR) = evalState (genericInjectWith options) 1
Expand All @@ -1235,15 +1235,15 @@ instance (GenericInject (f :+: g), GenericInject (h :+: i)) => GenericInject ((f
genericInjectWith options = pure (InputType {..})
where
embed (L1 l) =
UnionLit keyL valR (Data.HashMap.Strict.InsOrd.union ktsL' ktsR)
UnionLit keyL valR (Dhall.Map.union ktsL' ktsR)
where
UnionLit keyL valR ktsL' = embedL l
embed (R1 r) =
UnionLit keyR valR (Data.HashMap.Strict.InsOrd.union ktsL ktsR')
UnionLit keyR valR (Dhall.Map.union ktsL ktsR')
where
UnionLit keyR valR ktsR' = embedR r

declared = Union (Data.HashMap.Strict.InsOrd.union ktsL ktsR)
declared = Union (Dhall.Map.union ktsL ktsR)

InputType embedL (Union ktsL) = evalState (genericInjectWith options) 1
InputType embedR (Union ktsR) = evalState (genericInjectWith options) 1
Expand All @@ -1254,12 +1254,12 @@ instance (GenericInject f, GenericInject g) => GenericInject (f :*: g) where
InputType embedInR declaredInR <- genericInjectWith options

let embed (l :*: r) =
RecordLit (Data.HashMap.Strict.InsOrd.union mapL mapR)
RecordLit (Dhall.Map.union mapL mapR)
where
RecordLit mapL = embedInL l
RecordLit mapR = embedInR r

let declared = Record (Data.HashMap.Strict.InsOrd.union mapL mapR)
let declared = Record (Dhall.Map.union mapL mapR)
where
Record mapL = declaredInL
Record mapR = declaredInR
Expand All @@ -1269,17 +1269,17 @@ instance (GenericInject f, GenericInject g) => GenericInject (f :*: g) where
instance GenericInject U1 where
genericInjectWith _ = pure (InputType {..})
where
embed _ = RecordLit Data.HashMap.Strict.InsOrd.empty
embed _ = RecordLit mempty

declared = Record Data.HashMap.Strict.InsOrd.empty
declared = Record mempty

instance (Selector s, Inject a) => GenericInject (M1 S s (K1 i a)) where
genericInjectWith opts@(InterpretOptions {..}) = do
name <- fieldModifier . Data.Text.pack <$> getSelName n
let embed (M1 (K1 x)) =
RecordLit (Data.HashMap.Strict.InsOrd.singleton name (embedIn x))
RecordLit (Dhall.Map.singleton name (embedIn x))
let declared =
Record (Data.HashMap.Strict.InsOrd.singleton name declaredIn)
Record (Dhall.Map.singleton name declaredIn)
pure (InputType {..})
where
n :: M1 i s f a
Expand Down Expand Up @@ -1327,7 +1327,7 @@ newtype RecordType a =
RecordType
( Data.Functor.Product.Product
( Control.Applicative.Const
( Data.HashMap.Strict.InsOrd.InsOrdHashMap
( Dhall.Map.Map
Text
( Expr Src X )
)
Expand Down Expand Up @@ -1360,14 +1360,14 @@ field key valueType =
RecordLit fields <-
return expr

Data.HashMap.Strict.InsOrd.lookup key fields
Dhall.Map.lookup key fields
>>= extract valueType

in
RecordType
( Data.Functor.Product.Pair
( Control.Applicative.Const
( Data.HashMap.Strict.InsOrd.singleton
( Dhall.Map.singleton
key
( Dhall.expected valueType )
)
Expand Down Expand Up @@ -1432,21 +1432,21 @@ field key valueType =
infixr 5 >*<

newtype RecordInputType a
= RecordInputType (Data.HashMap.Strict.InsOrd.InsOrdHashMap Text (InputType a))
= RecordInputType (Dhall.Map.Map Text (InputType a))

instance Contravariant RecordInputType where
contramap f (RecordInputType inputTypeRecord) = RecordInputType $ contramap f <$> inputTypeRecord

instance Divisible RecordInputType where
divide f (RecordInputType bInputTypeRecord) (RecordInputType cInputTypeRecord) =
RecordInputType
$ Data.HashMap.Strict.InsOrd.union
$ Dhall.Map.union
((contramap $ fst . f) <$> bInputTypeRecord)
((contramap $ snd . f) <$> cInputTypeRecord)
conquer = RecordInputType Data.HashMap.Strict.InsOrd.empty
conquer = RecordInputType mempty

inputFieldWith :: Text -> InputType a -> RecordInputType a
inputFieldWith name inputType = RecordInputType $ Data.HashMap.Strict.InsOrd.singleton name inputType
inputFieldWith name inputType = RecordInputType $ Dhall.Map.singleton name inputType

inputField :: Inject a => Text -> RecordInputType a
inputField name = inputFieldWith name inject
Expand Down
Loading