keter 1.6 → 1.7
raw patch · 7 files changed
+66/−21 lines, 7 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Data.Aeson.KeyHelper: (!) :: (Eq k, Hashable k, HasCallStack) => HashMap k v -> k -> v
+ Data.Aeson.KeyHelper: (!?) :: (Eq k, Hashable k) => HashMap k v -> k -> Maybe v
+ Data.Aeson.KeyHelper: adjust :: (Eq k, Hashable k) => (v -> v) -> k -> HashMap k v -> HashMap k v
+ Data.Aeson.KeyHelper: alter :: (Eq k, Hashable k) => (Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
+ Data.Aeson.KeyHelper: alterF :: (Functor f, Eq k, Hashable k) => (Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v)
+ Data.Aeson.KeyHelper: compose :: (Eq b, Hashable b) => HashMap b c -> HashMap a b -> HashMap a c
+ Data.Aeson.KeyHelper: data HashMap k v
+ Data.Aeson.KeyHelper: delete :: (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
+ Data.Aeson.KeyHelper: difference :: (Eq k, Hashable k) => HashMap k v -> HashMap k w -> HashMap k v
+ Data.Aeson.KeyHelper: differenceWith :: (Eq k, Hashable k) => (v -> w -> Maybe v) -> HashMap k v -> HashMap k w -> HashMap k v
+ Data.Aeson.KeyHelper: elems :: HashMap k v -> [v]
+ Data.Aeson.KeyHelper: empty :: HashMap k v
+ Data.Aeson.KeyHelper: filter :: (v -> Bool) -> HashMap k v -> HashMap k v
+ Data.Aeson.KeyHelper: filterWithKey :: (k -> v -> Bool) -> HashMap k v -> HashMap k v
+ Data.Aeson.KeyHelper: findWithDefault :: (Eq k, Hashable k) => v -> k -> HashMap k v -> v
+ Data.Aeson.KeyHelper: foldMapWithKey :: Monoid m => (k -> v -> m) -> HashMap k v -> m
+ Data.Aeson.KeyHelper: foldl :: (a -> v -> a) -> a -> HashMap k v -> a
+ Data.Aeson.KeyHelper: foldl' :: (a -> v -> a) -> a -> HashMap k v -> a
+ Data.Aeson.KeyHelper: foldlWithKey :: (a -> k -> v -> a) -> a -> HashMap k v -> a
+ Data.Aeson.KeyHelper: foldlWithKey' :: (a -> k -> v -> a) -> a -> HashMap k v -> a
+ Data.Aeson.KeyHelper: foldr :: (v -> a -> a) -> a -> HashMap k v -> a
+ Data.Aeson.KeyHelper: foldr' :: (v -> a -> a) -> a -> HashMap k v -> a
+ Data.Aeson.KeyHelper: foldrWithKey :: (k -> v -> a -> a) -> a -> HashMap k v -> a
+ Data.Aeson.KeyHelper: foldrWithKey' :: (k -> v -> a -> a) -> a -> HashMap k v -> a
+ Data.Aeson.KeyHelper: fromList :: (Eq k, Hashable k) => [(k, v)] -> HashMap k v
+ Data.Aeson.KeyHelper: fromListWith :: (Eq k, Hashable k) => (v -> v -> v) -> [(k, v)] -> HashMap k v
+ Data.Aeson.KeyHelper: fromListWithKey :: (Eq k, Hashable k) => (k -> v -> v -> v) -> [(k, v)] -> HashMap k v
+ Data.Aeson.KeyHelper: infixl 9 !
+ Data.Aeson.KeyHelper: insert :: (Eq k, Hashable k) => k -> v -> HashMap k v -> HashMap k v
+ Data.Aeson.KeyHelper: insertWith :: (Eq k, Hashable k) => (v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
+ Data.Aeson.KeyHelper: intersection :: (Eq k, Hashable k) => HashMap k v -> HashMap k w -> HashMap k v
+ Data.Aeson.KeyHelper: intersectionWith :: (Eq k, Hashable k) => (v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
+ Data.Aeson.KeyHelper: intersectionWithKey :: (Eq k, Hashable k) => (k -> v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
+ Data.Aeson.KeyHelper: isSubmapOf :: (Eq k, Hashable k, Eq v) => HashMap k v -> HashMap k v -> Bool
+ Data.Aeson.KeyHelper: isSubmapOfBy :: (Eq k, Hashable k) => (v1 -> v2 -> Bool) -> HashMap k v1 -> HashMap k v2 -> Bool
+ Data.Aeson.KeyHelper: keys :: HashMap k v -> [k]
+ Data.Aeson.KeyHelper: keysSet :: HashMap k a -> HashSet k
+ Data.Aeson.KeyHelper: lookup :: (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
+ Data.Aeson.KeyHelper: lookupDefault :: (Eq k, Hashable k) => v -> k -> HashMap k v -> v
+ Data.Aeson.KeyHelper: mapMaybe :: (v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
+ Data.Aeson.KeyHelper: mapMaybeWithKey :: (k -> v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
+ Data.Aeson.KeyHelper: mapWithKey :: (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
+ Data.Aeson.KeyHelper: member :: (Eq k, Hashable k) => k -> HashMap k a -> Bool
+ Data.Aeson.KeyHelper: null :: HashMap k v -> Bool
+ Data.Aeson.KeyHelper: singleton :: Hashable k => k -> v -> HashMap k v
+ Data.Aeson.KeyHelper: size :: HashMap k v -> Int
+ Data.Aeson.KeyHelper: toKey :: Text -> Text
+ Data.Aeson.KeyHelper: toList :: HashMap k v -> [(k, v)]
+ Data.Aeson.KeyHelper: toText :: Text -> Text
+ Data.Aeson.KeyHelper: traverseWithKey :: Applicative f => (k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
+ Data.Aeson.KeyHelper: union :: (Eq k, Hashable k) => HashMap k v -> HashMap k v -> HashMap k v
+ Data.Aeson.KeyHelper: unionWith :: (Eq k, Hashable k) => (v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
+ Data.Aeson.KeyHelper: unionWithKey :: (Eq k, Hashable k) => (k -> v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
+ Data.Aeson.KeyHelper: unions :: (Eq k, Hashable k) => [HashMap k v] -> HashMap k v
+ Data.Aeson.KeyHelper: update :: (Eq k, Hashable k) => (a -> Maybe a) -> k -> HashMap k a -> HashMap k a
Files
- ChangeLog.md +6/−0
- Data/Aeson/KeyHelper.hs +33/−0
- Data/Yaml/FilePath.hs +7/−2
- Keter/Plugin/Postgres.hs +2/−2
- Keter/Types/Middleware.hs +6/−6
- Keter/Types/V10.hs +10/−10
- keter.cabal +2/−1
ChangeLog.md view
@@ -1,3 +1,9 @@+## 1.7++* Add support Aeson 2.*+* Add `Data.Aeson.KeyHelper.hs` in cabal file.+* And use the module where Aeson has changed how to handle Key and KeyMap.+ ## 1.6 * Make keter more chatty on boot. This allows you to figure out in code where things go wrong.
+ Data/Aeson/KeyHelper.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE NoImplicitPrelude #-}+-- | Utilities for dealing with Aeson version update++module Data.Aeson.KeyHelper+ ( module KeyMap+ , toKey+ , toText+ ) where++import Prelude (id)+import qualified Data.Text as Text++#if MIN_VERSION_aeson (2,0,0)+import qualified Data.Aeson.Key as Key+import Data.Aeson.KeyMap as KeyMap hiding (map)++toKey :: Text.Text -> Key.Key+toKey = Key.fromText++toText :: Key.Key -> Text.Text+toText = Key.toText++#else+import Data.HashMap.Strict as KeyMap hiding (map)++toKey :: Text.Text -> Text.Text+toKey = id++toText :: Text.Text -> Text.Text+toText = id++#endif
Data/Yaml/FilePath.hs view
@@ -15,6 +15,7 @@ import Control.Applicative ((<$>)) import Data.Yaml (decodeFileEither, ParseException (AesonException), parseJSON) import Prelude (($!), ($), Either (..), return, IO, (.), (>>=), Maybe (..), maybe, mapM, Ord, fail, FilePath)+import Data.Aeson.KeyHelper as AK import Data.Aeson.Types ((.:), (.:?), Object, Parser, Value, parseEither) import Data.Text (Text, unpack) import qualified Data.Set as Set@@ -42,12 +43,16 @@ -- | A replacement for the @.:@ operator which will both parse a file path and -- apply the relative file logic. lookupBase :: ParseYamlFile a => BaseDir -> Object -> Text -> Parser a-lookupBase basedir o t = (o .: t) >>= parseYamlFile basedir+lookupBase basedir o k = (o .: k') >>= parseYamlFile basedir+ where+ k' = AK.toKey k -- | A replacement for the @.:?@ operator which will both parse a file path and -- apply the relative file logic. lookupBaseMaybe :: ParseYamlFile a => BaseDir -> Object -> Text -> Parser (Maybe a)-lookupBaseMaybe basedir o t = (o .:? t) >>= maybe (return Nothing) ((Just <$>) . parseYamlFile basedir)+lookupBaseMaybe basedir o k = (o .:? k') >>= maybe (return Nothing) ((Just <$>) . parseYamlFile basedir)+ where+ k' = AK.toKey k -- | A replacement for the standard @FromJSON@ typeclass which can handle relative filepaths. class ParseYamlFile a where
Keter/Plugin/Postgres.hs view
@@ -9,6 +9,7 @@ ) where import Control.Applicative ((<$>), (<*>), pure)+import Data.Aeson.KeyHelper as AK (lookup) import Control.Concurrent (forkIO) import Control.Concurrent.Chan import Control.Concurrent.MVar@@ -18,7 +19,6 @@ import qualified Control.Monad.Trans.State as S import qualified Data.Char as C import Data.Default-import qualified Data.HashMap.Strict as HMap import qualified Data.Map as Map import Data.Maybe (fromMaybe) import Data.Monoid ((<>))@@ -135,7 +135,7 @@ void $ forkIO $ flip S.evalStateT (db0, g0) $ forever $ loop chan return Plugin { pluginGetEnv = \appname o ->- case HMap.lookup "postgres" o of+ case AK.lookup "postgres" o of Just (Array v) -> do let dbServer = fromMaybe def . parseMaybe parseJSON $ V.head v doenv chan appname dbServer
Keter/Types/Middleware.hs view
@@ -26,7 +26,7 @@ import Data.Text.Lazy.Encoding as TL (encodeUtf8, decodeUtf8) import Data.Text.Encoding as T (encodeUtf8, decodeUtf8) import Data.String (fromString)-import qualified Data.HashMap.Strict as H+import qualified Data.Aeson.KeyHelper as AK (toKey, toText, toList, empty) data MiddlewareConfig = AcceptOverride | Autohead@@ -47,10 +47,10 @@ parseJSON (String "method-override" ) = pure MethodOverride parseJSON (String "method-override-post") = pure MethodOverridePost parseJSON (Object o) =- case H.toList o of+ case AK.toList o of [("basic-auth", Object ( o'))] -> BasicAuth <$> o' .:? "realm" .!= "keter"- <*> (map (T.encodeUtf8 *** T.encodeUtf8) . H.toList <$> o' .:? "creds" .!= H.empty)- [("headers" , Object _ )] -> AddHeaders . map (T.encodeUtf8 *** T.encodeUtf8) . H.toList <$> o .:? "headers" .!= H.empty+ <*> (map ((T.encodeUtf8 . AK.toText) *** T.encodeUtf8) . AK.toList <$> o' .:? "creds" .!= AK.empty)+ [("headers" , Object _ )] -> AddHeaders . map ((T.encodeUtf8 . AK.toText) *** T.encodeUtf8) . AK.toList <$> o .:? "headers" .!= AK.empty [("local" , Object o')] -> Local <$> o' .:? "status" .!= 401 <*> (TL.encodeUtf8 <$> o' .:? "message" .!= "Unauthorized Accessing from Localhost ONLY" ) _ -> mzero -- fail "Rule: unexpected format"@@ -63,10 +63,10 @@ toJSON MethodOverride = "method-override" toJSON MethodOverridePost = "method-override-post" toJSON (BasicAuth realm cred) = object [ "basic-auth" .= object [ "realm" .= realm- , "creds" .= object ( map ( T.decodeUtf8 *** (String . T.decodeUtf8)) cred )+ , "creds" .= object ( map ( (AK.toKey . T.decodeUtf8) *** (String . T.decodeUtf8)) cred ) ] ]- toJSON (AddHeaders headers) = object [ "headers" .= object ( map (T.decodeUtf8 *** String . T.decodeUtf8) headers) ]+ toJSON (AddHeaders headers) = object [ "headers" .= object ( map ((AK.toKey . T.decodeUtf8) *** String . T.decodeUtf8) headers) ] toJSON (Local sc msg) = object [ "local" .= object [ "status" .= sc , "message" .= TL.decodeUtf8 msg ]
Keter/Types/V10.hs view
@@ -10,10 +10,10 @@ Value (Object, String, Bool), withObject, (.!=), (.:), (.:?), object, (.=))+import Data.Aeson.KeyHelper as AK (lookup, singleton, empty, insert) import qualified Data.CaseInsensitive as CI import Data.Conduit.Network (HostPreference) import Data.Default-import qualified Data.HashMap.Strict as HashMap import qualified Data.Map as Map import Data.Maybe (catMaybes, fromMaybe, isJust) import qualified Data.Set as Set@@ -45,20 +45,20 @@ , V.fromList $ map (flip Stanza False . StanzaRedirect . toCurrent) $ Set.toList redirs ] , bconfigPlugins =- case webapp >>= HashMap.lookup "postgres" . V04.configRaw of- Just (Bool True) -> HashMap.singleton "postgres" (Bool True)- _ -> HashMap.empty+ case webapp >>= AK.lookup "postgres" . V04.configRaw of+ Just (Bool True) -> AK.singleton "postgres" (Bool True)+ _ -> AK.empty } instance ParseYamlFile BundleConfig where parseYamlFile basedir = withObject "BundleConfig" $ \o ->- case HashMap.lookup "stanzas" o of+ case AK.lookup "stanzas" o of Nothing -> (toCurrent :: V04.BundleConfig -> BundleConfig) <$> parseYamlFile basedir (Object o) Just _ -> current o where current o = BundleConfig <$> lookupBase basedir o "stanzas"- <*> o .:? "plugins" .!= HashMap.empty+ <*> o .:? "plugins" .!= AK.empty instance ToJSON BundleConfig where toJSON BundleConfig {..} = object@@ -149,7 +149,7 @@ instance ParseYamlFile KeterConfig where parseYamlFile basedir = withObject "KeterConfig" $ \o ->- case HashMap.lookup "listeners" o of+ case AK.lookup "listeners" o of Just _ -> current o Nothing -> old o <|> current o where@@ -219,7 +219,7 @@ addRequiresSecure :: ToJSON a => Bool -> a -> Value addRequiresSecure rs x = case toJSON x of- Object o -> Object $ HashMap.insert "requires-secure" (toJSON rs) o+ Object o -> Object $ AK.insert "requires-secure" (toJSON rs) o v -> v instance ToJSON (StanzaRaw ()) where@@ -232,7 +232,7 @@ addStanzaType :: ToJSON a => Value -> a -> Value addStanzaType t x = case toJSON x of- Object o -> Object $ HashMap.insert "type" t o+ Object o -> Object $ AK.insert "type" t o v -> v data StaticFilesConfig = StaticFilesConfig@@ -323,7 +323,7 @@ Object o -> case path of SPAny -> Object o- SPSpecific x -> Object $ HashMap.insert "path" (String x) o+ SPSpecific x -> Object $ AK.insert "path" (String x) o v -> v data SourcePath = SPAny
keter.cabal view
@@ -1,6 +1,6 @@ Cabal-version: >=1.10 Name: keter-Version: 1.6+Version: 1.7 Synopsis: Web application deployment manager, focusing on Haskell web frameworks Description: Hackage documentation generation is not reliable. For up to date documentation, please see: <http://www.stackage.org/package/keter>. Homepage: http://www.yesodweb.com/@@ -91,6 +91,7 @@ Keter.HostManager Network.HTTP.ReverseProxy.Rewrite Data.Yaml.FilePath+ Data.Aeson.KeyHelper Codec.Archive.TempTarball Data.Conduit.LogFile Data.Conduit.Process.Unix