type-level-kv-list (empty) → 0.2.0.0
raw patch · 6 files changed
+352/−0 lines, 6 filesdep +Globdep +basedep +doctestsetup-changed
Dependencies added: Glob, base, doctest, type-level-kv-list
Files
- LICENSE +21/−0
- README.md +9/−0
- Setup.hs +2/−0
- src/Data/KVList.hs +133/−0
- test/DocTest.hs +57/−0
- type-level-kv-list.cabal +130/−0
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2016 Kadzuya OKAMOTO++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,9 @@+[](https://github.com/arowM/type-level-kv-list/actions/workflows/test.yaml)+[](https://hackage.haskell.org/package/type-level-kv-list)+[](http://stackage.org/lts/package/type-level-kv-list)+[](http://stackage.org/nightly/package/type-level-kv-list)++# type-level-kv-list++This library provides a brief implementation for extensible records.+It is sensitive to the ordering of key-value items, but has simple type constraints and provides short compile time.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Data/KVList.hs view
@@ -0,0 +1,133 @@+{-| This library provide a brief implementation for extensible records.+ It is sensitive to the ordering of key-value items, but has simple type constraints and provides short compile time.+-}++{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE UndecidableInstances #-}++module Data.KVList+ (+ -- * Constructors+ -- $setup+ KVList+ , (:=)((:=))+ , (&=)+ , kvcons+ , empty+ , singleton+ , ListKey(..)++ -- * Operators+ , get+ , HasKey+ , (&.)+ )+where++import Prelude++import Data.Kind (Constraint, Type)+import Data.Typeable (Typeable, typeOf)+import GHC.TypeLits (KnownSymbol, Symbol, TypeError, ErrorMessage(Text))+import GHC.OverloadedLabels (IsLabel(..))+import Unsafe.Coerce (unsafeCoerce)+++-- Constructors++{- $setup #constructors#+ We can create type level KV list as follows.++ >>> :set -XOverloadedLabels -XTypeOperators+ >>> import Prelude+ >>> import Data.KVList (empty, KVList, (:=)((:=)), (&.), (&=))+ >>> let sampleList = empty &= #foo := "str" &= #bar := 34+ >>> type SampleList = KVList '[ "foo" := String, "bar" := Int ]+-}++{-| A value with type level key.+-}+data KVList (kvs :: [Type]) where+ KVNil :: KVList '[]+ KVCons :: (KnownSymbol key) => key := v -> KVList xs -> KVList ((key := v) ': xs)++{-| -}+empty :: KVList '[]+empty = KVNil++(&=) :: (KnownSymbol k, Appended kvs '[k := v] ~ appended) => KVList kvs -> (k := v) -> KVList appended+(&=) kvs kv = append kvs (singleton kv)+{-# INLINE (&=) #-}++infixl 1 &=++{-| -}+kvcons :: (KnownSymbol k) => (k := v) -> KVList kvs -> KVList ((k := v) ': kvs)+kvcons = KVCons++{-| -}+data (key :: Symbol) := (value :: Type) where+ (:=) :: ListKey a -> b -> a := b+infix 2 :=++deriving instance (Show value) => Show (key := value)++{-| -}+type HasKey (key :: Symbol) (kvs :: [Type]) (v :: Type) = HasKey_ key kvs kvs v++type family HasKey_ (key :: Symbol) (kvs :: [Type]) (orig :: [Type]) (v :: Type) :: Constraint where+ HasKey_ key '[] '[] v = TypeError ('Text "The KVList is empty.")+ HasKey_ key '[] orig v = TypeError ('Text "The Key is not in the KVList.")+ HasKey_ key ((key := val) ': _) _ v = (val ~ v)+ HasKey_ key (_ ': kvs) orig v = HasKey_ key kvs orig v++{-| -}+type family Appended kvs1 kv2 :: [Type] where+ Appended '[] kv2 = kv2+ Appended (kv ': kvs) kv2 =+ kv ': Appended kvs kv2++{-| -}+append :: (Appended kvs1 kvs2 ~ appended) => KVList kvs1 -> KVList kvs2 -> KVList appended+append KVNil kvs2 = kvs2+append (KVCons kv kvs) kvs2 = KVCons kv (append kvs kvs2)+++{-| -}+singleton :: (KnownSymbol k) => (k := v) -> KVList '[ k := v ]+singleton kv = KVCons kv KVNil+++{-| -}+get :: (KnownSymbol key, HasKey key kvs v) => ListKey key -> KVList kvs -> v+get p kvs = get_ p kvs kvs++get_ :: (KnownSymbol key, HasKey key orig v) => ListKey key -> KVList kvs -> KVList orig -> v+get_ _ KVNil KVNil = error "Unreachable: The KVList is empty."+get_ _ KVNil _ = error "Unreachable: The Key is not in the KVList."+get_ p (KVCons (k := v) kvs) orig =+ if typeOf p == typeOf k then+ unsafeCoerce v+ else+ get_ p kvs orig+++{-| -}+(&.) :: (KnownSymbol key, HasKey key kvs v) => KVList kvs -> ListKey key -> v+(&.) kvs k = get k kvs+infixl 9 &.++{-| 'ListKey' is just a proxy, but needed to implement a non-orphan 'IsLabel' instance.+In most cases, you only need to create a `ListKey` instance with @OverloadedLabels@, such as `#foo`.+-}+data ListKey (t :: Symbol)+ = ListKey+ deriving (Show, Eq, Typeable)++instance l ~ l' => IsLabel (l :: Symbol) (ListKey l') where+#if MIN_VERSION_base(4, 10, 0)+ fromLabel = ListKey+#else+ fromLabel _ = ListKey+#endif
+ test/DocTest.hs view
@@ -0,0 +1,57 @@+module Main (main) where++import Prelude++import System.FilePath.Glob (glob)+import Test.DocTest (doctest)++main :: IO ()+main = glob "src/**/*.hs" >>= doDocTest++doDocTest :: [String] -> IO ()+doDocTest options =+ doctest $+ options <>+ ghcExtensions++ghcExtensions :: [String]+ghcExtensions =+ [ "-XBangPatterns"+ , "-XBinaryLiterals"+ , "-XConstraintKinds"+ , "-XDataKinds"+ , "-XDefaultSignatures"+ , "-XDeriveDataTypeable"+ , "-XDeriveFoldable"+ , "-XDeriveFunctor"+ , "-XDeriveGeneric"+ , "-XDeriveTraversable"+ , "-XDoAndIfThenElse"+ , "-XDuplicateRecordFields"+ , "-XEmptyDataDecls"+ , "-XExistentialQuantification"+ , "-XFlexibleContexts"+ , "-XFlexibleInstances"+ , "-XFunctionalDependencies"+ , "-XGADTs"+ , "-XGeneralizedNewtypeDeriving"+ , "-XInstanceSigs"+ , "-XKindSignatures"+ , "-XLambdaCase"+ , "-XMultiParamTypeClasses"+ , "-XMultiWayIf"+ , "-XNamedFieldPuns"+ , "-XNoImplicitPrelude"+ , "-XOverloadedStrings"+ , "-XPartialTypeSignatures"+ , "-XPatternGuards"+ , "-XPolyKinds"+ , "-XRankNTypes"+ , "-XRecordWildCards"+ , "-XScopedTypeVariables"+ , "-XStandaloneDeriving"+ , "-XTupleSections"+ , "-XTypeFamilies"+ , "-XTypeSynonymInstances"+ , "-XViewPatterns"+ ]
+ type-level-kv-list.cabal view
@@ -0,0 +1,130 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name: type-level-kv-list+version: 0.2.0.0+synopsis: Type level Key-Value list.+description: This library provides a brief implementation for extensible records.+category: Data+homepage: https://github.com/arowM/type-level-kv-list#readme+bug-reports: https://github.com/arowM/type-level-kv-list/issues+author: Sakura-chan the Goat+maintainer: arow.okamoto+github@gmail.com+copyright: 2016 Sakura-chan the Goat+license: MIT+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md++source-repository head+ type: git+ location: https://github.com/arowM/type-level-kv-list++library+ exposed-modules:+ Data.KVList+ other-modules:+ Paths_type_level_kv_list+ hs-source-dirs:+ src+ default-extensions:+ BangPatterns+ BinaryLiterals+ ConstraintKinds+ DataKinds+ DefaultSignatures+ DeriveDataTypeable+ DeriveFoldable+ DeriveFunctor+ DeriveGeneric+ DeriveTraversable+ DoAndIfThenElse+ DuplicateRecordFields+ EmptyDataDecls+ ExistentialQuantification+ FlexibleContexts+ FlexibleInstances+ FunctionalDependencies+ GADTs+ GeneralizedNewtypeDeriving+ InstanceSigs+ KindSignatures+ LambdaCase+ MultiParamTypeClasses+ MultiWayIf+ NamedFieldPuns+ OverloadedStrings+ PartialTypeSignatures+ PatternGuards+ PolyKinds+ RankNTypes+ RecordWildCards+ ScopedTypeVariables+ StandaloneDeriving+ Strict+ StrictData+ TupleSections+ TypeFamilies+ TypeSynonymInstances+ ViewPatterns+ ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+ build-depends:+ base >=4.7 && <5+ default-language: Haskell2010++test-suite doctest+ type: exitcode-stdio-1.0+ main-is: DocTest.hs+ hs-source-dirs:+ test+ default-extensions:+ BangPatterns+ BinaryLiterals+ ConstraintKinds+ DataKinds+ DefaultSignatures+ DeriveDataTypeable+ DeriveFoldable+ DeriveFunctor+ DeriveGeneric+ DeriveTraversable+ DoAndIfThenElse+ DuplicateRecordFields+ EmptyDataDecls+ ExistentialQuantification+ FlexibleContexts+ FlexibleInstances+ FunctionalDependencies+ GADTs+ GeneralizedNewtypeDeriving+ InstanceSigs+ KindSignatures+ LambdaCase+ MultiParamTypeClasses+ MultiWayIf+ NamedFieldPuns+ OverloadedStrings+ PartialTypeSignatures+ PatternGuards+ PolyKinds+ RankNTypes+ RecordWildCards+ ScopedTypeVariables+ StandaloneDeriving+ Strict+ StrictData+ TupleSections+ TypeFamilies+ TypeSynonymInstances+ ViewPatterns+ ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+ build-depends:+ Glob+ , base >=4.7 && <5+ , doctest+ , type-level-kv-list+ default-language: Haskell2010