content: {-# LANGUAGE
      CPP
    , OverloadedStrings
    #-}
  module Rest.Gen.Base.JSON
    ( showExample
    , showExamples
    ) where
  
  import Control.Applicative ((<|>))
  import Data.Aeson ((.=))
  import Data.JSON.Schema
  import Data.List (transpose)
  import Data.List.Split (chunksOf)
  import Data.Maybe
  import Text.PrettyPrint.HughesPJ
  import qualified Data.Aeson  as A
  import qualified Data.Text   as T
  import qualified Data.Vector as V
  
  import Rest.Gen.Base.JSON.Pretty
  
  showExample :: Schema -> String
  showExample = render . pp_value . showExample'
    where
      showExample' s = case s of
        Choice []    -> A.Null -- Cannot create zero value
        Choice (x:_) -> showExample' x
        Object fs    -> A.object $ map (\f -> key f .= showExample' (content f)) fs
        Map v        -> A.object ["<key>" .= showExample' v]
        Tuple vs     -> A.Array $ V.fromList $ map showExample' vs
        Array l _ v  -> A.Array $ V.fromList $ replicate (lengthBoundExample l `max` 1) (showExample' v)
        Value _      -> A.String "value"
        Boolean      -> A.Bool True
        Number b     -> A.Number . boundExample $ b
        Any          -> A.String "<value>"
        Constant v   -> v
  #if !MIN_VERSION_json_schema(0,7,0)
        Null         -> A.Null
  #endif
  
  
  -- | Generate enough examples as to mention every possible field
  --   at least once
  showExamples :: Schema -> [String]
  showExamples = map (render . pp_value) . showExamples'
    where
      -- Recursive types have infinite schemas, so we must ensure
      -- that we don't generate infinitely deep examples in that case.
      -- We thus impose a limit to the number of nestings
      showExamples' = fst . go (10 :: Int)
  
      -- Idea: @go n x == (showExamples' n x, length (showExamples' n x))@
      -- and note that @snd (go x) >= 1@
      go 0 _ = ([A.String "..."],1)
      go n s = case s of
        Choice []   -> ([A.Null], 1)
  
        Choice xs   -> let (examples, numExamples) = unzip $ map (go $ n-1) xs
                       in (concat examples, sum numExamples)
  
        Object []   -> ([A.object []], 1)
  
        Object fs   -> let (esByFld, numEsByFld) = unzip $ map (fieldExs n) fs
                           numExamples = maximum numEsByFld
                           examples = map A.object $ take numExamples $ transpose $ map cycle esByFld
                       in (examples, numExamples)
  
        Map v       -> let (examples, _) = go (n-1) v
                           mkKey i = T.pack $ "<key " ++ show (i :: Int) ++ ">"
                       in ([A.object [mkKey i .= e | (i,e) <- zip [1..] examples]], 1)
  
        Tuple []    -> ([A.Array V.empty], 1)
  
        Tuple vs    -> let (esByPos,numEsByPos) = unzip $ map (go $ n-1) vs
                           numExamples = maximum numEsByPos
                           examples = take numExamples $ transpose $ map cycle esByPos
                       in (map (A.Array . V.fromList) examples, numExamples)
  
        Array l _ v -> let minLen = fromMaybe 0 (lowerLength l)
                           maxLen = fromMaybe (numCases `max` minLen) (upperLength l)
                           (cases,numCases) = go (n-1) v
                           (q,r) = numCases `divMod` maxLen
                           numExamples = q + signum r
                           examples = chunksOf maxLen $ cases ++ take (minLen - r) cases
                       in if maxLen == 0 then ([A.Array V.empty], 1)
                          else (map (A.Array . V.fromList) examples, numExamples)
  
        Value _     -> ([A.String "value"], 1)
  
        Boolean     -> ([A.Bool True], 1)
  
        Number b    -> ([A.Number $ boundExample b], 1)
  
        Any         -> ([A.String "<value>"],1)
  
        Constant v  -> ([v], 1)
  
  #if !MIN_VERSION_json_schema(0,7,0)
        Null        -> ([A.Null], 1)
  #endif
  
      fieldExs n f = let (examples,num_examples) = go (n-1) (content f)
                     in (map (key f .=) examples, num_examples)
  
  
  boundExample :: Num a => Bound -> a
  boundExample b = fromIntegral . fromMaybe 0 $ upper b <|> lower b
  
  lengthBoundExample :: Num a => LengthBound -> a
  lengthBoundExample b = fromIntegral $ fromMaybe 0 (upperLength b <|> lowerLength b)
  