Skip to content

Instantly share code, notes, and snippets.

@snoyberg
Last active March 20, 2017 17:06
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save snoyberg/bfb8bd7bf41410bc1b6aa9b744d5f66f to your computer and use it in GitHub Desktop.
Save snoyberg/bfb8bd7bf41410bc1b6aa9b744d5f66f to your computer and use it in GitHub Desktop.
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
Copy link

qrilka commented Mar 10, 2017

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