-
-
Save danclien/d80b5f396b789e5fa215 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
-- 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` | |
-- ## Option 2 - Keep track of only the current `Value` and the key that failed (?) | |
-- * Lose the history and the calls to `<>` | |
-- * Pass a context `c` to the smart constructor. | |
-- * `(String, c) -> AccValidation [VError] a` | |
-- * `c` in this case should be an aeson `Value` | |
-- * For the front-end dev to figure out where the error occured, make them include | |
-- a unique identifier. | |
-- * The `Value` with the error will be included in the validation error | |
-- * Front-end dev can cross reference against their own unique identifier | |
-- 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"] ""] | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment