{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}

module Data.FuzzyTime.Parser
  ( fuzzyZonedTimeP,
    fuzzyLocalTimeP,
    fuzzyTimeOfDayP,
    atHourP,
    atMinuteP,
    atExactP,
    hourSegmentP,
    minuteSegmentP,
    twoDigitsSegmentP,
    fuzzyDayP,
    fuzzyDayOfTheWeekP,
    Parser,
  )
where

import Control.Monad (guard, msum, void)
import Data.Char as Char (toLower)
import Data.Fixed (Pico)
import Data.FuzzyTime.Types (DayOfWeek (Friday, Monday, Saturday, Sunday, Thursday, Tuesday, Wednesday), FuzzyDay (DayInMonth, DiffDays, DiffMonths, DiffWeeks, ExactDay, NextDayOfTheWeek, Now, OnlyDay, Today, Tomorrow, Yesterday), FuzzyLocalTime (FuzzyLocalTime), FuzzyTimeOfDay (AtExact, AtHour, AtMinute, Evening, HoursDiff, Midnight, MinutesDiff, Morning, Noon, SecondsDiff), FuzzyZonedTime (ZonedNow), Some (Both, One, Other))
import Data.List (elemIndex, find)
import Data.Maybe (fromMaybe, maybeToList)
import Data.Text (Text)
import Data.Time (TimeOfDay (TimeOfDay), defaultTimeLocale, parseTimeM)
import Data.Tree (Forest, Tree (Node), rootLabel, subForest)
import Data.Validity (isValid)
import Data.Void (Void)
import Text.Megaparsec (Parsec, empty, eof, label, oneOf, optional, some, try, (<|>))
import Text.Megaparsec.Char as Char (char, digitChar, letterChar, space1, string)
import Text.Megaparsec.Char.Lexer as Lexer (decimal)

type Parser = Parsec Void Text

fuzzyZonedTimeP :: Parser FuzzyZonedTime
fuzzyZonedTimeP :: Parser FuzzyZonedTime
fuzzyZonedTimeP = forall (f :: * -> *) a. Applicative f => a -> f a
pure FuzzyZonedTime
ZonedNow

fuzzyLocalTimeP :: Parser FuzzyLocalTime
fuzzyLocalTimeP :: Parser FuzzyLocalTime
fuzzyLocalTimeP = forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"FuzzyLocalTime" forall a b. (a -> b) -> a -> b
$ Some FuzzyDay FuzzyTimeOfDay -> FuzzyLocalTime
FuzzyLocalTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Parser a -> Parser b -> Parser (Some a b)
parseSome Parser FuzzyDay
fuzzyDayP Parser FuzzyTimeOfDay
fuzzyTimeOfDayP

-- | Note: Not composable
parseSome :: Parser a -> Parser b -> Parser (Some a b)
parseSome :: forall a b. Parser a -> Parser b -> Parser (Some a b)
parseSome Parser a
pa Parser b
pb =
  forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"Some" forall a b. (a -> b) -> a -> b
$
    forall a. [Parser a] -> Parser a
choice''
      [ do
          a
a <- Parser a
pa
          forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1
          b
b <- Parser b
pb
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> Some a b
Both a
a b
b,
        forall a b. a -> Some a b
One forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
pa,
        forall a b. b -> Some a b
Other forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser b
pb
      ]

fuzzyTimeOfDayP :: Parser FuzzyTimeOfDay
fuzzyTimeOfDayP :: Parser FuzzyTimeOfDay
fuzzyTimeOfDayP =
  forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"FuzzyTimeOfDay" forall a b. (a -> b) -> a -> b
$
    forall a. [Parser a] -> Parser a
choice'
      [ forall a. [(String, a)] -> Parser a
recTreeParser
          [ (String
"midnight", FuzzyTimeOfDay
Midnight),
            (String
"midday", FuzzyTimeOfDay
Noon),
            (String
"noon", FuzzyTimeOfDay
Noon),
            (String
"morning", FuzzyTimeOfDay
Morning),
            (String
"evening", FuzzyTimeOfDay
Evening)
          ],
        Parser FuzzyTimeOfDay
atExactP,
        Parser FuzzyTimeOfDay
atMinuteP,
        Parser FuzzyTimeOfDay
atHourP,
        Parser FuzzyTimeOfDay
diffP
      ]

atHourP :: Parser FuzzyTimeOfDay
atHourP :: Parser FuzzyTimeOfDay
atHourP =
  forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"AtHour" forall a b. (a -> b) -> a -> b
$ do
    Int
h <- Parser Int
hourSegmentP
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> FuzzyTimeOfDay
AtHour Int
h

atMinuteP :: Parser FuzzyTimeOfDay
atMinuteP :: Parser FuzzyTimeOfDay
atMinuteP =
  forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"AtMinute" forall a b. (a -> b) -> a -> b
$ do
    Int
h <- Parser Int
hourSegmentP
    Int
m <- Parser Int
minuteSegmentP
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> Int -> FuzzyTimeOfDay
AtMinute Int
h Int
m

atExactP :: Parser FuzzyTimeOfDay
atExactP :: Parser FuzzyTimeOfDay
atExactP =
  forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"AtExact" forall a b. (a -> b) -> a -> b
$ do
    Int
h <- Parser Int
hourSegmentP
    Int
m <- Parser Int
minuteSegmentP
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
':'
    Pico
s <- Parser Pico
readSimplePico
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ TimeOfDay -> FuzzyTimeOfDay
AtExact forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
h Int
m Pico
s

readSimplePico :: Parser Pico
readSimplePico :: Parser Pico
readSimplePico = do
  let d :: ParsecT Void Text Identity (Token Text)
d = forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf [Char
'0' .. Char
'9']
  String
beforeDot <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text Identity (Token Text)
d :: Parser String
  Maybe String
afterDot <-
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ do
      Char
dot <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'.'
      String
r <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text Identity (Token Text)
d
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Char
dot forall a. a -> [a] -> [a]
: String
r
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Read a => String -> a
read forall a b. (a -> b) -> a -> b
$ String
beforeDot forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a -> a
fromMaybe String
"" Maybe String
afterDot

diffP :: Parser FuzzyTimeOfDay
diffP :: Parser FuzzyTimeOfDay
diffP =
  forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"Diff" forall a b. (a -> b) -> a -> b
$ do
    Int
n <- forall a. Num a => Parser a -> Parser a
signed' forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
    Maybe Char
mc <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall a. [Parser a] -> Parser a
choice' [forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'h', forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'm', forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
's']
    Int -> FuzzyTimeOfDay
f <-
      case Maybe Char
mc of
        Maybe Char
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int -> FuzzyTimeOfDay
HoursDiff
        Just Char
'h' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int -> FuzzyTimeOfDay
HoursDiff
        Just Char
'm' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int -> FuzzyTimeOfDay
MinutesDiff
        Just Char
's' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (\Int
i -> Pico -> FuzzyTimeOfDay
SecondsDiff forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
        Maybe Char
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"should not happen."
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> FuzzyTimeOfDay
f Int
n

hourSegmentP :: Parser Int
hourSegmentP :: Parser Int
hourSegmentP =
  forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"hour segment" forall a b. (a -> b) -> a -> b
$ do
    Int
h <- Parser Int
twoDigitsSegmentP
    forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Int
h forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
h forall a. Ord a => a -> a -> Bool
< Int
24
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
':'
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
h

minuteSegmentP :: Parser Int
minuteSegmentP :: Parser Int
minuteSegmentP =
  forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"minute segment" forall a b. (a -> b) -> a -> b
$ do
    Int
m <- Parser Int
twoDigitsSegmentP
    forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Int
m forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
m forall a. Ord a => a -> a -> Bool
< Int
60
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
m

twoDigitsSegmentP :: Parser Int
twoDigitsSegmentP :: Parser Int
twoDigitsSegmentP =
  forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"two digit segment" forall a b. (a -> b) -> a -> b
$ do
    Int
d1 <- Parser Int
digit
    Maybe Int
md2 <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Int
digit
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
      case Maybe Int
md2 of
        Maybe Int
Nothing -> Int
d1
        Just Int
d2 -> Int
10 forall a. Num a => a -> a -> a
* Int
d1 forall a. Num a => a -> a -> a
+ Int
d2

digit :: Parser Int
digit :: Parser Int
digit =
  forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"digit" forall a b. (a -> b) -> a -> b
$ do
    let l :: String
l = [Char
'0' .. Char
'9']
    Char
c <- forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf String
l
    case forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Char
c String
l of
      Maybe Int
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Shouldn't happen."
      Just Int
d -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
d

-- | Can handle:
--
-- - yesterday
-- - now
-- - today
-- - tomorrow
-- - "%Y-%m-%d"
--
-- and all non-ambiguous prefixes
fuzzyDayP :: Parser FuzzyDay
fuzzyDayP :: Parser FuzzyDay
fuzzyDayP =
  forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"FuzzyDay" forall a b. (a -> b) -> a -> b
$
    forall a. [Parser a] -> Parser a
choice'
      [ forall a. [(String, a)] -> Parser a
recTreeParser
          [(String
"yesterday", FuzzyDay
Yesterday), (String
"now", FuzzyDay
Now), (String
"today", FuzzyDay
Today), (String
"tomorrow", FuzzyDay
Tomorrow)],
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Day -> FuzzyDay
ExactDay (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'-') forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
"%Y-%m-%d"),
        Parser FuzzyDay
dayInMonthP,
        Parser FuzzyDay
dayOfTheMonthP,
        DayOfWeek -> FuzzyDay
NextDayOfTheWeek forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DayOfWeek
fuzzyDayOfTheWeekP,
        Parser FuzzyDay
diffDayP
      ]

dayOfTheMonthP :: Parser FuzzyDay
dayOfTheMonthP :: Parser FuzzyDay
dayOfTheMonthP = do
  FuzzyDay
v <- Int -> FuzzyDay
OnlyDay forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
twoDigitsSegmentP
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall a. Validity a => a -> Bool
isValid FuzzyDay
v
  forall (f :: * -> *) a. Applicative f => a -> f a
pure FuzzyDay
v

dayInMonthP :: Parser FuzzyDay
dayInMonthP :: Parser FuzzyDay
dayInMonthP = do
  Int
m <- Parser Int
twoDigitsSegmentP
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
m forall a. Ord a => a -> a -> Bool
>= Int
1)
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
m forall a. Ord a => a -> a -> Bool
<= Int
12)
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"-"
  Int
d <- Parser Int
twoDigitsSegmentP
  let v :: FuzzyDay
v = Int -> Int -> FuzzyDay
DayInMonth Int
m Int
d
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall a. Validity a => a -> Bool
isValid FuzzyDay
v
  forall (f :: * -> *) a. Applicative f => a -> f a
pure FuzzyDay
v

diffDayP :: Parser FuzzyDay
diffDayP :: Parser FuzzyDay
diffDayP = do
  Int16
d <- forall a. Num a => Parser a -> Parser a
signed' forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
  Maybe Char
mc <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf [Char
'd', Char
'w', Char
'm']
  let f :: Int16 -> FuzzyDay
f =
        case Maybe Char
mc of
          Maybe Char
Nothing -> Int16 -> FuzzyDay
DiffDays
          Just Char
'd' -> Int16 -> FuzzyDay
DiffDays
          Just Char
'w' -> Int16 -> FuzzyDay
DiffWeeks
          Just Char
'm' -> Int16 -> FuzzyDay
DiffMonths
          Maybe Char
_ -> Int16 -> FuzzyDay
DiffDays -- Should not happen.
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int16 -> FuzzyDay
f Int16
d

-- | Can handle:
--
-- - monday
-- - tuesday
-- - wednesday
-- - thursday
-- - friday
-- - saturday
-- - sunday
--
-- and all non-ambiguous prefixes
fuzzyDayOfTheWeekP :: Parser DayOfWeek
fuzzyDayOfTheWeekP :: Parser DayOfWeek
fuzzyDayOfTheWeekP =
  forall a. [(String, a)] -> Parser a
recTreeParser
    [ (String
"monday", DayOfWeek
Monday),
      (String
"tuesday", DayOfWeek
Tuesday),
      (String
"wednesday", DayOfWeek
Wednesday),
      (String
"thursday", DayOfWeek
Thursday),
      (String
"friday", DayOfWeek
Friday),
      (String
"saturday", DayOfWeek
Saturday),
      (String
"sunday", DayOfWeek
Sunday)
    ]

recTreeParser :: [(String, a)] -> Parser a
recTreeParser :: forall a. [(String, a)] -> Parser a
recTreeParser [(String, a)]
tups = do
  let pf :: Forest (Char, Maybe a)
pf = forall c a. Eq c => [([c], a)] -> Forest (c, Maybe a)
makeParseForest [(String, a)]
tups
  String
s <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
letterChar
  case forall a. String -> Forest (Char, Maybe a) -> Maybe a
lookupInParseForest String
s Forest (Char, Maybe a)
pf of
    Maybe a
Nothing ->
      forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Could not parse any of these recursively unambiguously: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(String, a)]
tups)
    Just a
f -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
f

lookupInParseForest :: [Char] -> Forest (Char, Maybe a) -> Maybe a
lookupInParseForest :: forall a. String -> Forest (Char, Maybe a) -> Maybe a
lookupInParseForest = forall a. String -> Forest (Char, Maybe a) -> Maybe a
gof
  where
    gof :: [Char] -> Forest (Char, Maybe a) -> Maybe a
    gof :: forall a. String -> Forest (Char, Maybe a) -> Maybe a
gof String
cs = forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. String -> Tree (Char, Maybe a) -> Maybe a
got String
cs)
    got :: [Char] -> Tree (Char, Maybe a) -> Maybe a
    got :: forall a. String -> Tree (Char, Maybe a) -> Maybe a
got [] Tree (Char, Maybe a)
_ = forall a. Maybe a
Nothing
    got (Char
c : String
cs) Node {[Tree (Char, Maybe a)]
(Char, Maybe a)
subForest :: [Tree (Char, Maybe a)]
rootLabel :: (Char, Maybe a)
subForest :: forall a. Tree a -> [Tree a]
rootLabel :: forall a. Tree a -> a
..} =
      let (Char
tc, Maybe a
tma) = (Char, Maybe a)
rootLabel
       in if Char -> Char
Char.toLower Char
tc forall a. Eq a => a -> a -> Bool
== Char -> Char
Char.toLower Char
c
            then case String
cs of
              [] -> Maybe a
tma
              String
_ -> forall a. String -> Forest (Char, Maybe a) -> Maybe a
gof String
cs [Tree (Char, Maybe a)]
subForest
            else forall a. Maybe a
Nothing

makeParseForest :: Eq c => [([c], a)] -> Forest (c, Maybe a)
makeParseForest :: forall c a. Eq c => [([c], a)] -> Forest (c, Maybe a)
makeParseForest = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall c a.
Eq c =>
Forest (c, Maybe a) -> ([c], a) -> Forest (c, Maybe a)
insertf []
  where
    insertf :: Eq c => Forest (c, Maybe a) -> ([c], a) -> Forest (c, Maybe a)
    insertf :: forall c a.
Eq c =>
Forest (c, Maybe a) -> ([c], a) -> Forest (c, Maybe a)
insertf Forest (c, Maybe a)
for ([], a
_) = Forest (c, Maybe a)
for
    insertf Forest (c, Maybe a)
for (c
c : [c]
cs, a
a) =
      case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== c
c) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Tree a -> a
rootLabel) Forest (c, Maybe a)
for of
        Maybe (Tree (c, Maybe a))
Nothing ->
          let got :: [c] -> Maybe (Tree (c, Maybe a))
got [] = forall a. Maybe a
Nothing
              got (c
c_ : [c]
cs_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> [Tree a] -> Tree a
Node (c
c_, forall a. a -> Maybe a
Just a
a) forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ [c] -> Maybe (Tree (c, Maybe a))
got [c]
cs_
           in case [c] -> Maybe (Tree (c, Maybe a))
got (c
c forall a. a -> [a] -> [a]
: [c]
cs) of
                Maybe (Tree (c, Maybe a))
Nothing -> Forest (c, Maybe a)
for -- Should not happen, but is fine
                Just Tree (c, Maybe a)
t -> Tree (c, Maybe a)
t forall a. a -> [a] -> [a]
: Forest (c, Maybe a)
for
        Just Tree (c, Maybe a)
n ->
          forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map Forest (c, Maybe a)
for forall a b. (a -> b) -> a -> b
$ \Tree (c, Maybe a)
t ->
            let (c
tc, Maybe a
_) = forall a. Tree a -> a
rootLabel Tree (c, Maybe a)
t
             in if c
tc forall a. Eq a => a -> a -> Bool
== c
c
                  then Tree (c, Maybe a)
n {rootLabel :: (c, Maybe a)
rootLabel = (c
tc, forall a. Maybe a
Nothing), subForest :: Forest (c, Maybe a)
subForest = forall c a.
Eq c =>
Forest (c, Maybe a) -> ([c], a) -> Forest (c, Maybe a)
insertf (forall a. Tree a -> [Tree a]
subForest Tree (c, Maybe a)
n) ([c]
cs, a
a)}
                  else Tree (c, Maybe a)
t

signed' :: Num a => Parser a -> Parser a
signed' :: forall a. Num a => Parser a -> Parser a
signed' Parser a
p = ParsecT Void Text Identity (a -> a)
sign forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
p
  where
    sign :: ParsecT Void Text Identity (a -> a)
sign = (forall a. a -> a
id forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'+') forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall a. Num a => a -> a
negate forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'-')

choice' :: [Parser a] -> Parser a
choice' :: forall a. [Parser a] -> Parser a
choice' [] = forall (f :: * -> *) a. Alternative f => f a
empty
choice' [Parser a
x] = Parser a
x
choice' (Parser a
a : [Parser a]
as) = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser a
a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. [Parser a] -> Parser a
choice' [Parser a]
as

choice'' :: [Parser a] -> Parser a
choice'' :: forall a. [Parser a] -> Parser a
choice'' = forall a. [Parser a] -> Parser a
choice' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
eof)