packages feed

json-pointer (empty) → 0.1

raw patch · 6 files changed

+210/−0 lines, 6 filesdep +attoparsecdep +base-preludedep +textsetup-changed

Dependencies added: attoparsec, base-prelude, text

Files

+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2016, Sannsyn AS++Permission is hereby granted, free of charge, to any person+obtaining a copy of this software and associated documentation+files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use,+copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ json-pointer.cabal view
@@ -0,0 +1,57 @@+name:+  json-pointer+version:+  0.1+synopsis:+  JSON Pointer parsing and interpretation utilities+description:+  This library provides a parser and a model,+  which is supposed to be later interpreted by the client libraries.+category:+  Data, JSON, Parsing+homepage:+  https://github.com/sannsyn/json-pointer +bug-reports:+  https://github.com/sannsyn/json-pointer/issues +author:+  Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer:+  Nikita Volkov <nikita.y.volkov@mail.ru>+copyright:+  (c) 2016, Sannsyn AS+license:+  MIT+license-file:+  LICENSE+build-type:+  Simple+cabal-version:+  >=1.10+++source-repository head+  type:+    git+  location:+    git://github.com/sannsyn/json-pointer.git+++library+  hs-source-dirs:+    library+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language:+    Haskell2010+  other-modules:+    JSONPointer.Prelude+  exposed-modules:+    JSONPointer.Parser+    JSONPointer.Model+  build-depends:+    -- +    attoparsec >= 0.13 && < 0.14,+    --+    text == 1.*,+    --+    base-prelude >= 0.1.21 && < 0.2
+ library/JSONPointer/Model.hs view
@@ -0,0 +1,41 @@+module JSONPointer.Model+(+  JSONPointer,+  run,+  atIndexOrKey,+)+where++import JSONPointer.Prelude hiding (or)+import qualified Data.Attoparsec.Text+++-- |+-- A model of JSONPointer+-- represented in terms of a monoid.+newtype JSONPointer =+  JSONPointer (forall m. Monoid m => (Maybe Int -> Text -> m) -> m)++instance Monoid JSONPointer where+  {-# INLINE mempty #-}+  mempty =+    JSONPointer $ const mempty+  {-# INLINE mappend #-}+  mappend (JSONPointer fn1) (JSONPointer fn2) =+    JSONPointer $ \handler -> fn1 handler <> fn2 handler++-- |+-- Given a JSON Pointer specification and a function,+-- which interprets a possible index or a textual key into a monoid,+-- results in such a monoid.+{-# INLINE run #-}+run :: Monoid m => JSONPointer -> (Maybe Int -> Text -> m) -> m+run (JSONPointer fn) =+  fn++-- |+-- Constructs JSON Pointer from a possible array index and a textual key.+{-# INLINE atIndexOrKey #-}+atIndexOrKey :: Maybe Int -> Text -> JSONPointer+atIndexOrKey index key =+  JSONPointer $ \handler -> handler index key
+ library/JSONPointer/Parser.hs view
@@ -0,0 +1,74 @@+-- |+-- Attoparsec parser.+module JSONPointer.Parser+(+  Parser,+  run,+  jsonPointer,+)+where++import JSONPointer.Prelude+import Data.Attoparsec.Text+import qualified Data.Text+import qualified JSONPointer.Model as Model+++-- |+-- Uses the parser to parse the input text in whole.+run :: Parser a -> Text -> Either Text a+run parser input =+  either (Left . fromString) Right $+  parseOnly (parser <* endOfInput) input++-- |+-- JSON Pointer parser.+jsonPointer :: Parser Model.JSONPointer+jsonPointer =+  foldMany referenceToken++referenceToken :: Parser Model.JSONPointer+referenceToken =+  char '/' *> (keyToModel <$> key)+  where+    key =+      Data.Text.pack <$> referenceTokenChars+    keyToModel !text =+      Model.atIndexOrKey (textToIndexMaybe text) text+    textToIndexMaybe =+      either (const Nothing) Just .+      parseOnly parser+      where+        parser =+          decimal <* endOfInput++-- |+-- Reference token chars as per the definition in the JSON Pointer spec.+referenceTokenChars :: Parser [Char]+referenceTokenChars =+  many $ escapeSequence <|> notChar '/'+  where+    escapeSequence =+      char '~' *> (tilde <|> slash <|> other)+      where+        tilde =+          char '0' $> '~'+        slash =+          char '1' $> '/'+        other =+          fail "Illegal escape sequence"++foldMany :: (Alternative m, Monoid a) => m a -> m a+foldMany consume =+  step <|> end+  where+    step =+      mappend <$> consume <*> foldMany consume+    end =+      pure mempty++-- |+-- Note: this parser does not consume any input.+shouldFail :: (Alternative m, Monad m) => m a -> m ()+shouldFail p =+  join $ (p *> pure empty) <|> pure (pure ())
+ library/JSONPointer/Prelude.hs view
@@ -0,0 +1,14 @@+module JSONPointer.Prelude+( +  module Exports,+)+where+++-- base-prelude+-------------------------+import BasePrelude as Exports hiding (Alt)++-- text+-------------------------+import Data.Text as Exports (Text)