diff --git a/src/Network/Routing.hs b/src/Network/Routing.hs --- a/src/Network/Routing.hs +++ b/src/Network/Routing.hs @@ -167,7 +167,7 @@ fetch :: (MonadPlus m, KnownSymbol k, k D. proxy k -- ^ dictionary key -> (T.Text -> Maybe v) -- ^ reading function - -> Path (k D.:= v ': d) m a -> Path d m a + -> Path (k 'D.:= v ': d) m a -> Path d m a fetch p f = Param (':' : symbolVal p) go where go _ [] = mzero @@ -185,7 +185,7 @@ -- | take any pathes as [Text] rest :: (KnownSymbol k, Monad m, k D. proxy k -- ^ dictionary key - -> Path (k D.:= [T.Text] ': d) m a -> Path d m a + -> Path (k 'D.:= [T.Text] ': d) m a -> Path d m a rest k = Param (':': symbolVal k ++ "**") go where go d r = return (D.add k r d, []) diff --git a/src/Network/Routing/Dict.hs b/src/Network/Routing/Dict.hs --- a/src/Network/Routing/Dict.hs +++ b/src/Network/Routing/Dict.hs @@ -38,4 +38,4 @@ -- type family Members (kvs :: [KV *]) (prms :: [KV *]) :: Constraint type instance Members '[] prms = () -type instance Members (k := v ': kvs) prms = (Member k v prms, Members kvs prms) +type instance Members (k ':= v ': kvs) prms = (Member k v prms, Members kvs prms) diff --git a/src/Network/Routing/Dict/Internal.hs b/src/Network/Routing/Dict/Internal.hs --- a/src/Network/Routing/Dict/Internal.hs +++ b/src/Network/Routing/Dict/Internal.hs @@ -12,7 +12,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL < 710 +#if __GLASGOW_HASKELL__ < 710 {-# LANGUAGE OverlappingInstances #-} #endif @@ -39,7 +39,7 @@ import Data.List(intercalate) import Unsafe.Coerce import qualified Control.Monad.Primitive as P -import qualified Data.Primitive as P +import qualified Data.Primitive.Array as P import Control.Monad.ST (ST, runST) unsafeToAny :: a -> Any @@ -57,7 +57,7 @@ -- -- `add` and `mkDict` operation only allowed. data KVList (kvs :: [KV *]) where - Cons :: v -> KVList kvs -> KVList (k := v ': kvs) + Cons :: v -> KVList kvs -> KVList (k ':= v ': kvs) Empty :: KVList '[] instance ShowDict kvs => Show (Store kvs) where @@ -91,16 +91,16 @@ #if __GLASGOW_HASKELL__ > 707 type family HasKey (k :: Symbol) (kvs :: [KV *]) :: AddResult where - HasKey k '[] = AlreadyHasKey k - HasKey k (k := v ': kvs) = Dictionary - HasKey k (k' := v ': kvs) = HasKey k kvs + HasKey k '[] = 'AlreadyHasKey k + HasKey k (k ':= v ': kvs) = 'Dictionary + HasKey k (k' ':= v ': kvs) = HasKey k kvs #else type family HasKey (k :: Symbol) (kvs :: [KV *]) :: AddResult -type instance HasKey k kvs = AlreadyHasKey k +type instance HasKey k kvs = 'AlreadyHasKey k #endif -- | 'not elem key' constraint(ghc >= 7.8) -type k >> add (Proxy :: Proxy "bar") "baz" a -- Store {bar = "baz" :: [Char], foo = 12 :: Int} -add :: (k proxy k -> v -> Store kvs -> Store (k := v ': kvs) +add :: (k proxy k -> v -> Store kvs -> Store (k ':= v ': kvs) add _ v (Store l c) = Store (l + 1) (Cons v c) {-# INLINABLE add #-} @@ -125,7 +125,7 @@ instance ShowDict '[] where showDict _ _ = [] -instance (KnownSymbol k, Typeable v, Show v, ShowDict kvs) => ShowDict (k := v ': kvs) where +instance (KnownSymbol k, Typeable v, Show v, ShowDict kvs) => ShowDict (k ':= v ': kvs) where showDict i (Dict t) = (symbolVal (Proxy :: Proxy k), show (unsafeFromAny $ P.indexArray t i :: v), typeOf (undefined :: v)): showDict (i + 1) (unsafeCoerce $ Dict t :: Dict kvs) @@ -180,13 +180,13 @@ #if __GLASGOW_HASKELL__ > 707 type family Ix' (i :: Nat) (k :: Symbol) (kvs :: [KV *]) :: GetResult where - Ix' i k '[] = Key k - Ix' i k (k := v ': kvs) = NotInDicrionary i - Ix' i k (k' := v ': kvs) = Ix' (i + 1) k kvs + Ix' i k '[] = 'Key k + Ix' i k (k ':= v ': kvs) = 'NotInDicrionary i + Ix' i k (k' ':= v ': kvs) = Ix' (i + 1) k kvs type Ix k kvs = Ix' 0 k kvs -type Index = NotInDicrionary +type Index = 'NotInDicrionary getImpl :: forall i proxy k kvs v. (Index i ~ Ix k kvs, KnownNat i) => proxy (k :: Symbol) -> Dict kvs -> v getImpl _ (Dict d) = unsafeFromAny $ d `P.indexArray` fromIntegral (natVal (Proxy :: Proxy i)) @@ -196,14 +196,14 @@ get' :: proxy k -> Dict kvs -> v #if __GLASGOW_HASKELL__ >= 710 -instance {-# OVERLAPPING #-} Member k v (k := v ': kvs) where +instance {-# OVERLAPPING #-} Member k v (k ':= v ': kvs) where #else -instance Member k v (k := v ': kvs) where +instance Member k v (k ':= v ': kvs) where #endif get' = getImpl {-# INLINE get' #-} -instance (Member k v kvs, Index i ~ Ix k (k' := v' ': kvs), KnownNat i) => Member k v (k' := v' ': kvs) where +instance (Member k v kvs, Index i ~ Ix k (k' ':= v' ': kvs), KnownNat i) => Member k v (k' ':= v' ': kvs) where get' = getImpl {-# INLINE get' #-} @@ -212,11 +212,11 @@ class Member (k :: Symbol) (v :: *) (kvs :: [KV *]) | k kvs -> v where get' :: Int -> proxy k -> Dict kvs -> v -instance Member k v (k := v ': kvs) where +instance Member k v (k ':= v ': kvs) where get' !i _ (Dict d) = unsafeFromAny $ d `P.indexArray` i {-# INLINE get' #-} -instance Member k v kvs => Member k v (k' := v' ': kvs) where +instance Member k v kvs => Member k v (k' ':= v' ': kvs) where get' !i k d = get' (i + 1) k (unsafeCoerce d :: Dict kvs) {-# INLINE get' #-} diff --git a/web-routing.cabal b/web-routing.cabal --- a/web-routing.cabal +++ b/web-routing.cabal @@ -1,5 +1,5 @@ name: web-routing -version: 0.6.1 +version: 0.6.2 synopsis: simple routing library license: MIT license-file: LICENSE @@ -20,7 +20,7 @@ , bytestring >=0.10 && <0.11 , text >=1.1 && <1.3 , unordered-containers >=0.2 && <0.3 - , primitive >=0.5 && <0.6 + , primitive >=0.5 && <0.7 , types-compat >=0.1 && <0.2 ghc-options: -O2 -Wall hs-source-dirs: src