JSON-Combinator-0.2.0: Text/JSON/Combinator.hs

{-# LANGUAGE FlexibleContexts #-}


-- | Combinators for JSON data types.
module Text.JSON.Combinator
(
  -- * Transformers
  jnot
, withNumber
, withString
, withArray
, withObject
, withObjectFields
  -- * Constructors
, jzero
, jemptystring
, jemptyarray
, jemptyobject
, jsinglearray
, jsingleobject
  -- * Accessors
, getBool
, getNumber
, getString
, getArray
, getObject
  -- * Decisions
, isBool
, isTrue
, isFalse
, isNumber
, isString
, isArray
, isObject
  -- * Accessors with default
, numberOr
, stringOr
, arrayOr
, objectOr
, fieldsOr
, valuesOr
, numberOrZero
, stringOrEmpty
, arrayOrEmpty
, objectOrEmpty
, objectFieldsOrEmpty
, objectValuesOrEmpty
  -- * Combinators
, usingNumber
, usingString
, usingArray
, usingObject
, usingObjectFields
, usingObjectValues
  -- * Object field accessors
, hasField
, (-?)
, (-|)
, fieldOr
, fieldOrNull
, fieldOrTrue
, fieldOrFalse
, fieldOrZero
, fieldOrEmptyString
, fieldOrEmptyArray
, fieldOrEmptyObject
, hasField'
, (-??)
, field'
, (-||)
, field'Or
, field'OrNull
, field'OrTrue
, field'OrFalse
, field'OrZero
, field'OrEmptyString
, field'OrEmptyArray
, field'OrEmptyObject
  -- * Stdin/stdout interaction
, interactJSON
, interactJSON'
, withJSON
  -- * File I/O
, readJSONFile
, writeJSONFile
, interactJSONFile
, interactJSONFile'
, withJSONFile
  -- * Modules containing additional combinators
, module Text.JSON.JSONLike
, module Text.JSON.JSONField
, module Text.JSON.JSONParse
, module Text.JSON.JSONPrepend
, module Text.JSON.JSONPrint
) where

import Text.JSON.JSONLike
import Text.JSON.JSONField
import Text.JSON.JSONParse
import Text.JSON.JSONPrepend
import Text.JSON.JSONPrint
import Text.JSON.Interact
import Text.JSON.InteractFile
import Text.JSON.Failure
import Control.Failure
import Control.Applicative
import Data.Maybe
import Data.Monoid
import qualified Data.Foldable as F

-- | Returns whether or not a JSON is a boolean with the value true.
isTrue ::
  JSONLike j s a o f =>
  j -- ^ The JSON value.
  -> Bool
isTrue =
  foldJSON False True False (const False) (const False) (const False) (const False)

-- | Returns whether or not a JSON is a boolean with the value false.
isFalse ::
  JSONLike j s a o f =>
  j -- ^ The JSON value.
  -> Bool
isFalse =
  foldJSON False False True (const False) (const False) (const False) (const False)

-- | Returns whether or not a JSON is a boolean value.
isBool ::
  JSONLike j s a o f =>
  j -- ^ The JSON value.
  -> Bool
isBool =
  liftA2 (||) isTrue isFalse

-- | Returns whether or not a JSON is a number value.
isNumber ::
  JSONLike j s a o f =>
  j -- ^ The JSON value.
  -> Bool
isNumber =
  foldJSON False False False (const True) (const False) (const False) (const False)

-- | Returns whether or not a JSON is a string value.
isString ::
  JSONLike j s a o f =>
  j -- ^ The JSON value.
  -> Bool
isString =
  foldJSON False False False (const False) (const True) (const False) (const False)

-- | Returns whether or not a JSON is an array value.
isArray ::
  JSONLike j s a o f =>
  j -- ^ The JSON value.
  -> Bool
isArray =
  foldJSON False False False (const False) (const False) (const True) (const False)

-- | Returns whether or not a JSON is an object value.
isObject ::
  JSONLike j s a o f =>
  j -- ^ The JSON value.
  -> Bool
isObject =
  foldJSON False False False (const False) (const False) (const False) (const True)

-- | Inverts the JSON value if it is a boolean.
jnot ::
  JSONLike j s a o f =>
  j -- ^ The JSON value.
  -> j
jnot j =
  if isTrue j
    then jfalse
    else
      if isFalse j
        then
          jtrue
        else
          j

-- | Runs the given function if the JSON value is a number.
withNumber ::
  JSONLike j s a o f =>
  (Rational -> Rational)
  -> j -- ^ The JSON value.
  -> j
withNumber f j =
  foldJSON j j j (jnumber . f) (const j) (const j) (const j) j

-- | Runs the given function if the JSON value is a string.
withString ::
  JSONLike j s a o f =>
  (s -> s)
  -> j -- ^ The JSON value.
  -> j
withString f j =
  foldJSON j j j (const j) (jstring . f) (const j) (const j) j

-- | Runs the given function if the JSON value is an array.
withArray ::
  JSONLike j s a o f =>
  (a j -> a j)
  -> j -- ^ The JSON value.
  -> j
withArray f j =
  foldJSON j j j (const j) (const j) (jarray . f) (const j) j

-- | Runs the given function if the JSON value is an object.
withObject ::
  JSONLike j s a o f =>
  (o j -> o j)
  -> j -- ^ The JSON value.
  -> j
withObject f j =
  foldJSON j j j (const j) (const j) (const j) (jobject . f) j

-- | Runs the given function on the fields if the JSON value is an object.
withObjectFields ::
  (Functor o, JSONLike j s a o f) =>
  (j -> j)
  -> j -- ^ The JSON value.
  -> j
withObjectFields f =
  withObject (fmap f)

-- | Returns the potential boolean value of a JSON value.
getBool ::
  (Failure (ExpectedBool j) m, JSONLike j s a o f) =>
  j -- ^ The JSON value.
  -> m Bool
getBool j =
  let fl = failure (ExpectedBool j)
  in foldJSON fl (return True) (return False) (const fl) (const fl) (const fl) (const fl) j

getNumber ::
  (Failure (ExpectedNumber j) m, JSONLike j s a o f) =>
  j -- ^ The JSON value.
  -> m Rational
getNumber j =
  let fl = failure (ExpectedNumber j)
  in foldJSON fl fl fl return (const fl) (const fl) (const fl) j

-- | Returns the potential string value of a JSON value.
getString ::
  (Failure (ExpectedString j) m, JSONLike j s a o f) =>
  j -- ^ The JSON value.
  -> m s
getString j =
  let fl = failure (ExpectedString j)
  in foldJSON fl fl fl (const fl) return (const fl) (const fl) j

-- | Returns the potential array value of a JSON value.
getArray ::
  (Failure (ExpectedArray j) m, JSONLike j s a o f) =>
  j -- ^ The JSON value.
  -> m (a j)
getArray j =
  let fl = failure (ExpectedArray j)
  in foldJSON fl fl fl (const fl) (const fl) return (const fl) j

-- | Returns the potential object value of a JSON value.
getObject ::
  (Failure (ExpectedObject j) m, JSONLike j s a o f) =>
  j -- ^ The JSON value.
  -> m (o j)
getObject j =
  let fl = failure (ExpectedObject j)
  in foldJSON fl fl fl (const fl) (const fl) (const fl) return j

-- | Returns a number value from a JSON value or if it is not a number, returns the given default.
numberOr ::
  JSONLike j s a o f =>
  Rational
  -> j -- ^ The JSON value.
  -> 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 ::
  JSONLike j s a o f =>
  s
  -> j -- ^ The JSON value.
  -> s
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 ::
  JSONLike j s a o f =>
  a j
  -> j -- ^ The JSON value.
  -> a j
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 ::
  JSONLike j s a o f =>
  o j
  -> j -- ^ The JSON value.
  -> o j
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.
fieldsOr ::
  JSONField j f =>
  [f]
  -> j -- ^ The JSON value.
  -> [f]
fieldsOr x =
  fromMaybe x . fields

-- | Returns an object's values from a JSON value or if it is not an object, returns the given default.
valuesOr ::
  JSONField j f =>
  [j]
  -> j -- ^ The JSON value.
  -> [j]
valuesOr x =
  fromMaybe x . values

-- | Runs a function on the number of a JSON value or if it is not a number, returns the given default.
usingNumber ::
  JSONLike j s a o f =>
  x
  -> (Rational -> x)
  -> j -- ^ The JSON value.
  -> x
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 ::
  JSONLike j s a o f =>
  x
  -> (s -> x)
  -> j -- ^ The JSON value.
  -> x
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 ::
  JSONLike j s a o f =>
  x
  -> (a j -> x)
  -> j -- ^ The JSON value.
  -> x
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 ::
  JSONLike j s a o f =>
  x
  -> (o j -> x)
  -> j -- ^ The JSON value.
  -> x
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 ::
  JSONField j f =>
  a
  -> ([f] -> a)
  -> j -- ^ The JSON value.
  -> a
usingObjectFields a f =
  maybe a f . fields

-- | 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 ::
  JSONField j f =>
  a
  -> ([j] -> a)
  -> j -- ^ The JSON value.
  -> a
usingObjectValues a f =
  maybe a f . values

-- | The JSON value zero.
jzero ::
  JSONLike j s a o f =>
  j
jzero =
  jnumber 0

-- | The JSON value empty string.
jemptystring ::
  (Monoid s, JSONLike j s a o f) =>
  j
jemptystring =
  jstring mempty

-- | The JSON value empty array.
jemptyarray ::
  (Monoid (a j), JSONLike j s a o f) =>
  j
jemptyarray =
  jarray mempty

-- | The JSON value empty object.
jemptyobject ::
  (Monoid (o j), JSONLike j s a o f) =>
  j
jemptyobject =
  jobject mempty

-- | Puts a single value into a JSON array.
jsinglearray ::
  (Applicative a, JSONLike j s a o f) =>
  j
  -> j
jsinglearray =
  jarray . pure

-- | Puts a single value into a JSON object.
jsingleobject ::
  (Applicative o, JSONLike j s a o f) =>
  j
  -> j
jsingleobject =
  jobject . pure

-- | Returns the possible value associated with the given field if this is an object. An alias for 'field'.
(-|) ::
  (JSONField j f, Failure (NoSuchField f) m) =>
  f
  -> j -- ^ The JSON value.
  -> m j
(-|) =
  field

-- | Returns a number value from a JSON value or if it is not a number, returns zero.
numberOrZero ::
  JSONLike j s a o f =>
  j -- ^ The JSON value.
  -> Rational
numberOrZero =
  numberOr 0

-- | Returns a string value from a JSON value or if it is not a string, returns an empty string.
stringOrEmpty ::
  (JSONLike j s a o f, Monoid s) =>
  j -- ^ The JSON value.
  -> s
stringOrEmpty =
  stringOr mempty

-- | Returns an array value from a JSON value or if it is not an array, returns an empty array.
arrayOrEmpty ::
  (JSONLike j s a o f, Monoid (a j)) =>
  j -- ^ The JSON value.
  -> a j
arrayOrEmpty =
  arrayOr mempty

-- | Returns an object value from a JSON value or if it is not an object, returns an empty object.
objectOrEmpty ::
  (JSONLike j s a o f, Monoid (o j)) =>
  j -- ^ The JSON value.
  -> o j
objectOrEmpty =
  objectOr mempty

-- | Returns an object's fields from a JSON value or if it is not an object, returns no fields.
objectFieldsOrEmpty ::
  (JSONField j f, Monoid (o j)) =>
  j -- ^ The JSON value.
  -> [f]
objectFieldsOrEmpty =
  fieldsOr []

-- | Returns an object's values from a JSON value or if it is not an object, returns no values.
objectValuesOrEmpty ::
  (JSONField j f, Monoid (o j)) =>
  j -- ^ The JSON value.
  -> [j]
objectValuesOrEmpty =
  valuesOr []

-- | Whether or not a JSON value is an object with the given field.
hasField ::
  JSONField j f =>
  f
  -> j -- ^ The JSON value.
  -> Bool
hasField s =
  isJust . field s

-- | Whether or not a JSON value is an object with the given field. An alias for 'hasField'.
(-?) ::
  JSONField j f =>
  f
  -> j -- ^ The JSON value.
  -> Bool
(-?) =
  hasField

-- | 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 ::
  JSONField j f =>
  f
  -> j -- ^ The default.
  -> j -- ^ The JSON value.
  -> j
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 ::
  (JSONLike j s a o f, JSONField j f) =>
  f
  -> j -- ^ The JSON value.
  -> j
fieldOrNull s j =
  fieldOr s j jnull

-- | 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 ::
  (JSONLike j s a o f, JSONField j f) =>
  f
  -> j -- ^ The JSON value.
  -> j
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 ::
  (JSONLike j s a o f, JSONField j f) =>
  f
  -> j -- ^ The JSON value.
  -> j
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 ::
  (JSONLike j s a o f, JSONField j f) =>
  f
  -> j -- ^ The JSON value.
  -> j
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 ::
  (JSONLike j s a o f, JSONField j f, Monoid s) =>
  f
  -> j -- ^ The JSON value.
  -> j
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 ::
  (JSONLike j s a o f, JSONField j f, Monoid (a j)) =>
  f
  -> j -- ^ The JSON value.
  -> j
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 ::
  (JSONLike j s a o f, JSONField j f, Monoid (o j)) =>
  f
  -> j -- ^ The JSON value.
  -> j
fieldOrEmptyObject s j =
  fieldOr s j jemptyobject

-- | Traverses down JSON objects with the association fields and returns the potential value.
field' ::
  (F.Foldable t, Failure (NoSuchField f) m, JSONField j f) =>
  t f
  -> j
  -> m j
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, Failure (NoSuchField f) m, JSONField j f) =>
  t f
  -> j
  -> m j
(-||) =
  field'

-- | Traverses down JSON objects with the association fields and returns true if the association graph exists.
hasField' ::
  (JSONField j f, F.Foldable t) =>
  t f
  -> j -- ^ The JSON value.
  -> 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''.
(-??) ::
  (JSONField j f, F.Foldable t) =>
  t f
  -> j -- ^ The JSON value.
  -> Bool
(-??) =
  hasField'

-- | Traverses down JSON objects with the association fields and returns the potential value or the given default.
field'Or ::
  (JSONField j f, F.Foldable t) =>
  j -- ^ The default.
  -> t f
  -> j -- ^ The JSON value.
  -> j
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 ::
  (JSONLike j s a o f, JSONField j f, F.Foldable t) =>
  t f
  -> j -- ^ The JSON value.
  -> j
field'OrNull =
  field'Or jnull

-- | Traverses down JSON objects with the association fields and returns the potential value or a JSON true.
field'OrTrue ::
  (JSONLike j s a o f, JSONField j f, F.Foldable t) =>
  t f
  -> j -- ^ The JSON value.
  -> j
field'OrTrue =
  field'Or jtrue

-- | Traverses down JSON objects with the association fields and returns the potential value or a JSON false.
field'OrFalse ::
  (JSONLike j s a o f, JSONField j f, F.Foldable t) =>
  t f
  -> j -- ^ The JSON value.
  -> j
field'OrFalse =
  field'Or jfalse

-- | Traverses down JSON objects with the association fields and returns the potential value or a JSON zero.
field'OrZero ::
  (JSONLike j s a o f, JSONField j f, F.Foldable t) =>
  t f
  -> j -- ^ The JSON value.
  -> j
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 ::
  (JSONLike j s a o f, JSONField j f, F.Foldable t, Monoid s) =>
  t f
  -> j -- ^ The JSON value.
  -> j
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 ::
  (JSONLike j s a o f, JSONField j f, F.Foldable t, Monoid (a j)) =>
  t f
  -> j -- ^ The JSON value.
  -> j
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 ::
  (JSONLike j s a o f, JSONField j f, F.Foldable t, Monoid (o j)) =>
  t f
  -> j -- ^ The JSON value.
  -> j
field'OrEmptyObject =
  field'Or jemptyobject

-- | Parses a JSON file into a possible JSON object.
readJSONFile ::
  (JSONParse j a e, InteractFile a) =>
  FilePath
  -> IO (Either e j)
readJSONFile f =
  parseJSON f `fmap` readFile' f

-- | Writes a JSON object to a file.
writeJSONFile ::
  (InteractFile b, JSONPrint a b) =>
  FilePath
  ->
  a
  -> IO ()
writeJSONFile f =
  writeFile' f . printJSON

-- | Interacts by parsing the standard input for JSON, passing the result to the given function, then printing the result to standard output.
interactJSON ::
  (JSONPrint j' s, JSONParse j s e, Interact s) =>
  (Either e j -> j')
  -> IO ()
interactJSON f =
  interact' (printJSON . f . parseJSON "stdin")

-- | 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' ::
  (JSONPrint j' s, JSONParse j s e, Interact s) =>
  (e -> j')
  -> (j -> j')
  -> 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 ::
 (Interact p, Interact s, JSONPrint j' s, JSONParse j p e) =>
  (e -> IO ())
  -> (j -> j')
  -> IO ()
withJSON f g =
  getContents' >>= either f (putStr' . printJSON . g) . parseJSON "stdin"

-- | Interacts by parsing the given file for JSON, passing the result to the given function, then writing the result to the given file.
interactJSONFile ::
  (InteractFile p, InteractFile s, JSONPrint j' s, JSONParse j p e) =>
  (Either e j -> j')
  -> FilePath
  -> FilePath
  -> IO ()
interactJSONFile f i o =
  readFile' i >>= writeFile' o . (printJSON . f) . parseJSON "stdin"

-- | 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' ::
  (InteractFile p, InteractFile s, JSONPrint j' s, JSONParse j p e) =>
  (e -> j')
  -> (j -> j')
  -> 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 ::
  (InteractFile p, InteractFile s, JSONPrint j' s, JSONParse j p e) =>
  (e -> IO ())
  -> (j -> j')
  -> FilePath
  -> FilePath
  -> IO ()
withJSONFile f g i o =
  readFile' i >>= either f (writeFile' o . printJSON . g) . parseJSON i