module Chez.Grater.Parser where

import Chez.Grater.Internal.Prelude

import Chez.Grater.Parser.Types
  ( ParsedIngredient(..), ParsedIngredientName(..), ParsedQuantity(..), ParsedUnit(..)
  )
import Chez.Grater.Scraper.Types (ScrapedIngredient(..), ScrapedStep(..))
import Chez.Grater.Types
  ( Ingredient(..), IngredientName(..), Quantity(..), Step(..), Unit(..), box, cup, emptyQuantity
  , gram, liter, milligram, milliliter, mkQuantity, ounce, pinch, pound, splash, sprinkle
  , tablespoon, teaspoon, whole
  )
import Data.Char (isAlpha, isDigit, isSpace)
import Data.Function (fix)
import Text.Read (readMaybe)
import qualified Data.Attoparsec.Text as Atto
import qualified Data.CaseInsensitive as CI
import qualified Data.Map.Strict as Map
import qualified Data.Text as Text

unitAliasTable :: Map (CI Text) Unit
unitAliasTable :: Map (CI Text) Unit
unitAliasTable = [(CI Text, Unit)] -> Map (CI Text) Unit
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
  [ (CI Text
"ounce", Unit
ounce)
  , (CI Text
"ounces", Unit
ounce)
  , (CI Text
"oz", Unit
ounce)
  , (CI Text
"c", Unit
cup)
  , (CI Text
"cup", Unit
cup)
  , (CI Text
"cups", Unit
cup)
  , (CI Text
"tablespoon", Unit
tablespoon)
  , (CI Text
"tablespoons", Unit
tablespoon)
  , (CI Text
"tbsp", Unit
tablespoon)
  , (CI Text
"teaspoon", Unit
teaspoon)
  , (CI Text
"teaspoons", Unit
teaspoon)
  , (CI Text
"tsp", Unit
teaspoon)
  , (CI Text
"pinch", Unit
pinch)
  , (CI Text
"pinches", Unit
pinch)
  , (CI Text
"box", Unit
box)
  , (CI Text
"boxes", Unit
box)
  , (CI Text
"pound", Unit
pound)
  , (CI Text
"pounds", Unit
pound)
  , (CI Text
"splash", Unit
splash)
  , (CI Text
"splashes", Unit
splash)
  , (CI Text
"sprinkle", Unit
sprinkle)
  , (CI Text
"sprinkles", Unit
sprinkle)
  , (CI Text
"whole", Unit
whole)

  , (CI Text
"milliliter", Unit
milliliter)
  , (CI Text
"millilitre", Unit
milliliter)
  , (CI Text
"ml", Unit
milliliter)
  , (CI Text
"liter", Unit
liter)
  , (CI Text
"litre", Unit
liter)
  , (CI Text
"l", Unit
liter)
  , (CI Text
"milligram", Unit
milligram)
  , (CI Text
"mg", Unit
milligram)
  , (CI Text
"gram", Unit
gram)
  , (CI Text
"g", Unit
gram)
  ]

quantityAliasTable :: Map (CI Text) Quantity
quantityAliasTable :: Map (CI Text) Quantity
quantityAliasTable = (Double -> Quantity)
-> Map (CI Text) Double -> Map (CI Text) Quantity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> Quantity
mkQuantity (Map (CI Text) Double -> Map (CI Text) Quantity)
-> ([(CI Text, Double)] -> Map (CI Text) Double)
-> [(CI Text, Double)]
-> Map (CI Text) Quantity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(CI Text, Double)] -> Map (CI Text) Double
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(CI Text, Double)] -> Map (CI Text) Quantity)
-> [(CI Text, Double)] -> Map (CI Text) Quantity
forall a b. (a -> b) -> a -> b
$
  [ (CI Text
"half dozen", Double
6)
  , (CI Text
"dozen", Double
12)
  , (CI Text
"quarter", Double
0.25)
  , (CI Text
"third", Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
3)
  , (CI Text
"half", Double
0.5)
  , (CI Text
"one", Double
1)
  , (CI Text
"two", Double
2)
  , (CI Text
"three", Double
3)
  , (CI Text
"four", Double
4)
  , (CI Text
"five", Double
5)
  , (CI Text
"six", Double
6)
  , (CI Text
"seven", Double
7)
  , (CI Text
"eight", Double
8)
  , (CI Text
"nine", Double
9)
  , (CI Text
"ten", Double
10)
  , (CI Text
"eleven", Double
11)
  , (CI Text
"twelve", Double
12)
  ]

scrubIngredientName :: ParsedIngredientName -> IngredientName
scrubIngredientName :: ParsedIngredientName -> IngredientName
scrubIngredientName = CI Text -> IngredientName
IngredientName (CI Text -> IngredientName)
-> (ParsedIngredientName -> CI Text)
-> ParsedIngredientName
-> IngredientName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedIngredientName -> CI Text
unParsedIngredientName

scrubUnit :: ParsedUnit -> Maybe Unit
scrubUnit :: ParsedUnit -> Maybe Unit
scrubUnit = \case
  ParsedUnit CI Text
x -> Unit -> Maybe Unit
forall a. a -> Maybe a
Just (Unit -> Maybe Unit) -> Unit -> Maybe Unit
forall a b. (a -> b) -> a -> b
$ Unit -> CI Text -> Map (CI Text) Unit -> Unit
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (CI Text -> Unit
Unit CI Text
x) CI Text
x Map (CI Text) Unit
unitAliasTable
  ParsedUnit
ParsedUnitMissing -> Maybe Unit
forall a. Maybe a
Nothing

scrubQuantity :: ParsedQuantity -> Quantity
scrubQuantity :: ParsedQuantity -> Quantity
scrubQuantity = \case
  ParsedQuantity Double
q -> Double -> Quantity
mkQuantity Double
q
  ParsedQuantityWord CI Text
w -> Quantity -> CI Text -> Map (CI Text) Quantity -> Quantity
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Quantity
emptyQuantity CI Text
w Map (CI Text) Quantity
quantityAliasTable
  ParsedQuantity
ParsedQuantityMissing -> Quantity
emptyQuantity

scrubIngredient :: ParsedIngredient -> Ingredient
scrubIngredient :: ParsedIngredient -> Ingredient
scrubIngredient ParsedIngredient {ParsedUnit
ParsedQuantity
ParsedIngredientName
parsedIngredientUnit :: ParsedIngredient -> ParsedUnit
parsedIngredientQuantity :: ParsedIngredient -> ParsedQuantity
parsedIngredientName :: ParsedIngredient -> ParsedIngredientName
parsedIngredientUnit :: ParsedUnit
parsedIngredientQuantity :: ParsedQuantity
parsedIngredientName :: ParsedIngredientName
..} = Ingredient :: IngredientName -> Quantity -> Maybe Unit -> Ingredient
Ingredient
  { ingredientName :: IngredientName
ingredientName = ParsedIngredientName -> IngredientName
scrubIngredientName ParsedIngredientName
parsedIngredientName
  , ingredientQuantity :: Quantity
ingredientQuantity = ParsedQuantity -> Quantity
scrubQuantity ParsedQuantity
parsedIngredientQuantity
  , ingredientUnit :: Maybe Unit
ingredientUnit = ParsedUnit -> Maybe Unit
scrubUnit ParsedUnit
parsedIngredientUnit
  }

quantityP :: Atto.Parser ParsedQuantity
quantityP :: Parser ParsedQuantity
quantityP = Parser ParsedQuantity
quantityExpression Parser ParsedQuantity
-> Parser ParsedQuantity -> Parser ParsedQuantity
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ParsedQuantity
quantityWord Parser ParsedQuantity
-> Parser ParsedQuantity -> Parser ParsedQuantity
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ParsedQuantity
quantityMissing
  where
    isIgnoredC :: Char -> Bool
isIgnoredC Char
c = Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
c [Char
'Â']
    isQuantityC :: Char -> Bool
isQuantityC Char
c = Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
c [Char
'/', Char
'.', Char
'-', Char
'⁄', Char
'¼', Char
'½', Char
'¾', Char
'⅓', Char
'⅔'] Bool -> Bool -> Bool
|| Char -> Bool
isIgnoredC Char
c
    quantityParser :: (Text -> Parser Text b) -> Parser Text b
quantityParser Text -> Parser Text b
p = Text -> Parser Text b
p (Text -> Parser Text b) -> (Text -> Text) -> Text -> Parser Text b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
Text.filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isIgnoredC) (Text -> Parser Text b) -> Parser Text Text -> Parser Text b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Char -> Bool) -> Parser Text Text
Atto.takeWhile Char -> Bool
isQuantityC
    strictQuantityParser :: (Text -> Parser Text b) -> Parser Text b
strictQuantityParser Text -> Parser Text b
p = Text -> Parser Text b
p (Text -> Parser Text b) -> (Text -> Text) -> Text -> Parser Text b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.strip (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
Text.filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isIgnoredC) (Text -> Parser Text b) -> Parser Text Text -> Parser Text b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Char -> Bool) -> Parser Text Text
Atto.takeWhile1 Char -> Bool
isQuantityC

    quantitySingle :: Text -> m a
quantitySingle Text
str = m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> m a) -> [Char] -> m a
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
Text.unpack Text
str [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" is not a single quantity") a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> m a) -> (Text -> Maybe a) -> Text -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Maybe a
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> Maybe a) -> (Text -> [Char]) -> Text -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
Text.unpack (Text -> [Char]) -> (Text -> Text) -> Text -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
Text.filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) (Text -> m a) -> Text -> m a
forall a b. (a -> b) -> a -> b
$ Text
str
    quantityUnicode :: Text -> f a
quantityUnicode = \case
      Text
"¼" -> a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
0.25
      Text
"½" -> a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
0.5
      Text
"¾" -> a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
0.75
      Text
"⅓" -> a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> f a) -> a -> f a
forall a b. (a -> b) -> a -> b
$ a
1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
3
      Text
"⅔" -> a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> f a) -> a -> f a
forall a b. (a -> b) -> a -> b
$ a
2 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
3
      Text
str -> [Char] -> f a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> f a) -> [Char] -> f a
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
Text.unpack Text
str [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" is not a unicode quantity"
    quantityDecimal :: Text -> m a
quantityDecimal Text
str = case (Char -> Bool) -> Text -> [Text]
Text.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==) Char
'.') Text
str of
      [Text
x, Text
y] -> m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> m a) -> [Char] -> m a
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
Text.unpack Text
str [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" is not a decimal quantity") a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> m a) -> Maybe a -> m a
forall a b. (a -> b) -> a -> b
$ do
        a
x' <- Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer -> a) -> Maybe Integer -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Maybe Integer
forall a. Read a => [Char] -> Maybe a
readMaybe (Text -> [Char]
Text.unpack Text
x)
        a
y' <- Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer -> a) -> Maybe Integer -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Maybe Integer
forall a. Read a => [Char] -> Maybe a
readMaybe (Text -> [Char]
Text.unpack Text
y)
        a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a
x' a -> a -> a
forall a. Num a => a -> a -> a
+ (a
y' a -> a -> a
forall a. Fractional a => a -> a -> a
/ (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Text -> Int
Text.length Text
y))
      [Text]
_ -> [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> m a) -> [Char] -> m a
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
Text.unpack Text
str [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" is not a decimal quantity"
    quantityFraction :: Text -> m a
quantityFraction Text
str = case (Char -> Bool) -> Text -> [Text]
Text.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==) Char
'/') (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
Text.replace Text
"⁄" Text
"/" Text
str of
      [Text
x, Text
y] -> m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> m a) -> [Char] -> m a
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
Text.unpack Text
str [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" is not a fractional quantity") a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> m a) -> Maybe a -> m a
forall a b. (a -> b) -> a -> b
$
        a -> a -> a
forall a. Fractional a => a -> a -> a
(/) (a -> a -> a) -> Maybe a -> Maybe (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Maybe a
forall a. Read a => [Char] -> Maybe a
readMaybe (Text -> [Char]
Text.unpack Text
x) Maybe (a -> a) -> Maybe a -> Maybe a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> Maybe a
forall a. Read a => [Char] -> Maybe a
readMaybe (Text -> [Char]
Text.unpack Text
y)
      [Text]
_ -> [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> m a) -> [Char] -> m a
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
Text.unpack Text
str [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" is not a fractional quantity"

    quantityImproper :: Parser Text b
quantityImproper = (Text -> Parser Text b) -> Parser Text b
forall b. (Text -> Parser Text b) -> Parser Text b
quantityParser ((Text -> Parser Text b) -> Parser Text b)
-> (Text -> Parser Text b) -> Parser Text b
forall a b. (a -> b) -> a -> b
$ \Text
str -> case (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Text]] -> [Text]
forall a. Monoid a => [a] -> a
mconcat ([[Text]] -> [Text]) -> (Text -> [[Text]]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [Text]) -> [Text] -> [[Text]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Char -> Bool) -> Text -> [Text]
Text.split Char -> Bool
isSpace) ([Text] -> [[Text]]) -> (Text -> [Text]) -> Text -> [[Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
Text.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==) Char
'-') (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text
str of
      [Text
x, Text
y] -> do
        b
x' <- Text -> Parser Text b
forall (f :: * -> *) a.
(Alternative f, MonadFail f, Read a, Fractional a) =>
Text -> f a
quantitySimple Text
x
        b
y' <- Text -> Parser Text b
forall (f :: * -> *) a.
(Alternative f, MonadFail f, Read a, Fractional a) =>
Text -> f a
quantitySimple Text
y
        b -> Parser Text b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> Parser Text b) -> b -> Parser Text b
forall a b. (a -> b) -> a -> b
$ if b
x' b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< b
y' then (b
x' b -> b -> b
forall a. Num a => a -> a -> a
+ b
y') b -> b -> b
forall a. Fractional a => a -> a -> a
/ b
2 else b
x' b -> b -> b
forall a. Num a => a -> a -> a
+ b
y'
      [Text]
_ -> [Char] -> Parser Text b
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser Text b) -> [Char] -> Parser Text b
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
Text.unpack Text
str [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" is not an improper quantity"

    quantitySimple :: Text -> f a
quantitySimple Text
str =
      Text -> f a
forall (m :: * -> *) a. (MonadFail m, Read a) => Text -> m a
quantitySingle Text
str
        f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> f a
forall (f :: * -> *) a. (Fractional a, MonadFail f) => Text -> f a
quantityUnicode Text
str
        f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> f a
forall (m :: * -> *) a. (MonadFail m, Fractional a) => Text -> m a
quantityDecimal Text
str
        f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> f a
forall (m :: * -> *) a.
(MonadFail m, Fractional a, Read a) =>
Text -> m a
quantityFraction Text
str

    quantityExpression :: Parser ParsedQuantity
quantityExpression = Double -> ParsedQuantity
ParsedQuantity (Double -> ParsedQuantity)
-> Parser Text Double -> Parser ParsedQuantity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text -> Parser Text Double) -> Parser Text Double
forall b. (Text -> Parser Text b) -> Parser Text b
strictQuantityParser Text -> Parser Text Double
forall (f :: * -> *) a.
(Alternative f, MonadFail f, Read a, Fractional a) =>
Text -> f a
quantitySimple Parser Text Double -> Parser Text Double -> Parser Text Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Double
forall b. (Read b, Fractional b, Ord b) => Parser Text b
quantityImproper)
    quantityWord :: Parser ParsedQuantity
quantityWord = CI Text -> ParsedQuantity
ParsedQuantityWord (CI Text -> ParsedQuantity)
-> (Text -> CI Text) -> Text -> ParsedQuantity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk (Text -> ParsedQuantity)
-> Parser Text Text -> Parser ParsedQuantity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((\Text
str -> if Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk Text
str CI Text -> [CI Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Map (CI Text) Quantity -> [CI Text]
forall k a. Map k a -> [k]
Map.keys Map (CI Text) Quantity
quantityAliasTable then Text -> Parser Text Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
str else [Char] -> Parser Text Text
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser Text Text) -> [Char] -> Parser Text Text
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
Text.unpack Text
str [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" is not a quantity") (Text -> Parser Text Text) -> Parser Text Text -> Parser Text Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser Text Text -> Parser Text Text
forall a. Parser a -> Parser a
spaced ((Char -> Bool) -> Parser Text Text
Atto.takeWhile1 Char -> Bool
isAlpha))
    quantityMissing :: Parser ParsedQuantity
quantityMissing = (Text -> Parser ParsedQuantity) -> Parser ParsedQuantity
forall b. (Text -> Parser Text b) -> Parser Text b
quantityParser ((Text -> Parser ParsedQuantity) -> Parser ParsedQuantity)
-> (Text -> Parser ParsedQuantity) -> Parser ParsedQuantity
forall a b. (a -> b) -> a -> b
$ \Text
str -> case Text -> Bool
Text.null Text
str of
      Bool
True -> ParsedQuantity -> Parser ParsedQuantity
forall (f :: * -> *) a. Applicative f => a -> f a
pure ParsedQuantity
ParsedQuantityMissing
      Bool
False -> [Char] -> Parser ParsedQuantity
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser ParsedQuantity)
-> [Char] -> Parser ParsedQuantity
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
Text.unpack Text
str [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" is a quantity, but thought it was missing"

spaced :: Atto.Parser a -> Atto.Parser a
spaced :: Parser a -> Parser a
spaced Parser a
p = Parser Text () -> Parser Text (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Text Char -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser Text Char
Atto.space) Parser Text (Maybe ()) -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser a
p Parser a -> Parser Text (Maybe ()) -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text () -> Parser Text (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Text Char -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser Text Char
Atto.space))

unitP :: Atto.Parser ParsedUnit
unitP :: Parser ParsedUnit
unitP = Parser ParsedUnit
unitWord Parser ParsedUnit -> Parser ParsedUnit -> Parser ParsedUnit
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsedUnit -> Parser ParsedUnit
forall (f :: * -> *) a. Applicative f => a -> f a
pure ParsedUnit
ParsedUnitMissing
  where
    isIgnoredC :: Char -> Bool
isIgnoredC Char
c = Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
c [Char
'.']
    isUnitC :: Char -> Bool
isUnitC Char
c = Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char -> Bool
isIgnoredC Char
c
    unitWord :: Parser ParsedUnit
unitWord = do
      CI Text
unit <- Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk (Text -> CI Text) -> (Text -> Text) -> Text -> CI Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
Text.filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isIgnoredC) (Text -> CI Text) -> Parser Text Text -> Parser Text (CI Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text -> Parser Text Text
forall a. Parser a -> Parser a
spaced ((Char -> Bool) -> Parser Text Text
Atto.takeWhile1 Char -> Bool
isUnitC)
      case CI Text
unit CI Text -> [CI Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Map (CI Text) Unit -> [CI Text]
forall k a. Map k a -> [k]
Map.keys Map (CI Text) Unit
unitAliasTable of
        Bool
True -> ParsedUnit -> Parser ParsedUnit
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParsedUnit -> Parser ParsedUnit)
-> ParsedUnit -> Parser ParsedUnit
forall a b. (a -> b) -> a -> b
$ CI Text -> ParsedUnit
ParsedUnit CI Text
unit
        Bool
False -> [Char] -> Parser ParsedUnit
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"No unit found"

nameP :: Atto.Parser ParsedIngredientName
nameP :: Parser ParsedIngredientName
nameP = CI Text -> ParsedIngredientName
ParsedIngredientName (CI Text -> ParsedIngredientName)
-> (Text -> CI Text) -> Text -> ParsedIngredientName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk (Text -> CI Text) -> (Text -> Text) -> Text -> CI Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.strip (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
Text.unwords ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
Text.strip ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
Text.words (Text -> ParsedIngredientName)
-> Parser Text Text -> Parser ParsedIngredientName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
Atto.takeText

ingredientP :: Atto.Parser ParsedIngredient
ingredientP :: Parser ParsedIngredient
ingredientP = (ParsedQuantity, ParsedUnit, ParsedIngredientName)
-> ParsedIngredient
mk ((ParsedQuantity, ParsedUnit, ParsedIngredientName)
 -> ParsedIngredient)
-> Parser Text (ParsedQuantity, ParsedUnit, ParsedIngredientName)
-> Parser ParsedIngredient
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,,) (ParsedQuantity
 -> ParsedUnit
 -> ParsedIngredientName
 -> (ParsedQuantity, ParsedUnit, ParsedIngredientName))
-> Parser ParsedQuantity
-> Parser
     Text
     (ParsedUnit
      -> ParsedIngredientName
      -> (ParsedQuantity, ParsedUnit, ParsedIngredientName))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ParsedQuantity
quantityP Parser
  Text
  (ParsedUnit
   -> ParsedIngredientName
   -> (ParsedQuantity, ParsedUnit, ParsedIngredientName))
-> Parser ParsedUnit
-> Parser
     Text
     (ParsedIngredientName
      -> (ParsedQuantity, ParsedUnit, ParsedIngredientName))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ParsedUnit
unitP Parser
  Text
  (ParsedIngredientName
   -> (ParsedQuantity, ParsedUnit, ParsedIngredientName))
-> Parser ParsedIngredientName
-> Parser Text (ParsedQuantity, ParsedUnit, ParsedIngredientName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ParsedIngredientName
nameP)
  where
    mk :: (ParsedQuantity, ParsedUnit, ParsedIngredientName)
-> ParsedIngredient
mk (ParsedQuantity
q, ParsedUnit
u, ParsedIngredientName
n) = ParsedIngredientName
-> ParsedQuantity -> ParsedUnit -> ParsedIngredient
ParsedIngredient ParsedIngredientName
n ParsedQuantity
q ParsedUnit
u

sanitize :: Text -> Text
sanitize :: Text -> Text
sanitize = Text -> Text
replacements (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
Text.filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isIgnoredC)
  where
    replacements :: Text -> Text
replacements Text
str = ((Text, Text) -> Text -> Text) -> Text -> [(Text, Text)] -> Text
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Text -> Text -> Text -> Text) -> (Text, Text) -> Text -> Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Text -> Text -> Text
Text.replace) Text
str
      [ (Text
"\194", Text
" ")
      , (Text
"\226\150\162", Text
"")
      ]
    isIgnoredC :: Char -> Bool
isIgnoredC Char
c = Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
c [Char
'▢', Char
'☐']

runParser :: Atto.Parser a -> Text -> Either String a
runParser :: Parser a -> Text -> Either [Char] a
runParser Parser a
parser Text
x = Parser a -> Text -> Either [Char] a
forall a. Parser a -> Text -> Either [Char] a
Atto.parseOnly Parser a
parser (Text -> Text
Text.strip (Text -> Text
sanitize Text
x))

-- |Parse scraped ingredients.
parseScrapedIngredients :: [ScrapedIngredient] -> Either Text [Ingredient]
parseScrapedIngredients :: [ScrapedIngredient] -> Either Text [Ingredient]
parseScrapedIngredients [ScrapedIngredient]
xs = ([Char] -> Text)
-> Either [Char] [Ingredient] -> Either Text [Ingredient]
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (Text -> [Char] -> Text
forall a b. a -> b -> a
const Text
"Failed to parse ingredients") (Either [Char] [Ingredient] -> Either Text [Ingredient])
-> ((ScrapedIngredient -> Either [Char] (Maybe ParsedIngredient))
    -> Either [Char] [Ingredient])
-> (ScrapedIngredient -> Either [Char] (Maybe ParsedIngredient))
-> Either Text [Ingredient]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Maybe ParsedIngredient] -> [Ingredient])
-> Either [Char] [Maybe ParsedIngredient]
-> Either [Char] [Ingredient]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Ingredient] -> [Ingredient]
forall a. Ord a => [a] -> [a]
nubOrd ([Ingredient] -> [Ingredient])
-> ([Maybe ParsedIngredient] -> [Ingredient])
-> [Maybe ParsedIngredient]
-> [Ingredient]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParsedIngredient -> Ingredient)
-> [ParsedIngredient] -> [Ingredient]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParsedIngredient -> Ingredient
scrubIngredient ([ParsedIngredient] -> [Ingredient])
-> ([Maybe ParsedIngredient] -> [ParsedIngredient])
-> [Maybe ParsedIngredient]
-> [Ingredient]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe ParsedIngredient] -> [ParsedIngredient]
forall a. [Maybe a] -> [a]
catMaybes) (Either [Char] [Maybe ParsedIngredient]
 -> Either [Char] [Ingredient])
-> ((ScrapedIngredient -> Either [Char] (Maybe ParsedIngredient))
    -> Either [Char] [Maybe ParsedIngredient])
-> (ScrapedIngredient -> Either [Char] (Maybe ParsedIngredient))
-> Either [Char] [Ingredient]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ScrapedIngredient]
-> (ScrapedIngredient -> Either [Char] (Maybe ParsedIngredient))
-> Either [Char] [Maybe ParsedIngredient]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [ScrapedIngredient]
xs ((ScrapedIngredient -> Either [Char] (Maybe ParsedIngredient))
 -> Either Text [Ingredient])
-> (ScrapedIngredient -> Either [Char] (Maybe ParsedIngredient))
-> Either Text [Ingredient]
forall a b. (a -> b) -> a -> b
$ \case
  ScrapedIngredient Text
raw | Text -> Bool
Text.null Text
raw -> Maybe ParsedIngredient -> Either [Char] (Maybe ParsedIngredient)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ParsedIngredient
forall a. Maybe a
Nothing
  ScrapedIngredient Text
raw -> ParsedIngredient -> Maybe ParsedIngredient
forall a. a -> Maybe a
Just (ParsedIngredient -> Maybe ParsedIngredient)
-> Either [Char] ParsedIngredient
-> Either [Char] (Maybe ParsedIngredient)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ParsedIngredient -> Text -> Either [Char] ParsedIngredient
forall a. Parser a -> Text -> Either [Char] a
runParser Parser ParsedIngredient
ingredientP Text
raw

-- |Parse raw ingredients, i.e. ones we know should be separated by newlines.
parseRawIngredients :: Text -> Either Text [Ingredient]
parseRawIngredients :: Text -> Either Text [Ingredient]
parseRawIngredients Text
content = do
  ([Char] -> Either Text [Ingredient])
-> ([ParsedIngredient] -> Either Text [Ingredient])
-> Either [Char] [ParsedIngredient]
-> Either Text [Ingredient]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either Text [Ingredient] -> [Char] -> Either Text [Ingredient]
forall a b. a -> b -> a
const (Either Text [Ingredient] -> [Char] -> Either Text [Ingredient])
-> Either Text [Ingredient] -> [Char] -> Either Text [Ingredient]
forall a b. (a -> b) -> a -> b
$ Text -> Either Text [Ingredient]
forall a b. a -> Either a b
Left Text
"Failed to parse ingredients") ([Ingredient] -> Either Text [Ingredient]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Ingredient] -> Either Text [Ingredient])
-> ([ParsedIngredient] -> [Ingredient])
-> [ParsedIngredient]
-> Either Text [Ingredient]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParsedIngredient -> Ingredient)
-> [ParsedIngredient] -> [Ingredient]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParsedIngredient -> Ingredient
scrubIngredient)
    (Either [Char] [ParsedIngredient] -> Either Text [Ingredient])
-> (Text -> Either [Char] [ParsedIngredient])
-> Text
-> Either Text [Ingredient]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Either [Char] ParsedIngredient)
-> [Text] -> Either [Char] [ParsedIngredient]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Parser ParsedIngredient -> Text -> Either [Char] ParsedIngredient
forall a. Parser a -> Text -> Either [Char] a
runParser Parser ParsedIngredient
ingredientP)
    ([Text] -> Either [Char] [ParsedIngredient])
-> (Text -> [Text]) -> Text -> Either [Char] [ParsedIngredient]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null)
    ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
Text.lines
    (Text -> Either Text [Ingredient])
-> Text -> Either Text [Ingredient]
forall a b. (a -> b) -> a -> b
$ Text
content

-- |Passive ingredient parser which separates on newlines.
mkIngredients :: Text -> [Ingredient]
mkIngredients :: Text -> [Ingredient]
mkIngredients =
  (Text -> Ingredient) -> [Text] -> [Ingredient]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
str -> IngredientName -> Quantity -> Maybe Unit -> Ingredient
Ingredient (CI Text -> IngredientName
IngredientName (Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk Text
str)) Quantity
emptyQuantity Maybe Unit
forall a. Maybe a
Nothing) ([Text] -> [Ingredient])
-> (Text -> [Text]) -> Text -> [Ingredient]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
Text.lines

-- |Parse scraped steps.
parseScrapedSteps :: [ScrapedStep] -> Either Text [Step]
parseScrapedSteps :: [ScrapedStep] -> Either Text [Step]
parseScrapedSteps = \case
  [ScrapedStep Text
single] | Text
"1." Text -> Text -> Bool
`Text.isPrefixOf` Text
single -> (((([Text], Int, [Step]) -> Either Text [Step])
  -> ([Text], Int, [Step]) -> Either Text [Step])
 -> ([Text], Int, [Step]) -> Either Text [Step])
-> ([Text], Int, [Step])
-> ((([Text], Int, [Step]) -> Either Text [Step])
    -> ([Text], Int, [Step]) -> Either Text [Step])
-> Either Text [Step]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((([Text], Int, [Step]) -> Either Text [Step])
 -> ([Text], Int, [Step]) -> Either Text [Step])
-> ([Text], Int, [Step]) -> Either Text [Step]
forall a. (a -> a) -> a
fix ((Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
Text.words (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
Text.drop Int
2 (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text
single, (Int
1 :: Int), []) (((([Text], Int, [Step]) -> Either Text [Step])
  -> ([Text], Int, [Step]) -> Either Text [Step])
 -> Either Text [Step])
-> ((([Text], Int, [Step]) -> Either Text [Step])
    -> ([Text], Int, [Step]) -> Either Text [Step])
-> Either Text [Step]
forall a b. (a -> b) -> a -> b
$ \([Text], Int, [Step]) -> Either Text [Step]
f -> \case
    ([], Int
_, [Step]
parsed) -> [Step] -> Either Text [Step]
forall a b. b -> Either a b
Right ([Step] -> Either Text [Step]) -> [Step] -> Either Text [Step]
forall a b. (a -> b) -> a -> b
$ [Step] -> [Step]
forall a. [a] -> [a]
reverse [Step]
parsed
    ([Text]
toParse, Int
ordinal, [Step]
parsed) ->
      let nextOrdinal :: Text
nextOrdinal = Int -> Text
forall a. Show a => a -> Text
tshow (Int
ordinal Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
          ([Text]
next, [Text]
rest) = (Text -> Bool) -> [Text] -> ([Text], [Text])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Bool
Text.isSuffixOf Text
nextOrdinal) [Text]
toParse
      in case [Text]
rest of
        Text
x:[Text]
xs -> case Text -> Text -> Maybe Text
Text.stripSuffix Text
nextOrdinal Text
x of
          Just Text
y -> ([Text], Int, [Step]) -> Either Text [Step]
f ([Text]
xs, Int
ordinal Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, (Text -> Step
Step ([Text] -> Text
Text.unwords ([Text]
next [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
y])))Step -> [Step] -> [Step]
forall a. a -> [a] -> [a]
:[Step]
parsed)
          Maybe Text
Nothing -> ([Text], Int, [Step]) -> Either Text [Step]
f ([Text]
xs, Int
ordinal Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, (Text -> Step
Step ([Text] -> Text
Text.unwords [Text]
next))Step -> [Step] -> [Step]
forall a. a -> [a] -> [a]
:[Step]
parsed)
        [] -> ([Text], Int, [Step]) -> Either Text [Step]
f ([], Int
ordinal Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, (Text -> Step
Step ([Text] -> Text
Text.unwords [Text]
next))Step -> [Step] -> [Step]
forall a. a -> [a] -> [a]
:[Step]
parsed)
  [ScrapedStep Text
single] -> [Step] -> Either Text [Step]
forall a b. b -> Either a b
Right ([Step] -> Either Text [Step]) -> [Step] -> Either Text [Step]
forall a b. (a -> b) -> a -> b
$ (Text -> Step) -> [Text] -> [Step]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Step
Step (Text -> Step) -> (Text -> Text) -> Text -> Step
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
Text.unwords ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
Text.words) ([Text] -> [Step]) -> (Text -> [Text]) -> Text -> [Step]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
Text.strip ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
Text.lines (Text -> [Step]) -> Text -> [Step]
forall a b. (a -> b) -> a -> b
$ Text
single
  [ScrapedStep]
xs -> [Step] -> Either Text [Step]
forall a b. b -> Either a b
Right ([Step] -> Either Text [Step]) -> [Step] -> Either Text [Step]
forall a b. (a -> b) -> a -> b
$ (ScrapedStep -> Step) -> [ScrapedStep] -> [Step]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(ScrapedStep Text
step) -> Text -> Step
Step (Text -> Step) -> (Text -> Text) -> Text -> Step
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
Text.unwords ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
Text.words (Text -> Step) -> Text -> Step
forall a b. (a -> b) -> a -> b
$ Text
step) [ScrapedStep]
xs