Create a gist now

Instantly share code, notes, and snippets.

@snoyberg /v1.hs
Last active Mar 20, 2017

What would you like to do?
Do notation/partial pattern match blog post
#!/usr/bin/env stack
-- stack --install-ghc --resolver lts-8.0 runghc --package text
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
import qualified Data.Text as T
import Data.Text (Text)
import Data.Text.Read
input :: Text
input =
"Alice 165cm 30y 15\n\
\Bob 170cm 35y -20\n\
\Charlie 175cm 40y 0\n"
data Person = Person
{ name :: !Text
, height :: !Int
, age :: !Int
, balance :: !Int
}
deriving Show
parseLine :: Text -> Maybe Person
parseLine t0 = do
let (name, t1) = T.break (== ' ') t0
t2 <- T.stripPrefix " " t1
(height, t3) <-
case decimal t2 of
Right (height, t3) -> Just (height, t3)
Left _ -> Nothing
t4 <- T.stripPrefix "cm " t3
(age, t5) <-
case decimal t4 of
Right (age, t5) -> Just (age, t5)
Left _ -> Nothing
t6 <- T.stripPrefix "y " t5
balance <-
case signed decimal t6 of
Right (balance, "") -> Just balance
_ -> Nothing
Just Person {..}
parseLines :: Text -> Maybe [Person]
parseLines = mapM parseLine . T.lines
main :: IO ()
main =
case parseLines input of
Nothing -> error "Invalid input"
Just people -> mapM_ print people
#!/usr/bin/env stack
-- stack --install-ghc --resolver lts-8.0 runghc --package text
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
import qualified Data.Text as T
import Data.Text (Text)
import Data.Text.Read
input :: Text
input =
"Alice 165cm 30y 15\n\
\Bob 170cm 35y -20\n\
\Charlie 175cm 40y 0\n"
data Person = Person
{ name :: !Text
, height :: !Int
, age :: !Int
, balance :: !Int
}
deriving Show
parseLine :: Text -> Maybe Person
parseLine t0 = do
let (name, t1) = T.break (== ' ') t0
t2 <- T.stripPrefix " " t1
let Right (height, t3) = decimal t2
t4 <- T.stripPrefix "cm " t3
let Right (age, t5) = decimal t4
t6 <- T.stripPrefix "y " t5
let Right (balance, "") = signed decimal t6
Just Person {..}
parseLines :: Text -> Maybe [Person]
parseLines = mapM parseLine . T.lines
main :: IO ()
main =
case parseLines input of
Nothing -> error "Invalid input"
Just people -> mapM_ print people
#!/usr/bin/env stack
-- stack --install-ghc --resolver lts-8.0 runghc --package text
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
import qualified Data.Text as T
import Data.Text (Text)
import Data.Text.Read
input :: Text
input =
"Alice 165cm 30y 15\n\
\Bob 170cm 35y -20\n\
\Charlie 175cm 40y 0\n"
data Person = Person
{ name :: !Text
, height :: !Int
, age :: !Int
, balance :: !Int
}
deriving Show
parseLine :: Text -> Maybe Person
parseLine t0 = do
let (name, t1) = T.break (== ' ') t0
t2 <- T.stripPrefix " " t1
Right (height, t3) <- Just $ decimal t2
t4 <- T.stripPrefix "cm " t3
Right (age, t5) <- Just $ decimal t4
t6 <- T.stripPrefix "y " t5
Right (balance, "") <- Just $ signed decimal t6
Just Person {..}
parseLines :: Text -> Maybe [Person]
parseLines = mapM parseLine . T.lines
main :: IO ()
main =
case parseLines input of
Nothing -> error "Invalid input"
Just people -> mapM_ print people
#!/usr/bin/env stack
-- stack --install-ghc --resolver lts-8.0 runghc --package text
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
import Control.Monad (guard)
import qualified Data.Text as T
import Data.Text (Text)
import Data.Text.Read
input :: Text
input =
"Alice 165cm 30y 15\n\
\Bob 170cm 35y -20\n\
\Charlie 175cm 40y 0\n"
data Person = Person
{ name :: !Text
, height :: !Int
, age :: !Int
, balance :: !Int
}
deriving Show
parseLine :: Text -> Maybe Person
parseLine t0 = do
let (name, t1) = T.break (== ' ') t0
t2 <- T.stripPrefix " " t1
(height, t3) <- either (const Nothing) Just $ decimal t2
t4 <- T.stripPrefix "cm " t3
(age, t5) <- either (const Nothing) Just $ decimal t4
t6 <- T.stripPrefix "y " t5
(balance, t7) <- either (const Nothing) Just $ signed decimal t6
guard $ T.null t7
Just Person {..}
parseLines :: Text -> Maybe [Person]
parseLines = mapM parseLine . T.lines
main :: IO ()
main =
case parseLines input of
Nothing -> error "Invalid input"
Just people -> mapM_ print people

qrilka commented Mar 10, 2017 edited

There's also http://hackage.haskell.org/package/errors-2.1.3/docs/Control-Error-Util.html#v:hush to make the last variant a bit less verbose :)

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment