type-level-kv-list 1.1.0 → 2.0.0

raw patch · 7 files changed

+324/−188 lines, 7 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• README.md +9/−0
• src/Data/KVList.hs +133/−0
• src/Data/TypeLevelKVList.hs +0/−130
• test/DocTest.hs +57/−0
• test/Doctest.hs +0/−17
• test/Spec.hs +0/−2
• type-level-kv-list.cabal +125/−39

@@ -0,0 +1,9 @@+[![test](https://github.com/arowM/type-level-kv-list/actions/workflows/test.yaml/badge.svg)](https://github.com/arowM/type-level-kv-list/actions/workflows/test.yaml)+[![Hackage](https://img.shields.io/hackage/v/type-level-kv-list.svg)](https://hackage.haskell.org/package/type-level-kv-list)+[![Stackage LTS](http://stackage.org/package/type-level-kv-list/badge/lts)](http://stackage.org/lts/package/type-level-kv-list)+[![Stackage Nightly](http://stackage.org/package/type-level-kv-list/badge/nightly)](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.

@@ -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

@@ -1,130 +0,0 @@-{-|-  This module supply a way to construct type safe key-value pair list-  and convenient operations for the type.--}--{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeInType #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE IncoherentInstances #-}--module Data.TypeLevelKVList-  (-  -- * Constructors-  -- $setup-    NamedVal-  , namedVal-  , (:.)(..)-  , Null(..)--  -- * Operators-  , get-  , Lookup-  , keys-  , keys'--  -- * Misc-  , NamedList-  )-where--import Data.Proxy (Proxy(..))-import Data.Typeable (Typeable)-import GHC.TypeLits (KnownSymbol, symbolVal)---- Constructors--{- $setup #constructors#-  We can create type level KV list as follows.--  >>> :set -XDataKinds -XTypeOperators-  >>> let sampleList = (namedVal "str" :: NamedVal String "foo") :. (namedVal 34 :: NamedVal Int "bar") :. Null-  >>> type SampleList = NamedVal String "foo" :. NamedVal Int "bar" :. Null--}--{-| A value with type level key.- -}-type NamedVal v key = (Proxy key, v)--{-| A convenient function to construct type level KV list.- -}-namedVal :: v -> NamedVal v k-namedVal a = (Proxy, a)--{-| Type level list cons.- -}-data a :. b = a :. b-  deriving (Typeable, Eq, Show)-infixr 8 :.--{-| Type level empty list.- -}-data Null = Null-  deriving (Typeable, Eq, Show)--{-| Type level @lookup :: k -> [(k, a)] -> a@.- -}-type family Lookup pkey list where-  Lookup pk ((pk, v) :. b) = v-  Lookup pk ((px, v) :. b) = Lookup pk b-  Lookup pk Null = Null--{-| Main class for a list of values with type level key- -}-class NamedList layout where-  type family NamedList' layout-  {-|-    >>> keys (Proxy :: Proxy SampleList)-    ["foo","bar"]-  -}-  keys :: Proxy layout -> [String]--instance (NamedList b, KnownSymbol k) => NamedList (NamedVal v k :. b) where-  type NamedList' (NamedVal v k :. b) = NamedVal v k :. NamedList' b-  keys _ = symbolVal (Proxy :: Proxy k) : keys (Proxy :: Proxy b)--instance NamedList Null where-  type NamedList' Null = Null-  keys _ = []--{-| Chek if the key is included in type level list.- -}-class HasKey list pkey value where-  get' :: pkey -> list -> value--instance HasKey (NamedVal v k :. b) (Proxy k) v where-  get' _ ((_, a) :. _) = a--instance HasKey b (Proxy k) v =>-  HasKey (a :. b) (Proxy k) v where-  get' p (_ :. b) = get' p b--instance HasKey Null (Proxy k) Null where-  get' _ Null = Null--{-|-  >>> get (Proxy :: Proxy "foo") sampleList-  "str"--  >>> get (Proxy :: Proxy "bar") sampleList-  34--  >>> get (Proxy :: Proxy "baz") sampleList-  Null--}-get :: (HasKey list pkey (Lookup pkey list))-    => pkey -> list -> Lookup pkey list-get (pkey :: pkey) (list :: list) =-  get' pkey list :: Lookup pkey list--{-|-  >>> keys' sampleList-  ["foo","bar"]--}-keys' :: NamedList k => k -> [String]-keys' (_ :: k) = keys (Proxy :: Proxy k)

@@ -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"+    ]

@@ -1,17 +0,0 @@-module Main where--import Data.Monoid ((<>))-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 =-    [ "-XDataKinds"-    , "-XTypeOperators"-    ]

@@ -1,2 +0,0 @@-main :: IO ()-main = putStrLn "Test suite not yet implemented"

@@ -1,44 +1,130 @@-name:                type-level-kv-list-version:             1.1.0-synopsis:            A module for hash map like object with type level keys.-description:         Please see README.md-homepage:            https://github.com/arowM/type-level-kv-list#readme-license:             MIT-license-file:        LICENSE-author:              Kadzuya Okamoto-maintainer:          arow.okamoto+github@gmail.com-copyright:           2016 Kadzuya Okamoto-category:            Data-build-type:          Simple--- extra-source-files:-cabal-version:       >=1.10--library-  hs-source-dirs:      src-  exposed-modules:     Data.TypeLevelKVList-  build-depends:       base >= 4.7 && < 5-  default-language:    Haskell2010+cabal-version: 1.12 -test-suite type-level-kv-list-test-  type:                exitcode-stdio-1.0-  hs-source-dirs:      test-  main-is:             Spec.hs-  build-depends:       base-                     , type-level-kv-list-  ghc-options:         -threaded -rtsopts -with-rtsopts=-N-  default-language:    Haskell2010+-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack -test-suite doctest-  type:                exitcode-stdio-1.0-  hs-source-dirs:      test-  main-is:             Doctest.hs-  build-depends:       base-                     , Glob-                     , doctest-                     , type-level-kv-list-  ghc-options:         -threaded -rtsopts -with-rtsopts=-N-  default-language:    Haskell2010+name:           type-level-kv-list+version:        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+  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