{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
-- | Run digestive-functors forms against JSON.
module Text.Digestive.Aeson
    ( digestJSON ) where

import Control.Lens
import Data.Aeson (Value(..))
import Data.Aeson.Lens
import Safe
import Text.Digestive

import qualified Data.Text as T

--------------------------------------------------------------------------------
{-| Given a JSON document and a form, attempt to use the JSON document to
evaluation the form. If the form fails validation, then 'Nothing' is
returned.

Example:

>     import Data.Aeson (json)
>     import Data.Attoparsec.Lazy (parse, maybeResult)
>     import Text.Digestive.Aeson (digestJSON)
>     ...
>     Just parsedJson <- maybeResult . parse json <$> fetchJsonText
>     digestJSON "" myForm parsedJson
-}
digestJSON :: Monad m
           => Form v m a
           -- ^ The form to evaluate.
           -> Value
           -- ^ The JSON document to use for validation. If you need to use
           -- only part of this document, you need to transform this value
           -- first. You may find the @aeson-lens@ package useful for this.
           -> m (View v, Maybe a)
digestJSON f json = postForm "" f (jsonEnv json)
  where jsonEnv :: Monad m => Value -> Env m
        jsonEnv v p = return . maybe [] jsonToText $
          Just v ^. pathToLens (filter (not . T.null) p)

        pathToLens = foldl (.) id . map pathElem
        pathElem p = maybe (key p) nth (readMay $ T.unpack p)

        jsonToText (String s) = [TextInput s]
        jsonToText (Bool b)   = showPack b
        jsonToText (Number n) = showPack n
        jsonToText Null       = []
        jsonToText (Object _) = []
        jsonToText (Array _)  = []

        showPack = return . TextInput . T.pack . show