简体   繁体   中英

Additional pattern matching inside case

Hopefully, the code is commented well enough.

-- I have 2 data types:

data Person = Person { firstName :: String, lastName :: String, age :: Int }
  deriving (Show)

data Error = IncompleteDataError | IncorrectDataError String
  deriving (Show)

-- This function should take a list a pairs like:
-- fillPerson [("firstName","John"), ("lastName","Smith"), ("dbdf", "dff"), ("age","30"), ("age", "40")]
-- And fill the record with values of the fields with corresponding names.
-- It ignores the redundant fields.
-- If there are less then 3 meaningful fields, it should throw an error IncompleteDataError
-- If the field age doesn't have a number, if should return IncorrectDataError str, where str — is the value of age.

fillPerson :: [(String, String)] -> Either Error Person

fillPerson [] = Left IncompleteDataError
fillPerson (x:xs) = let

  -- Int stores number of fields
  helper :: [(String, String)] -> Person -> Int -> Either Error Person
  helper _ p 3 = Right p
  helper [] _ _ = Left IncompleteDataError
  helper ((key, value):xs) p n = case key of
    "firstName" -> helper xs p{firstName=value} (n + 1)
    "lastName" -> helper xs p{lastName=value} (n + 1)
    -- how to return IncorrectDataError str here?
    -- I need to store reads value :: [(Int, String)]
    -- if the String is not empty, return Left IncorrectDataError value
    -- but how to write this?
    "age" -> helper xs p{age=read value::Int} (n + 1)
    _ -> helper xs p n
  in
    helper (x:xs) Person{} 0

You have an association list; use lookup to get each name, or produce an IncompleteDataError if the lookup fails. maybe converts each Nothing to a Left value and each Just value to Right value .

-- lookup :: Eq a => a -> [(a,b)] -> Maybe b
-- maybe :: b -> (a -> b) -> Maybe a -> b

verifyInt :: String -> Either Error Int
verifyInt x = ... -- E.g. verify "3" == Right 3
                  --      verify "foo" == Left IncorrectDataError


fillPerson kv = Person
                <$> (get "firstName" kv)
                <*> (get "lastName" kv)
                <*> (get "age" kv >>= verifyInt)
    where get key kv = maybe (Left IncompleteDataError) Right $ lookup key kv

Since get :: String -> [(String, String)] -> Either Error String , the Applicative instance for functions ensures that fillPerson :: [(String, String)] -> Either Error Person . If any call to get returns Left IncompleteDataError , the result of Person <$> ... will do so as well; otherwise, you'll get a Right (Person ...) value.

The problem that you have is trying to do all the things at once in a single recursive function, interleaving several different concerns. It's possible to write that way, but better to follow the format of @chepner's answer and break things down into pieces. This is a supplement to their answer re. the verification of age . With the addition of an import:

-- readMaybe :: Read a => String -> Maybe a
import Text.Read (readMaybe)

And a helper function to turn Maybe “failures” ( Nothing ) into the corresponding Either ( Left ):

maybeToEither :: a -> Maybe b -> Either a b
maybeToEither x = maybe (Left x) Right

Here is a solution that does all the verification you describe:

fillPerson store = do  -- Either monad

  -- May fail with ‘IncompleteDataError’
  f <- string "firstName"
  l <- string "lastName"

  -- May fail with ‘IncompleteDataError’ *or* ‘IncorrectDataError’
  a <- int "age"

  pure Person
    { firstName = f
    , lastName = l
    , age = a
    }

  where

    string :: String -> Either Error String
    string key = maybeToEither IncompleteDataError (lookup key store)

    int :: String -> Either Error Int
    int key = do
      value <- string key  -- Reuse error handling from ‘string’
      maybeToEither (IncorrectDataError value) (readMaybe value)

You can make this more compact using RecordWildCards , although this is less advisable because it's not explicit, so it's sensitive to renaming of fields in Person .

fillPerson store = do
  firstName <- string "firstName"
  lastName <- string "lastName"
  age <- int "age"
  pure Person{..}  -- Implicitly, ‘firstName = firstName’ &c.
  where
    …

Applicative operators are more common for this type of thing, and preferable in most cases as they avoid unnecessary intermediate names. However, one caveat of using positional arguments rather than named fields is that it's possible to mix up the order of fields that have the same type (here, firstName and lastName ).

fillPerson store = Person
  <$> string "firstName"
  <*> string "lastName"
  <*> int "age"
  where
    …

It's also possible to make this definition point-free, omitting store from the parameters of fillPerson and making it instead a parameter of string and int , using liftA3 Person <$> string "firstName" <*> … (the (r ->) applicative); in this particular case I wouldn't choose that style, but it may be a worthy exercise to try to rewrite it yourself.


As to your question:

    -- I need to store reads value :: [(Int, String)]
    -- if the String is not empty, return Left IncorrectDataError value
    -- but how to write this?

You can write:

"age" -> case reads value of
  [(value', "")] -> helper xs p{age=value'} (n + 1)
  _ -> Left (IncorrectValueError value)

However there are a number of problems with your code:

  • It starts with a Person whose fields are undefined, and will raise exceptions if accessed, which would be fine if you guaranteed that they were all filled in, but…

  • It tracks the number of fields set but not which fields , so you can set firstName three times and end up returning an invalid Person .

So if you want to do this in a single definition, here's how I would restructure it—keep the recursive helper, but make each equation handle one condition, using an accumulator with Maybe s for each of the fields, updating them from Nothing to Just as you find each field.

fillPerson' :: [(String, String)] -> Either Error Person
fillPerson' = fillFields (Nothing, Nothing, Nothing)
  where

    fillFields
      -- Accumulator of firstName, lastName, and age.
      :: (Maybe String, Maybe String, Maybe Int)
      -- Remaining input keys to check.
      -> [(String, String)]
      -- Final result.
      -> Either Error Person

    -- Set firstName if not set.
    fillFields (Nothing, ml, ma) (("firstName", f) : kvs)
      = fillFields (Just f, ml, ma) kvs

    -- Set lastName if not set.
    fillFields (mf, Nothing, ma) (("lastName", l) : kvs)
      = fillFields (mf, Just l, ma) kvs

    -- Set age if not set, failing immediately if not a valid number.
    fillFields (mf, ml, Nothing) (("age", a) : kvs)
      | all (`elem` ['0'..'9']) a
      = fillFields (mf, ml, Just (read a)) kvs
      | otherwise
      = Left (IncorrectDataError a)

    -- Ignore redundant firstName.
    fillFields acc@(Just{}, ml, ma) (("firstName", _) : kvs)
      = fillFields acc kvs

    -- Ignore redundant lastName.
    fillFields acc@(mf, Just{}, ma) (("lastName", _) : kvs)
      = fillFields acc kvs

    -- Ignore redundant age.
    fillFields acc@(mf, ml, Just{}) (("age", _) : kvs)
      = fillFields acc kvs

    -- Ignore extra fields.
    fillFields acc (_ : kvs)
      = fillFields acc kvs

    -- If all fields are present anywhere in the input,
    -- we can finish early and successfully.
    fillFields (Just f, Just l, Just a) _
      = Right Person
        { firstName = f
        , lastName = l
        , age = a
        }

    -- If any field is missing at the end, fail.
    fillFields __ []
      = Left IncompleteDataError

Note how the structure of the code is very brittle: if we change Person at all, many lines of this definition will have to change. That's why it's better to break the problem down into smaller composable parts and put them together.

This does, however, serve as an example of how to translate an “imperative” loop into Haskell: write a recursive function with an accumulator for your “mutable” state, make a recursive call (possibly updating the accumulator) to loop, and stop the recursion to exit the loop. (In fact, if you squint, this is essentially a translation of an imperative program into an explicit control graph.)

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM