V.hs

-- Not the greatest Haskell code, but it's possible to create a `i -> AccValidation err a` type 
-- that can keep help keep track of where errors are.

-- For aeson, may be possible to just put the `[(Text, Value)]`s in place of `[String]`?
-- e.g. * Replace `[String] -> AccValidation [VError] a` with `[(Text, Value)] -> AccValidation [VError] a`
--        where `Text` is the key name, and `Value` is the value being parsed
--      * Make the smart constructor also take in a `Value` so it can `<>` the data.
--      * `VError` would need to be parameterized too to accept `Value` instead of `String`

-- May not be useful, and please ignore the bad code for now. D: I'm tired.

-- # Setup
import           Control.Applicative
import           Control.Lens ((#))
import           Data.Monoid
import           Data.Validation
import qualified Data.ByteString.Char8 as BS
import qualified Data.Traversable as TR
 
type V a = [String] -> AccValidation [VError] a
 
data VError = MustNotBeEmpty [String] String
            | MustBeLessThan32Length [String] String
            deriving (Eq, Show)

-- Simple
newtype String32 = String32 String deriving (Eq, Show)

string32 :: String -> V String32
string32 t i
  | length t == 0  = _Failure # [MustNotBeEmpty i t]
  | length t > 32  = _Failure # [MustBeLessThan32Length i t]
  | otherwise      = _Success # String32 t
 
-- Complex
data Parent = Parent { parentName     :: String32
                     , favoriteChild  :: Child
                     , parentChildren :: [Child]
                     } deriving (Show)
 
data Child = Child { childName :: String32 
                   } deriving (Show)
 
parent :: V String32 -> V Child -> V [Child] ->  V Parent
parent name fav children i = Parent                       <$> 
                             name     (i <> ["name"])     <*> 
                             fav      (i <> ["favorite"]) <*> 
                             children (i <> ["children"])

child :: V String32 -> V Child
child name i = Child                <$> 
               name (i <> ["name"])

children :: [V Child] -> V [Child]
children xs i = 
  let a = zip xs [0..]
      b = fmap (\x -> (fst x) (i <> [show $ snd x])) a
  in TR.sequenceA b

main :: IO ()
main = do
  print $ child (string32 "Bob") []
  -- AccSuccess (Child {childName = String32 "Bob"})

  print $ child (string32 "") []
  -- AccFailure [MustNotBeEmpty ["name"] ""]

  print $ parent (string32 "Parent") (child (string32 "Bob")) (children []) []
  -- AccSuccess (Parent {parentName = String32 "Parent", favoriteChild = Child {childName = String32 "Bob"}, parentChildren = []})

  print $ parent (string32 "") (child (string32 "")) (children []) []
  -- AccFailure [MustNotBeEmpty ["name"] "",MustNotBeEmpty ["favorite","name"] ""]

  print $ parent (string32 "Parent") (child (string32 "Bob")) (children [child (string32 "Bob")]) []
  -- AccSuccess (Parent {parentName = String32 "Parent", favoriteChild = Child {childName = String32 "Bob"}, parentChildren = [Child {childName = String32 "Bob"}]})

  print $ parent (string32 "") (child (string32 "")) (children [child (string32 "")]) []
  -- AccFailure [MustNotBeEmpty ["name"] "",MustNotBeEmpty ["favorite","name"] "",MustNotBeEmpty ["children","0","name"] ""]