## The boss wants more

So the boss comes back and says, “Naren, this is great but I don’t want to write code to specify my schedule”. He scribbles some notes on the whiteboard to illustrate that he’d rather specify his schedules in plain text.

```
Meeting with CTO
Mo, We,Fr 10-12, 3-5
Lunch
Mo,Tu,We,Th,Fr 12-1
```

###
Amazingly, your colleague has a parser

You don’t scramble into a panic because your best pal already has a parser created and it reads as follows. Some imports;

```
> {-# LANGUAGE OverloadedStrings #-}
> module CoverPart2 where
> import CoverPart1
> import SchedulePrimitives
> import Prelude hiding (takeWhile)
> import Control.Applicative
> import Control.Monad
> import Data.Attoparsec.Text
> import Data.Attoparsec.Combinator
> import Data.Char
> import Data.Functor.Compose
> import Data.Text (Text,unpack,pack)
```

a few individual parsers for the label, the day of week, and time range components;

```
> label :: Parser Text
> label = skipSpace *> takeWhile1 (\c -> not (isEndOfLine c) && (isAlphaNum c || isSpace c)) <* endOfLine
>
> dayOfWeekP :: Parser Text
> dayOfWeekP = skipSpace *> choice ["Mo","Tu","We","Th","Fr","Sa","Su"]
>
> hourRangeP :: Parser (Int,Int)
> hourRangeP = do
> skipSpace
> x <- decimal
> guard (x >= 0 && x <= 23)
> char '-'
> y <- decimal
> guard (y >= 0 && y <= 23 && x < y)
> return (x,y)
```

and, in keeping with good coding, a full parser is created using combinations of the above.

```
> schedule :: Parser [(Text,[Text],[(Int,Int)])]
> schedule = many $
> (,,)
> <$> label
> <*> (dayOfWeekP `sepBy1` (skipSpace *> char ','))
> <*> (hourRangeP `sepBy1` (skipSpace *> char ','))
```

You try it out.

```
> sched1 :: Text
> sched1 = "Meet with CTO\n\
> \Mo,We,Fr 10-12, 15-16\n\
> \\n\
> \Lunch\n\
> \Mo,Tu,We,Tu,Fr 12-13"
```

```
ghci> let Right s = parseOnly schedule sched1
ghci> mapM_ print s
("Meet with CTO",["Mo","We","Fr"],[(10,12),(15,16)])
("Lunch",["Mo","Tu","We","Tu","Fr"],[(12,13)])
```

## I don’t want to write another interpreter!

Nice. Technically, you could write a converter to take the output of this parser and convert it to a schedule. That’s just a whole lot of double work. Because, you essentially end up writing another parser – only this time, it parses a data structure. So, let’s have a look at our humble friend from the last post that allowed us to hang `IO`

actions within a `Schedule DT`

. Surely, what we want is to hang `Schedule DT`

within a `Parser`

!

```
> type ParserS = Compose Parser (Schedule DT)
>
> (<$$>) :: (b -> Schedule DT a) -> Parser b -> ParserS a
> f <$$> p = Compose $ f <$> p
>
> liftP :: Parser a -> ParserS a
> liftP = (<$$>) pure
```

Here’s the new schedule parser,

```
> scheduleS :: ParserS [Text]
> scheduleS = fmap (foldr (++) []) . many $
> (\l a b -> if a && b then [l] else [])
> <$> liftP label
> <*> fmap or (dayOfWeekS `sepBy1` (liftP $ skipSpace *> char ','))
> <*> fmap or (hourRangeS `sepBy1` (liftP $ skipSpace *> char ','))
> where dayOfWeekS = (fmap (snd.fst) . dayOfWeek . unpack) <$$> dayOfWeekP
> hourRangeS = (uncurry hourRange) <$$> hourRangeP
>
> hourRange :: Int -> Int -> Schedule DT Bool
> hourRange i j = (\(_,(a,_)) (_,(b,_)) -> a > b)
> <$> arbitraryRange (fromIntegral i*3600) (24*3600)
> <*> arbitraryRange (fromIntegral j*3600) (24*3600)
```

et voila!

```
ghci> let Right s = parseOnly (getCompose scheduleS) sched1
ghci> :t s
s :: Schedule DT [Text]
ghci> pretty . filter (not . null . fst) $ runSchedule s (0,7*24*3600)
(1970-01-02 10:00:00 UTC,1970-01-02 11:59:59 UTC) ---> ["Meet with CTO"]
(1970-01-02 12:00:00 UTC,1970-01-02 12:59:59 UTC) ---> ["Lunch"]
(1970-01-02 15:00:00 UTC,1970-01-02 15:59:59 UTC) ---> ["Meet with CTO"]
(1970-01-05 10:00:00 UTC,1970-01-05 11:59:59 UTC) ---> ["Meet with CTO"]
(1970-01-05 12:00:00 UTC,1970-01-05 12:59:59 UTC) ---> ["Lunch"]
(1970-01-05 15:00:00 UTC,1970-01-05 15:59:59 UTC) ---> ["Meet with CTO"]
(1970-01-06 12:00:00 UTC,1970-01-06 12:59:59 UTC) ---> ["Lunch"]
(1970-01-07 10:00:00 UTC,1970-01-07 11:59:59 UTC) ---> ["Meet with CTO"]
(1970-01-07 12:00:00 UTC,1970-01-07 12:59:59 UTC) ---> ["Lunch"]
(1970-01-07 15:00:00 UTC,1970-01-07 15:59:59 UTC) ---> ["Meet with CTO"]
```

There are no problems with overlapping events either.

```
> sched2 :: Text
> sched2 = "Meet with CTO\n\
> \Mo,We,Fr 11-13, 15-16\n\
> \\n\
> \Lunch\n\
> \Mo,Tu,We,Tu,Fr 12-13"
```

```
ghci> let Right s = parseOnly (getCompose scheduleS) sched2
ghci> pretty . filter (not . null . fst) $ runSchedule s (0,7*24*3600)
(1970-01-02 11:00:00 UTC,1970-01-02 11:59:59 UTC) ---> ["Meet with CTO"]
(1970-01-02 12:00:00 UTC,1970-01-02 12:59:59 UTC) ---> ["Meet with CTO","Lunch"]
(1970-01-02 15:00:00 UTC,1970-01-02 15:59:59 UTC) ---> ["Meet with CTO"]
(1970-01-05 11:00:00 UTC,1970-01-05 11:59:59 UTC) ---> ["Meet with CTO"]
(1970-01-05 12:00:00 UTC,1970-01-05 12:59:59 UTC) ---> ["Meet with CTO","Lunch"]
(1970-01-05 15:00:00 UTC,1970-01-05 15:59:59 UTC) ---> ["Meet with CTO"]
(1970-01-06 12:00:00 UTC,1970-01-06 12:59:59 UTC) ---> ["Lunch"]
(1970-01-07 11:00:00 UTC,1970-01-07 11:59:59 UTC) ---> ["Meet with CTO"]
(1970-01-07 12:00:00 UTC,1970-01-07 12:59:59 UTC) ---> ["Meet with CTO","Lunch"]
(1970-01-07 15:00:00 UTC,1970-01-07 15:59:59 UTC) ---> ["Meet with CTO"]
```

## Next time

I’ve often been under the impression that `Applicative`

’s are pretty boring; I tend to spend no time with them as I tuck into `Monad`

s straight way; so, I’ll leave myself and you, the reader, with a collection of great blog-posts and Haskell libraries on this topic that are well worth the read. Next time, I’ll go back to the problem of leap years and general constraint specification.

- Gabriel Gonzalez: Using Applicative and Alterative to model database table joins
- A masterclass (using folds) not only in Applicative but also in treating computations as primitives:
- Conal Elliott: Another lovely example of type class morphisms
- Conal Elliott: More beautiful fold zipping
- Gabriel’s post: Composable streaming folds

- Paolo Capriotti: Applicative is thoroughly embraced in this package
- Of course, I can’t list posts on abstractions without Mr. Edward Kmett’s input on this matter: Abstracting With Applicatives

There are many more in the back of my head; I’ll add them here as I recall them. Meanwhile, please leave your links in the comments below!