diff --git a/JSON-Combinator.cabal b/JSON-Combinator.cabal new file mode 100644 --- /dev/null +++ b/JSON-Combinator.cabal @@ -0,0 +1,32 @@ +Name: JSON-Combinator +Version: 0.0.1 +License: BSD3 +License-File: LICENSE +Author: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ> +Maintainer: Tony Morris +Synopsis: A combinator library on top of Text.JSON +Category: Education +Description: A combinator library on top of Text.JSON http://hackage.haskell.org/package/JSONb +Cabal-version: >= 1.2 +Build-Type: Simple + +Flag small_base + Description: Choose the new, split-up base package. + +Library + Build-Depends: base < 5 && >= 4, + JSONb, + bytestring, + bytestring-trie, + HUnit, + QuickCheck, + test-framework, + test-framework-hunit, + test-framework-quickcheck2 + + GHC-Options: -Wall + -fno-warn-orphans + -fno-warn-type-defaults + -fno-warn-name-shadowing + + Exposed-Modules: Text.JSONb.Combinator diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,27 @@ +Copyright 2009 Tony Morris + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 AUTHORS 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple +main = defaultMain + diff --git a/Text/JSONb/Combinator.hs b/Text/JSONb/Combinator.hs new file mode 100644 --- /dev/null +++ b/Text/JSONb/Combinator.hs @@ -0,0 +1,639 @@ +-- | Combinators for Text.JSONb data types. +module Text.JSONb.Combinator where + + +import Data.Maybe +import Control.Arrow +import Text.JSONb +import Data.ByteString +import qualified Data.ByteString as S +import Data.Trie +import qualified Data.Trie as T +import qualified Data.Foldable as F + +-- | The type of JSON arrays. +type JArray = [JSON] + +-- | The type of JSON objects. +type JObject = Trie JSON + +-- | Inverts the JSON value if it is a boolean. +jNot :: + JSON + -> JSON +jNot (Boolean x) = Boolean (not x) +jNot j = j + +-- | Runs the given function if the JSON value is a number. +withNumber :: + (Rational -> Rational) + -> JSON + -> JSON +withNumber f (Number r) = Number (f r) +withNumber _ j = j + +-- | Runs the given function if the JSON value is a string. +withString :: + (ByteString -> ByteString) + -> JSON + -> JSON +withString f (String x) = String (f x) +withString _ j = j + +-- | Runs the given function if the JSON value is an array. +withArray :: + (JArray -> JArray) + -> JSON + -> JSON +withArray f (Array x) = Array (f x) +withArray _ j = j + +-- | Runs the given function if the JSON value is an object. +withObject :: + (JObject -> JObject) + -> JSON + -> JSON +withObject f (Object x) = Object (f x) +withObject _ j = j + +-- | Runs the given function on the fields if the JSON value is an object. +withObjectFields :: + (ByteString -> ByteString) + -> JSON + -> JSON +withObjectFields f = + withObject (fromList . fmap (first f) . toList) + +-- | Runs the given function on the field values if the JSON value is an object. +withObjectValues :: + (JSON -> JSON) + -> JSON + -> JSON +withObjectValues f = + withObject (fromList . fmap (second f) . toList) + +-- | Prepends the given association if the JSON is an object. +(->:) :: + (ByteString, JSON) + -> JSON + -> JSON +(k, v) ->: Object x = Object (insert k v x) +_ ->: x = x + +-- | Prepends the given value if the JSON is an array. +(-->>:) :: + JSON + -> JSON + -> JSON +k -->>: Array x = Array (k : x) +_ -->>: x = x + +-- | A JSON number with the value zero. +jZero :: + JSON +jZero = + Number 0 + +-- | A JSON string with a value of empty. +jEmptyString :: + JSON +jEmptyString = + String S.empty + +-- | A JSON array with a value of empty. +jEmptyArray :: + JSON +jEmptyArray = + Array [] + +-- | A JSON object with a value of empty. +jEmptyObject :: + JSON +jEmptyObject = + Object T.empty + +-- | A JSON boolean with a value of true. +jTrue :: + JSON +jTrue = + Boolean True + +-- | A JSON boolean with a value of false. +jFalse :: + JSON +jFalse = + Boolean False + +-- | Returns a JSON array value with the given single value. +jSingleArray :: + JSON + -> JSON +jSingleArray x = + Array [x] + +-- | Returns a JSON object value with the given single association value. +jSingleObject :: + ByteString + -> JSON + -> JSON +jSingleObject k v = + Object (T.singleton k v) + +-- | Returns the potential boolean value of a JSON value. +getBool :: + JSON + -> Maybe Bool +getBool (Boolean x) = Just x +getBool _ = Nothing + +-- | Returns the potential number value of a JSON value. +getNumber :: + JSON + -> Maybe Rational +getNumber (Number x) = Just x +getNumber _ = Nothing + +-- | Returns the potential string value of a JSON value. +getString :: + JSON + -> Maybe ByteString +getString (String x) = Just x +getString _ = Nothing + +-- | Returns the potential array value of a JSON value. +getArray :: + JSON + -> Maybe [JSON] +getArray (Array x) = Just x +getArray _ = Nothing + +-- | Returns the potential object value of a JSON value. +getObject :: + JSON + -> Maybe (Trie JSON) +getObject (Object x) = Just x +getObject _ = Nothing + +-- | Returns the potential object fields of a JSON value. +getObjectFields :: + JSON + -> Maybe [ByteString] +getObjectFields = + fmap keys . getObject + +-- | Returns the potential object field values of a JSON value. +getObjectValues :: + JSON + -> Maybe [JSON] +getObjectValues = + fmap (fmap snd . toList) . getObject + +-- | Returns whether or not a JSON is a boolean value. +isBool :: + JSON + -> Bool +isBool = + isJust . getBool + +-- | Returns whether or not a JSON is a boolean with the value true. +isTrue :: + JSON + -> Bool +isTrue = + F.or . getBool + +-- | Returns whether or not a JSON is a boolean with the value false. +isFalse :: + JSON + -> Bool +isFalse = + not . F.and . getBool + +-- | Returns whether or not a JSON is a number value. +isNumber :: + JSON + -> Bool +isNumber = + isJust . getNumber + +-- | Returns whether or not a JSON is a string value. +isString :: + JSON + -> Bool +isString = + isJust . getString + +-- | Returns whether or not a JSON is an array value. +isArray :: + JSON + -> Bool +isArray = + isJust . getArray + +-- | Returns whether or not a JSON is an object value. +isObject :: + JSON + -> Bool +isObject = + isJust . getObject + +-- | Returns a number value from a JSON value or if it is not a number, returns the given default. +numberOr :: + Rational + -> JSON + -> Rational +numberOr x = + fromMaybe x . getNumber + +-- | Returns a string value from a JSON value or if it is not a string, returns the given default. +stringOr :: + ByteString + -> JSON + -> ByteString +stringOr x = + fromMaybe x . getString + +-- | Returns a rational value from a JSON value or if it is not a rational, returns the given default. +arrayOr :: + JArray + -> JSON + -> JArray +arrayOr x = + fromMaybe x . getArray + +-- | Returns an object value from a JSON value or if it is not an object, returns the given default. +objectOr :: + Trie JSON + -> JSON + -> Trie JSON +objectOr x = + fromMaybe x . getObject + +-- | Returns an object's fields from a JSON value or if it is not an object, returns the given default. +objectFieldsOr :: + [ByteString] + -> JSON + -> [ByteString] +objectFieldsOr x = + fromMaybe x . getObjectFields + +-- | Returns an object's values from a JSON value or if it is not an object, returns the given default. +objectValuesOr :: + [JSON] + -> JSON + -> [JSON] +objectValuesOr x = + fromMaybe x . getObjectValues + +-- | Returns a number value from a JSON value or if it is not a number, returns zero. +numberOrZero :: + JSON + -> Rational +numberOrZero = + numberOr 0 + +-- | Returns a string value from a JSON value or if it is not a string, returns an empty string. +stringOrEmpty :: + JSON + -> ByteString +stringOrEmpty = + stringOr S.empty + +-- | Returns an array value from a JSON value or if it is not an array, returns an empty array. +arrayOrEmpty :: + JSON + -> JArray +arrayOrEmpty = + arrayOr [] + +-- | Returns an object value from a JSON value or if it is not an object, returns an empty object. +objectOrEmpty :: + JSON + -> Trie JSON +objectOrEmpty = + objectOr T.empty + +-- | Returns an object's fields from a JSON value or if it is not an object, returns no fields. +objectFieldsOrEmpty :: + JSON + -> [ByteString] +objectFieldsOrEmpty = + objectFieldsOr [] + +-- | Returns an object's values from a JSON value or if it is not an object, returns no values. +objectValuesOrEmpty :: + JSON + -> [JSON] +objectValuesOrEmpty = + objectValuesOr [] + +-- | Runs a function on the number of a JSON value or if it is not a number, returns the given default. +usingNumber :: + a + -> (Rational -> a) + -> JSON + -> a +usingNumber a f = + maybe a f . getNumber + +-- | Runs a function on the string of a JSON value or if it is not a string, returns the given default. +usingString :: + a + -> (ByteString -> a) + -> JSON + -> a +usingString a f = + maybe a f . getString + +-- | Runs a function on the array of a JSON value or if it is not an array, returns the given default. +usingArray :: + a + -> ([JSON] -> a) + -> JSON + -> a +usingArray a f = + maybe a f . getArray + +-- | Runs a function on the object of a JSON value or if it is not an object, returns the given default. +usingObject :: + a + -> (Trie JSON -> a) + -> JSON + -> a +usingObject a f = + maybe a f . getObject + +-- | Runs a function on the fields of an object of a JSON value or if it is not an object, returns the given default. +usingObjectFields :: + a + -> ([ByteString] -> a) + -> JSON + -> a +usingObjectFields a f = + maybe a f . getObjectFields + +-- | Runs a function on the values of an object of a JSON value or if it is not an object, returns the given default. +usingObjectValues :: + a + -> ([JSON] -> a) + -> JSON + -> a +usingObjectValues a f = + maybe a f . getObjectValues + +-- | Whether or not a JSON value is an object with the given field. +hasField :: + ByteString + -> JSON + -> Bool +hasField s = + isJust . field s + +-- | Whether or not a JSON value is an object with the given field. An alias for 'hasField'. +(-?) :: + ByteString + -> JSON + -> Bool +(-?) = + hasField + +-- | Returns the possible value associated with the given field if this is an object. +field :: + ByteString + -> JSON + -> Maybe JSON +field s j = + getObject j >>= T.lookup s + +-- | Returns the possible value associated with the given field if this is an object. An alias for 'field'. +(-|) :: + ByteString + -> JSON + -> Maybe JSON +(-|) = + field + +-- | Returns the value associated with the given field or if this is not an object or has no associated value, return the given default. +fieldOr :: + ByteString + -> JSON + -> JSON + -> JSON +fieldOr s = + flip fromMaybe . field s + +-- | Returns the value associated with the given field or if this is not an object or has no associated value, return a JSON null. +fieldOrNull :: + ByteString + -> JSON + -> JSON +fieldOrNull s j = + fieldOr s j Null + +-- | Returns the value associated with the given field or if this is not an object or has no associated value, return a JSON true. +fieldOrTrue :: + ByteString + -> JSON + -> JSON +fieldOrTrue s j = + fieldOr s j jTrue + +-- | Returns the value associated with the given field or if this is not an object or has no associated value, return a JSON false. +fieldOrFalse :: + ByteString + -> JSON + -> JSON +fieldOrFalse s j = + fieldOr s j jFalse + +-- | Returns the value associated with the given field or if this is not an object or has no associated value, return a JSON zero. +fieldOrZero :: + ByteString + -> JSON + -> JSON +fieldOrZero s j = + fieldOr s j jZero + +-- | Returns the value associated with the given field or if this is not an object or has no associated value, return a JSON string that is empty. +fieldOrEmptyString :: + ByteString + -> JSON + -> JSON +fieldOrEmptyString s j = + fieldOr s j jEmptyString + +-- | Returns the value associated with the given field or if this is not an object or has no associated value, return a JSON array that is empty. +fieldOrEmptyArray :: + ByteString + -> JSON + -> JSON +fieldOrEmptyArray s j = + fieldOr s j jEmptyArray + +-- | Returns the value associated with the given field or if this is not an object or has no associated value, return a JSON object that is empty. +fieldOrEmptyObject :: + ByteString + -> JSON + -> JSON +fieldOrEmptyObject s j = + fieldOr s j jEmptyObject + +-- | Traverses down JSON objects with the association fields and returns true if the association graph exists. +hasField' :: + F.Foldable t => + t ByteString + -> JSON + -> Bool +hasField' s = + isJust . field' s + +-- | Traverses down JSON objects with the association fields and returns true if the association graph exists. An alias for 'hasField''. +(-??) :: + F.Foldable t => + t ByteString + -> JSON + -> Bool +(-??) = + hasField' + +-- | Traverses down JSON objects with the association fields and returns the potential value. +field' :: + F.Foldable t => + t ByteString + -> JSON + -> Maybe JSON +field' = + flip (F.foldrM field) + +-- | Traverses down JSON objects with the association fields and returns the potential value. An alias for 'field''. +(-||) :: + F.Foldable t => + t ByteString + -> JSON + -> Maybe JSON +(-||) = + field' + +-- | Traverses down JSON objects with the association fields and returns the potential value or the given default. +field'Or :: + F.Foldable t => + JSON + -> t ByteString + -> JSON + -> JSON +field'Or d s = + fromMaybe d . field' s + +-- | Traverses down JSON objects with the association fields and returns the potential value or a JSON null. +field'OrNull :: + F.Foldable t => + t ByteString + -> JSON + -> JSON +field'OrNull = + field'Or Null + +-- | Traverses down JSON objects with the association fields and returns the potential value or a JSON true. +field'OrTrue :: + F.Foldable t => + t ByteString + -> JSON + -> JSON +field'OrTrue = + field'Or jTrue + +-- | Traverses down JSON objects with the association fields and returns the potential value or a JSON false. +field'OrFalse :: + F.Foldable t => + t ByteString + -> JSON + -> JSON +field'OrFalse = + field'Or jFalse + +-- | Traverses down JSON objects with the association fields and returns the potential value or a JSON zero. +field'OrZero :: + F.Foldable t => + t ByteString + -> JSON + -> JSON +field'OrZero = + field'Or jZero + +-- | Traverses down JSON objects with the association fields and returns the potential value or a JSON empty string. +field'OrEmptyString :: + F.Foldable t => + t ByteString + -> JSON + -> JSON +field'OrEmptyString = + field'Or jEmptyString + +-- | Traverses down JSON objects with the association fields and returns the potential value or a JSON empty array. +field'OrEmptyArray :: + F.Foldable t => + t ByteString + -> JSON + -> JSON +field'OrEmptyArray = + field'Or jEmptyArray + +-- | Traverses down JSON objects with the association fields and returns the potential value or a JSON empty object. +field'OrEmptyObject :: + F.Foldable t => + t ByteString + -> JSON + -> JSON +field'OrEmptyObject = + field'Or jEmptyObject + +-- | Interacts by parsing the standard input for JSON, passing the result to the given function, then printing the result to standard output. +interactJSON :: + (Either String JSON -> JSON) + -> IO () +interactJSON f = + S.interact (encode Compact . f . decode) + +-- | Interacts by parsing the standard input for JSON, passing a failed result with a string error message to the given function, or a successful result to the given function, then printing the result to standard output. +interactJSON' :: + (String -> JSON) + -> (JSON -> JSON) + -> IO () +interactJSON' l = interactJSON . either l + +-- | Interacts by parsing the standard input for JSON, executing the given function for a failed result with a string error message, or printing a successful result to the given function and passing the result to standard output. +withJSON :: + (String -> IO ()) + -> (JSON -> JSON) + -> IO () +withJSON f g = + S.getContents >>= either f (S.putStr . encode Compact . g) . decode + +-- | Interacts by parsing the given file for JSON, passing the result to the given function, then writing the result to the given file. +interactJSONFile :: + (Either String JSON -> JSON) + -> FilePath + -> FilePath + -> IO () +interactJSONFile f i o = + S.readFile i >>= S.writeFile o . (encode Compact . f) . decode + +-- | Interacts by parsing the given file for JSON, passing a failed result with a string error message to the given function, or a successful result to the given function, then writing the result to the given file. +interactJSONFile' :: + (String -> JSON) + -> (JSON -> JSON) + -> FilePath + -> FilePath + -> IO () +interactJSONFile' l = + interactJSONFile . either l + +-- | Interacts by parsing the given file for JSON, executing the given function for a failed result with a string error message, or printing a successful result to the given function and writing the result to the given file. +withJSONFile :: + (String -> IO ()) + -> (JSON -> JSON) + -> FilePath + -> FilePath + -> IO () +withJSONFile f g i o = + S.readFile i >>= either f (S.writeFile o . encode Compact . g) . decode