packages feed

yaml-light-lens (empty) → 0.1.0.0

raw patch · 5 files changed

+249/−0 lines, 5 filesdep +basedep +bytestringdep +bytestring-lexingsetup-changed

Dependencies added: base, bytestring, bytestring-lexing, containers, doctest, lens, yaml-light

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, Anthony Cowley++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Anthony Cowley nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Data/Yaml/YamlLight/Lens.hs view
@@ -0,0 +1,173 @@+{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses,+             TypeFamilies, RankNTypes #-}+-- | Lenses for working with YAML structures.+module Data.Yaml.YamlLight.Lens (+   -- * Indexed traversals+   nth, key, key', +   -- * Yaml parsing prism+   _Yaml, AsYaml(..),+   -- * Numeric parsers+   yamlInt, yamlReal) where+import Control.Applicative+import Control.Lens+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BC+import Data.ByteString.Lex.Integral+import Data.ByteString.Lex.Double+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Traversable (sequenceA)+import Data.Yaml.YamlLight++-- $setup+-- >>> :set -XOverloadedStrings++-- | The two indexable types of YAML data are sequences and mappings.+data YamlIx = ArrIx Int | ObjIx YamlLight++type instance Index YamlLight = YamlIx+type instance IxValue YamlLight = YamlLight++instance Applicative f => Ixed f YamlLight where+  ix k@(ArrIx i) f (YSeq xs) | i < 0 = pure (YSeq xs)+                             | otherwise = YSeq <$> go xs i where+    go [] _ = pure []+    go (y:ys) 0 = (:ys) <$> indexed f k y+    go (y:ys) i' = (y:) <$> (go ys $! i' - 1)+  ix k@(ObjIx k') f (YMap m) = case Map.lookup k' m of+    Just v -> YMap . flip (Map.insert k') m <$> indexed f k v+    Nothing -> pure (YMap m)+  ix _ _ y = pure y++instance At YamlLight where+  at k@(ObjIx k') f (YMap m) = YMap . aux <$> indexed f k mv+    where aux Nothing = maybe m (const (Map.delete k' m)) mv+          aux (Just v) = Map.insert k' v m+          mv = Map.lookup k' m+  at k f y = const y <$> indexed f k Nothing++instance Applicative f => Each f YamlLight YamlLight YamlLight YamlLight where+  each f (YSeq xs) = YSeq <$> traverse (uncurry $ indexed f)+                                       (zip (map ArrIx [0..]) xs)+  each f (YMap m) = YMap <$> sequenceA (Map.mapWithKey (indexed f . ObjIx) m)+  each _ y = pure y++noRemainder :: (a, ByteString) -> Maybe a+noRemainder (x, bs) = if BC.null bs then Just x else Nothing++-- | Try to parse an 'Integral' value from a 'YamlLight'.+yamlInt :: Integral b => YamlLight -> Maybe b+yamlInt (YStr s) = readSigned readDecimal s >>= noRemainder+yamlInt _ = Nothing++-- | Try to parse a 'Double' from a 'YamlLight'.+yamlReal :: YamlLight -> Maybe Double+yamlReal (YStr s) = readDouble s >>= noRemainder+yamlReal _ = Nothing++-- | Lens into a sequence.+--+-- >>> YSeq [YStr "a", YStr "b", YStr "c"] ^? nth 1+-- Just (YStr "b")+--+-- >>> YSeq [YStr "a", YStr "b", YStr "c"] & nth 1 .~ YStr "B"+-- YSeq [YStr "a",YStr "B",YStr "c"]+--+-- >>> YSeq [YStr "a", YStr "b", YStr "c"] ^? nth 2 . _Yaml :: Maybe String+-- Just "c"+nth :: Applicative f => Int -> IndexedLensLike' YamlIx f YamlLight YamlLight+nth = ix . ArrIx++-- | Lens into a mapping. 'ByteString's are used as keys directly. If+-- you wish to use a complex mapping key, see 'key''.+--+-- >>> let m = YMap $ Map.fromList [(YStr "name", YStr "Tony Stark"), (YStr "sequels", YStr "2")]+-- >>> m & key "sequels" . traversed . _Yaml +~ 1+-- YMap (fromList [(YStr "name",YStr "Tony Stark"),(YStr "sequels",YStr "3")])+key :: ByteString -> IndexedLens' YamlIx YamlLight (Maybe YamlLight)+key = key' . YStr++-- | Lens into a mapping using a complex key.+key' :: YamlLight -> IndexedLens' YamlIx YamlLight (Maybe YamlLight)+key' = at . ObjIx++-- | Convert between YAML values and common types of Haskell values.+class AsYaml a where+  fromYaml :: YamlLight -> Maybe a+  toYaml   :: a -> YamlLight++instance AsYaml (Map YamlLight YamlLight) where+  fromYaml (YMap m) = Just m+  fromYaml _        = Nothing+  toYaml = YMap++instance AsYaml [YamlLight] where+  fromYaml (YSeq a) = Just a+  fromYaml _        = Nothing+  toYaml = YSeq++instance AsYaml ByteString where+  fromYaml (YStr s) = Just s+  fromYaml _        = Nothing+  toYaml = YStr++instance AsYaml String where+  fromYaml (YStr s) = Just $ BC.unpack s+  fromYaml _        = Nothing+  toYaml = YStr . BC.pack++instance AsYaml Int where+  fromYaml x@(YStr _) = yamlInt x+  fromYaml _ = Nothing+  toYaml x = YStr $ if x < 0 then BC.cons '-' bs else bs+    where Just bs = packDecimal $ abs x+  -- toYaml = YStr . BC.pack . show++instance AsYaml Integer where+  fromYaml x@(YStr _) = yamlInt x+  fromYaml _ = Nothing+  toYaml x = YStr $ if x < 0 then BC.cons '-' bs else bs+    where Just bs = packDecimal $ abs x+  -- toYaml = YStr . BC.pack . show++instance AsYaml Double where+  fromYaml x@(YStr _) = yamlReal x+  fromYaml _ = Nothing+  toYaml = YStr . BC.pack . show++-- | Convert between YAML values and corresponding common Haskell+-- values.+--+-- >>> YStr "-2.3" ^? _Yaml :: Maybe Double+-- Just (-2.3)+--+-- >>> YStr "7b.3" ^? _Yaml :: Maybe Double+-- Nothing+--+-- >>> YStr "-23" ^? _Yaml :: Maybe Int+-- Just (-23)+--+-- >>> YStr "Help, I'm trapped in a haddock factory!" ^? _Yaml :: Maybe String+-- Just "Help, I'm trapped in a haddock factory!"+--+-- >>> YStr "An integer" ^? _Yaml :: Maybe Integer+-- Nothing+--+-- If we just want to pull out those values that were successfully+-- parsed,+-- +-- >>> let nums = YSeq [YStr "3", YStr "2a", YStr "1"]+-- >>> nums ^.. each._Yaml :: [Int]+-- [3,1]+--+-- Alternately, we may want to fail the entire parse if any element+-- fails to parse.+-- +-- >>> sequenceA $ map (preview _Yaml) (nums ^.. each) :: Maybe [Int]+-- Nothing+-- >>> let nums' = YSeq [YStr "3", YStr "2", YStr "1"]+-- >>> sequenceA $ map (preview _Yaml) (nums' ^.. each) :: Maybe [Int]+-- Just [3,2,1]+_Yaml :: AsYaml a => Prism' YamlLight a+_Yaml = prism' toYaml fromYaml+
+ tests/doctests.hs view
@@ -0,0 +1,5 @@+module Main where+import Test.DocTest++main :: IO ()+main = doctest ["-isrc", "src/Data/Yaml/YamlLight/Lens.hs"]
+ yaml-light-lens.cabal view
@@ -0,0 +1,39 @@+name:                yaml-light-lens+version:             0.1.0.0+synopsis:            Lens interface to yaml-light.+-- description:         +license:             BSD3+license-file:        LICENSE+author:              Anthony Cowley+maintainer:          acowley@gmail.com+copyright:           Copyright (C) 2012-2013 Anthony Cowley+category:            Data+build-type:          Simple+extra-source-files:  tests/doctests.hs+cabal-version:       >= 1.10++source-repository head+  type:     git+  location: http://github.com/acowley/yaml-light-lens.git++library+  exposed-modules:     Data.Yaml.YamlLight.Lens+  build-depends:       base >= 4.5 && < 5,+                       bytestring,+                       bytestring-lexing >= 0.4.3,+                       containers,+                       lens >= 3.8 && < 3.10,+                       yaml-light >= 0.1 && < 0.2+  hs-source-dirs:      src+  ghc-options:         -Wall -fno-warn-orphans+  default-language:    Haskell2010++test-suite doctests+  type:           exitcode-stdio-1.0+  main-is:        doctests.hs+  ghc-options:    -Wall -Werror -threaded+  hs-source-dirs: tests+  default-language:    Haskell2010+  build-depends:+    base,+    doctest