{-# LANGUAGE TupleSections #-} module Web.BowerJson.Utils where import Control.Applicative import Control.Monad import Control.Category ((>>>)) import Data.List (stripPrefix) import Data.Map (Map) import qualified Data.Map as M import Data.Traversable (traverse) import Data.Aeson import qualified Data.Aeson.Types as Aeson -------------- -- Safe headMay :: [a] -> Maybe a headMay [] = Nothing headMay (x:_) = Just x lastMay :: [a] -> Maybe a lastMay [] = Nothing lastMay [x] = Just x lastMay (_:xs) = lastMay xs ---------------- -- Aeson -- | Aeson only provides FromJSON instances such as: @FromJSON a => FromJSON -- (Map String a)@. This function allows you to parse a Map value from JSON -- where the keys are not 'String', when you supply a function @(String -> -- Parser a)@ to parse the keys with. parseWithArbitraryKeys :: (Ord a, FromJSON v) => (String -> Aeson.Parser a) -> Value -> Aeson.Parser (Map a v) parseWithArbitraryKeys parseKey v' = do list <- M.toList <$> parseJSON v' list' <- traverse (\(k, v) -> (,v) <$> parseKey k) list return (M.fromList list') ------------------------- -- String manipulation -- | Given a prefix and a suffix, go through the supplied list, attempting -- to extract one string from the list which has the given prefix and suffix, -- All other strings in the list are returned as the second component of the -- tuple. takeDelim :: String -> String -> [String] -> (Maybe String, [String]) takeDelim start end = foldr go (Nothing, []) where go str (Just x, strs) = (Just x, str : strs) go str (Nothing, strs) = case stripWrapper start end str of Just str' -> (Just str', strs) Nothing -> (Nothing, str : strs) -- | Like stripPrefix, but strips a suffix as well. stripWrapper :: String -> String -> String -> Maybe String stripWrapper start end = stripPrefix start >>> fmap reverse >=> stripPrefix (reverse end) >>> fmap reverse