{-# LANGUAGE CPP #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE ViewPatterns #-}
module XMonad.Prompt.OrgMode (
orgPrompt,
orgPromptRefile,
orgPromptRefileTo,
orgPromptPrimary,
ClipboardSupport (..),
OrgMode,
#ifdef TESTING
pInput,
Note (..),
Priority (..),
Date (..),
Time (..),
TimeOfDay (..),
OrgTime (..),
DayOfWeek (..),
#endif
) where
import XMonad.Prelude
import XMonad (X, io, whenJust)
import XMonad.Prompt (XPConfig, XPrompt (showXPrompt), mkXPromptWithReturn, mkComplFunFromList, ComplFunction)
import XMonad.Util.Parser
import XMonad.Util.XSelection (getSelection)
import XMonad.Util.Run
import Control.DeepSeq (deepseq)
import qualified Data.List.NonEmpty as NE (head)
import Data.Time (Day (ModifiedJulianDay), NominalDiffTime, UTCTime (utctDay), addUTCTime, fromGregorian, getCurrentTime, nominalDay, toGregorian)
#if MIN_VERSION_time(1, 9, 0)
import Data.Time.Format.ISO8601 (iso8601Show)
#else
import Data.Time.Format (defaultTimeLocale, formatTime, iso8601DateFormat)
#endif
import GHC.Natural (Natural)
import System.IO (IOMode (AppendMode, ReadMode), hClose, hGetContents, openFile, withFile)
data OrgMode = OrgMode
{ OrgMode -> ClipboardSupport
clpSupport :: ClipboardSupport
, :: String
, OrgMode -> [Char]
orgFile :: FilePath
}
mkOrgCfg :: ClipboardSupport -> String -> FilePath -> X OrgMode
mkOrgCfg :: ClipboardSupport -> [Char] -> [Char] -> X OrgMode
mkOrgCfg ClipboardSupport
clp [Char]
header [Char]
fp = ClipboardSupport -> [Char] -> [Char] -> OrgMode
OrgMode ClipboardSupport
clp [Char]
header forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadIO m => [Char] -> m [Char]
mkAbsolutePath [Char]
fp
data ClipboardSupport
= PrimarySelection
| NoClpSupport
data Clp
= String
| Body String
instance XPrompt OrgMode where
showXPrompt :: OrgMode -> String
showXPrompt :: OrgMode -> [Char]
showXPrompt OrgMode{ [Char]
todoHeader :: [Char]
todoHeader :: OrgMode -> [Char]
todoHeader, [Char]
orgFile :: [Char]
orgFile :: OrgMode -> [Char]
orgFile, ClipboardSupport
clpSupport :: ClipboardSupport
clpSupport :: OrgMode -> ClipboardSupport
clpSupport } =
forall a. Monoid a => [a] -> a
mconcat [[Char]
"Add ", [Char]
todoHeader, [Char]
clp, [Char]
" to ", [Char]
orgFile, [Char]
": "]
where
[Char]
clp :: String = case ClipboardSupport
clpSupport of
ClipboardSupport
NoClpSupport -> [Char]
""
ClipboardSupport
PrimarySelection -> [Char]
" + PS"
orgPrompt
:: XPConfig
-> String
-> FilePath
-> X ()
orgPrompt :: XPConfig -> [Char] -> [Char] -> X ()
orgPrompt XPConfig
xpc = (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPConfig -> OrgMode -> X Bool
mkOrgPrompt XPConfig
xpc forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) forall a b c d. (a -> b) -> (c -> d -> a) -> c -> d -> b
.: ClipboardSupport -> [Char] -> [Char] -> X OrgMode
mkOrgCfg ClipboardSupport
NoClpSupport
orgPromptPrimary :: XPConfig -> String -> FilePath -> X ()
orgPromptPrimary :: XPConfig -> [Char] -> [Char] -> X ()
orgPromptPrimary XPConfig
xpc = (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPConfig -> OrgMode -> X Bool
mkOrgPrompt XPConfig
xpc forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) forall a b c d. (a -> b) -> (c -> d -> a) -> c -> d -> b
.: ClipboardSupport -> [Char] -> [Char] -> X OrgMode
mkOrgCfg ClipboardSupport
PrimarySelection
data RefilePrompt = Refile
instance XPrompt RefilePrompt where
showXPrompt :: RefilePrompt -> String
showXPrompt :: RefilePrompt -> [Char]
showXPrompt RefilePrompt
Refile = [Char]
"Refile note to: "
orgPromptRefile :: XPConfig -> String -> FilePath -> X ()
orgPromptRefile :: XPConfig -> [Char] -> [Char] -> X ()
orgPromptRefile XPConfig
xpc [Char]
str [Char]
fp = do
OrgMode
orgCfg <- ClipboardSupport -> [Char] -> [Char] -> X OrgMode
mkOrgCfg ClipboardSupport
NoClpSupport [Char]
str [Char]
fp
[Char]
fileContents <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ do
Handle
handle <- [Char] -> IOMode -> IO Handle
openFile (OrgMode -> [Char]
orgFile OrgMode
orgCfg) IOMode
ReadMode
[Char]
contents <- Handle -> IO [Char]
hGetContents Handle
handle
[Char]
contents forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ([Char]
contents forall a b. NFData a => a -> b -> b
`deepseq` Handle -> IO ()
hClose Handle
handle)
Bool
notCancelled <- XPConfig -> OrgMode -> X Bool
mkOrgPrompt XPConfig
xpc OrgMode
orgCfg
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
notCancelled forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust (forall a. Parser a -> [Char] -> Maybe a
runParser Parser [Heading]
pOrgFile [Char]
fileContents) forall a b. (a -> b) -> a -> b
$ \[Heading]
headings ->
forall p a.
XPrompt p =>
p -> XPConfig -> ComplFunction -> ([Char] -> X a) -> X (Maybe a)
mkXPromptWithReturn RefilePrompt
Refile XPConfig
xpc ([Heading] -> ComplFunction
completeHeadings [Heading]
headings) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe [Char]
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just [Char]
parent -> [Char] -> [Char] -> X ()
refile [Char]
parent (OrgMode -> [Char]
orgFile OrgMode
orgCfg)
where
completeHeadings :: [Heading] -> ComplFunction
completeHeadings :: [Heading] -> ComplFunction
completeHeadings = XPConfig -> [[Char]] -> ComplFunction
mkComplFunFromList XPConfig
xpc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Heading -> [Char]
headingText
orgPromptRefileTo
:: XPConfig
-> String
-> String
-> FilePath
-> X ()
orgPromptRefileTo :: XPConfig -> [Char] -> [Char] -> [Char] -> X ()
orgPromptRefileTo XPConfig
xpc [Char]
refileHeading [Char]
str [Char]
fp = do
OrgMode
orgCfg <- ClipboardSupport -> [Char] -> [Char] -> X OrgMode
mkOrgCfg ClipboardSupport
NoClpSupport [Char]
str [Char]
fp
Bool
notCancelled <- XPConfig -> OrgMode -> X Bool
mkOrgPrompt XPConfig
xpc OrgMode
orgCfg
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
notCancelled forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> X ()
refile [Char]
refileHeading (OrgMode -> [Char]
orgFile OrgMode
orgCfg)
mkOrgPrompt :: XPConfig -> OrgMode -> X Bool
mkOrgPrompt :: XPConfig -> OrgMode -> X Bool
mkOrgPrompt XPConfig
xpc oc :: OrgMode
oc@OrgMode{ [Char]
todoHeader :: [Char]
todoHeader :: OrgMode -> [Char]
todoHeader, [Char]
orgFile :: [Char]
orgFile :: OrgMode -> [Char]
orgFile, ClipboardSupport
clpSupport :: ClipboardSupport
clpSupport :: OrgMode -> ClipboardSupport
clpSupport } =
forall a. Maybe a -> Bool
isJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall p a.
XPrompt p =>
p -> XPConfig -> ComplFunction -> ([Char] -> X a) -> X (Maybe a)
mkXPromptWithReturn OrgMode
oc XPConfig
xpc (forall a b. a -> b -> a
const (forall (f :: * -> *) a. Applicative f => a -> f a
pure [])) [Char] -> X ()
appendNote
where
appendNote :: String -> X ()
appendNote :: [Char] -> X ()
appendNote [Char]
input = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ do
Clp
clpStr <- case ClipboardSupport
clpSupport of
ClipboardSupport
NoClpSupport -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Char] -> Clp
Body [Char]
""
ClipboardSupport
PrimarySelection -> do
[Char]
sel <- forall (m :: * -> *). MonadIO m => m [Char]
getSelection
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
sel) [[Char]
"http://", [Char]
"https://"]
then [Char] -> Clp
Header [Char]
sel
else [Char] -> Clp
Body forall a b. (a -> b) -> a -> b
$ [Char]
"\n " forall a. Semigroup a => a -> a -> a
<> [Char]
sel
forall r. [Char] -> IOMode -> (Handle -> IO r) -> IO r
withFile [Char]
orgFile IOMode
AppendMode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip Handle -> [Char] -> IO ()
hPutStrLn
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
"") (Clp -> [Char] -> Note -> IO [Char]
ppNote Clp
clpStr [Char]
todoHeader) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Maybe Note
pInput
forall a b. (a -> b) -> a -> b
$ [Char]
input
refile :: String -> FilePath -> X ()
refile :: [Char] -> [Char] -> X ()
refile ([Char] -> [Char]
asString -> [Char]
parent) ([Char] -> [Char]
asString -> [Char]
fp) =
X ([Char] -> [Char]) -> X ()
proc forall a b. (a -> b) -> a -> b
$ X ([Char] -> [Char])
inEmacs
X ([Char] -> [Char])
-> X ([Char] -> [Char]) -> X ([Char] -> [Char])
>-> X ([Char] -> [Char])
asBatch
X ([Char] -> [Char])
-> X ([Char] -> [Char]) -> X ([Char] -> [Char])
>-> [Char] -> X ([Char] -> [Char])
eval ([[Char]] -> [Char]
progn [ [Char]
"find-file" forall a. Semigroup a => a -> a -> a
<> [Char]
fp
, [Char]
"end-of-buffer"
, [Char]
"org-refile nil nil"
forall a. Semigroup a => a -> a -> a
<> [[Char]] -> [Char]
list [ [Char]
parent
, [Char]
fp
, [Char]
"nil"
, [[Char]] -> [Char]
saveExcursion [[Char]
"org-find-exact-headline-in-buffer"
forall a. Semigroup a => a -> a -> a
<> [Char]
parent]
]
, [Char]
"save-buffer"
])
data Time = Time
{ Time -> Date
date :: Date
, Time -> Maybe OrgTime
tod :: Maybe OrgTime
}
deriving (Time -> Time -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Time -> Time -> Bool
$c/= :: Time -> Time -> Bool
== :: Time -> Time -> Bool
$c== :: Time -> Time -> Bool
Eq, Int -> Time -> [Char] -> [Char]
[Time] -> [Char] -> [Char]
Time -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [Time] -> [Char] -> [Char]
$cshowList :: [Time] -> [Char] -> [Char]
show :: Time -> [Char]
$cshow :: Time -> [Char]
showsPrec :: Int -> Time -> [Char] -> [Char]
$cshowsPrec :: Int -> Time -> [Char] -> [Char]
Show)
data TimeOfDay = HHMM Int Int
deriving (TimeOfDay -> TimeOfDay -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeOfDay -> TimeOfDay -> Bool
$c/= :: TimeOfDay -> TimeOfDay -> Bool
== :: TimeOfDay -> TimeOfDay -> Bool
$c== :: TimeOfDay -> TimeOfDay -> Bool
Eq)
instance Show TimeOfDay where
show :: TimeOfDay -> String
show :: TimeOfDay -> [Char]
show (HHMM Int
h Int
m) = Int -> [Char]
pad Int
h forall a. Semigroup a => a -> a -> a
<> [Char]
":" forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
pad Int
m
where
pad :: Int -> String
pad :: Int -> [Char]
pad Int
n = (if Int
n forall a. Ord a => a -> a -> Bool
<= Int
9 then [Char]
"0" else [Char]
"") forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Int
n
data OrgTime = MomentInTime TimeOfDay | TimeSpan TimeOfDay TimeOfDay
deriving (OrgTime -> OrgTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrgTime -> OrgTime -> Bool
$c/= :: OrgTime -> OrgTime -> Bool
== :: OrgTime -> OrgTime -> Bool
$c== :: OrgTime -> OrgTime -> Bool
Eq)
instance Show OrgTime where
show :: OrgTime -> String
show :: OrgTime -> [Char]
show (MomentInTime TimeOfDay
tod) = forall a. Show a => a -> [Char]
show TimeOfDay
tod
show (TimeSpan TimeOfDay
tod TimeOfDay
tod') = forall a. Show a => a -> [Char]
show TimeOfDay
tod forall a. Semigroup a => a -> a -> a
<> [Char]
"-" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show TimeOfDay
tod'
data Date
= Today
| Tomorrow
| Next DayOfWeek
| Date (Int, Maybe Int, Maybe Integer)
deriving (Date -> Date -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Date -> Date -> Bool
$c/= :: Date -> Date -> Bool
== :: Date -> Date -> Bool
$c== :: Date -> Date -> Bool
Eq, Eq Date
Date -> Date -> Bool
Date -> Date -> Ordering
Date -> Date -> Date
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Date -> Date -> Date
$cmin :: Date -> Date -> Date
max :: Date -> Date -> Date
$cmax :: Date -> Date -> Date
>= :: Date -> Date -> Bool
$c>= :: Date -> Date -> Bool
> :: Date -> Date -> Bool
$c> :: Date -> Date -> Bool
<= :: Date -> Date -> Bool
$c<= :: Date -> Date -> Bool
< :: Date -> Date -> Bool
$c< :: Date -> Date -> Bool
compare :: Date -> Date -> Ordering
$ccompare :: Date -> Date -> Ordering
Ord, Int -> Date -> [Char] -> [Char]
[Date] -> [Char] -> [Char]
Date -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [Date] -> [Char] -> [Char]
$cshowList :: [Date] -> [Char] -> [Char]
show :: Date -> [Char]
$cshow :: Date -> [Char]
showsPrec :: Int -> Date -> [Char] -> [Char]
$cshowsPrec :: Int -> Date -> [Char] -> [Char]
Show)
toOrgFmt :: Maybe OrgTime -> Day -> String
toOrgFmt :: Maybe OrgTime -> Day -> [Char]
toOrgFmt Maybe OrgTime
tod Day
day =
forall a. Monoid a => [a] -> a
mconcat [[Char]
"<", [Char]
isoDay, [Char]
" ", forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show (Day -> DayOfWeek
dayOfWeek Day
day), [Char]
time, [Char]
">"]
where
[Char]
time :: String = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" ((Char
' ' forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) Maybe OrgTime
tod
#if MIN_VERSION_time(1, 9, 0)
[Char]
isoDay :: String = forall t. ISO8601 t => t -> [Char]
iso8601Show Day
day
#else
isoDay :: String = formatTime defaultTimeLocale (iso8601DateFormat Nothing) day
#endif
ppDate :: Time -> IO String
ppDate :: Time -> IO [Char]
ppDate Time{ Date
date :: Date
date :: Time -> Date
date, Maybe OrgTime
tod :: Maybe OrgTime
tod :: Time -> Maybe OrgTime
tod } = do
UTCTime
curTime <- IO UTCTime
getCurrentTime
let curDay :: Day
curDay = UTCTime -> Day
utctDay UTCTime
curTime
(Integer
y, Int
m, Int
_) = Day -> (Integer, Int, Int)
toGregorian Day
curDay
diffToDay :: DayOfWeek -> NominalDiffTime
diffToDay DayOfWeek
d = DayOfWeek -> DayOfWeek -> NominalDiffTime
diffBetween DayOfWeek
d (Day -> DayOfWeek
dayOfWeek Day
curDay)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe OrgTime -> Day -> [Char]
toOrgFmt Maybe OrgTime
tod forall a b. (a -> b) -> a -> b
$ case Date
date of
Date
Today -> Day
curDay
Date
Tomorrow -> UTCTime -> Day
utctDay forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> UTCTime -> UTCTime
addDays NominalDiffTime
1 UTCTime
curTime
Next DayOfWeek
wday -> UTCTime -> Day
utctDay forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> UTCTime -> UTCTime
addDays (DayOfWeek -> NominalDiffTime
diffToDay DayOfWeek
wday) UTCTime
curTime
Date (Int
d, Maybe Int
mbM, Maybe Integer
mbY) -> Integer -> Int -> Int -> Day
fromGregorian (forall a. a -> Maybe a -> a
fromMaybe Integer
y Maybe Integer
mbY) (forall a. a -> Maybe a -> a
fromMaybe Int
m Maybe Int
mbM) Int
d
where
NominalDiffTime -> UTCTime -> UTCTime
addDays :: NominalDiffTime -> UTCTime -> UTCTime
= NominalDiffTime -> UTCTime -> UTCTime
addUTCTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* NominalDiffTime
nominalDay)
diffBetween :: DayOfWeek -> DayOfWeek -> NominalDiffTime
diffBetween :: DayOfWeek -> DayOfWeek -> NominalDiffTime
diffBetween DayOfWeek
d DayOfWeek
cur
| DayOfWeek
d forall a. Eq a => a -> a -> Bool
== DayOfWeek
cur = NominalDiffTime
7
| Bool
otherwise = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a
abs forall a b. (a -> b) -> a -> b
$ (forall a. Enum a => a -> Int
fromEnum DayOfWeek
d forall a. Num a => a -> a -> a
- forall a. Enum a => a -> Int
fromEnum DayOfWeek
cur) forall a. Integral a => a -> a -> a
`mod` Int
7
dayOfWeek :: Day -> DayOfWeek
dayOfWeek :: Day -> DayOfWeek
dayOfWeek (ModifiedJulianDay Integer
d) = forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger forall a b. (a -> b) -> a -> b
$ Integer
d forall a. Num a => a -> a -> a
+ Integer
3
data DayOfWeek
= Monday | Tuesday | Wednesday | Thursday | Friday | Saturday | Sunday
deriving (DayOfWeek -> DayOfWeek -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DayOfWeek -> DayOfWeek -> Bool
$c/= :: DayOfWeek -> DayOfWeek -> Bool
== :: DayOfWeek -> DayOfWeek -> Bool
$c== :: DayOfWeek -> DayOfWeek -> Bool
Eq, Eq DayOfWeek
DayOfWeek -> DayOfWeek -> Bool
DayOfWeek -> DayOfWeek -> Ordering
DayOfWeek -> DayOfWeek -> DayOfWeek
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DayOfWeek -> DayOfWeek -> DayOfWeek
$cmin :: DayOfWeek -> DayOfWeek -> DayOfWeek
max :: DayOfWeek -> DayOfWeek -> DayOfWeek
$cmax :: DayOfWeek -> DayOfWeek -> DayOfWeek
>= :: DayOfWeek -> DayOfWeek -> Bool
$c>= :: DayOfWeek -> DayOfWeek -> Bool
> :: DayOfWeek -> DayOfWeek -> Bool
$c> :: DayOfWeek -> DayOfWeek -> Bool
<= :: DayOfWeek -> DayOfWeek -> Bool
$c<= :: DayOfWeek -> DayOfWeek -> Bool
< :: DayOfWeek -> DayOfWeek -> Bool
$c< :: DayOfWeek -> DayOfWeek -> Bool
compare :: DayOfWeek -> DayOfWeek -> Ordering
$ccompare :: DayOfWeek -> DayOfWeek -> Ordering
Ord, Int -> DayOfWeek -> [Char] -> [Char]
[DayOfWeek] -> [Char] -> [Char]
DayOfWeek -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [DayOfWeek] -> [Char] -> [Char]
$cshowList :: [DayOfWeek] -> [Char] -> [Char]
show :: DayOfWeek -> [Char]
$cshow :: DayOfWeek -> [Char]
showsPrec :: Int -> DayOfWeek -> [Char] -> [Char]
$cshowsPrec :: Int -> DayOfWeek -> [Char] -> [Char]
Show)
instance Enum DayOfWeek where
toEnum :: Int -> DayOfWeek
toEnum :: Int -> DayOfWeek
toEnum Int
i = case forall a. Integral a => a -> a -> a
mod Int
i Int
7 of
Int
0 -> DayOfWeek
Sunday
Int
1 -> DayOfWeek
Monday
Int
2 -> DayOfWeek
Tuesday
Int
3 -> DayOfWeek
Wednesday
Int
4 -> DayOfWeek
Thursday
Int
5 -> DayOfWeek
Friday
Int
_ -> DayOfWeek
Saturday
fromEnum :: DayOfWeek -> Int
fromEnum :: DayOfWeek -> Int
fromEnum = \case
DayOfWeek
Monday -> Int
1
DayOfWeek
Tuesday -> Int
2
DayOfWeek
Wednesday -> Int
3
DayOfWeek
Thursday -> Int
4
DayOfWeek
Friday -> Int
5
DayOfWeek
Saturday -> Int
6
DayOfWeek
Sunday -> Int
7
data Note
= Scheduled String Time Priority
| Deadline String Time Priority
| NormalMsg String Priority
deriving (Note -> Note -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Note -> Note -> Bool
$c/= :: Note -> Note -> Bool
== :: Note -> Note -> Bool
$c== :: Note -> Note -> Bool
Eq, Int -> Note -> [Char] -> [Char]
[Note] -> [Char] -> [Char]
Note -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [Note] -> [Char] -> [Char]
$cshowList :: [Note] -> [Char] -> [Char]
show :: Note -> [Char]
$cshow :: Note -> [Char]
showsPrec :: Int -> Note -> [Char] -> [Char]
$cshowsPrec :: Int -> Note -> [Char] -> [Char]
Show)
data Priority = A | B | C | NoPriority
deriving (Priority -> Priority -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Priority -> Priority -> Bool
$c/= :: Priority -> Priority -> Bool
== :: Priority -> Priority -> Bool
$c== :: Priority -> Priority -> Bool
Eq, Int -> Priority -> [Char] -> [Char]
[Priority] -> [Char] -> [Char]
Priority -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [Priority] -> [Char] -> [Char]
$cshowList :: [Priority] -> [Char] -> [Char]
show :: Priority -> [Char]
$cshow :: Priority -> [Char]
showsPrec :: Int -> Priority -> [Char] -> [Char]
$cshowsPrec :: Int -> Priority -> [Char] -> [Char]
Show)
ppNote :: Clp -> String -> Note -> IO String
ppNote :: Clp -> [Char] -> Note -> IO [Char]
ppNote Clp
clp [Char]
todo = \case
Scheduled [Char]
str Time
time Priority
prio -> [Char] -> [Char] -> Maybe Time -> Priority -> IO [Char]
mkLine [Char]
str [Char]
"SCHEDULED: " (forall a. a -> Maybe a
Just Time
time) Priority
prio
Deadline [Char]
str Time
time Priority
prio -> [Char] -> [Char] -> Maybe Time -> Priority -> IO [Char]
mkLine [Char]
str [Char]
"DEADLINE: " (forall a. a -> Maybe a
Just Time
time) Priority
prio
NormalMsg [Char]
str Priority
prio -> [Char] -> [Char] -> Maybe Time -> Priority -> IO [Char]
mkLine [Char]
str [Char]
"" forall a. Maybe a
Nothing Priority
prio
where
mkLine :: String -> String -> Maybe Time -> Priority -> IO String
mkLine :: [Char] -> [Char] -> Maybe Time -> Priority -> IO [Char]
mkLine [Char]
str [Char]
sched Maybe Time
time Priority
prio = do
[Char]
t <- case Maybe Time
time of
Maybe Time
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
""
Just Time
ti -> (([Char]
"\n " forall a. Semigroup a => a -> a -> a
<> [Char]
sched) forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Time -> IO [Char]
ppDate Time
ti
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Char]
"* " forall a. Semigroup a => a -> a -> a
<> [Char]
todo forall a. Semigroup a => a -> a -> a
<> [Char]
priority forall a. Semigroup a => a -> a -> a
<> case Clp
clp of
Body [Char]
c -> forall a. Monoid a => [a] -> a
mconcat [[Char]
str, [Char]
t, [Char]
c]
Header [Char]
c -> forall a. Monoid a => [a] -> a
mconcat [[Char]
"[[", [Char]
c, [Char]
"][", [Char]
str,[Char]
"]]", [Char]
t]
where
priority :: [Char]
priority = case Priority
prio of
Priority
NoPriority -> [Char]
" "
Priority
otherPrio -> [Char]
" [#" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Priority
otherPrio forall a. Semigroup a => a -> a -> a
<> [Char]
"] "
pInput :: String -> Maybe Note
pInput :: [Char] -> Maybe Note
pInput [Char]
inp = (forall a. Parser a -> [Char] -> Maybe a
`runParser` [Char]
inp) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Parser a] -> Parser a
choice forall a b. (a -> b) -> a -> b
$
[ [Char] -> Time -> Priority -> Note
Scheduled forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> Parser [Char]
getLast [Char]
"+s" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser [Char]
" ") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe Date -> Maybe OrgTime -> Parser Time
fixTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe Date)
pDate forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe OrgTime)
pOrgTime) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Priority
pPriority
, [Char] -> Time -> Priority -> Note
Deadline forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> Parser [Char]
getLast [Char]
"+d" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser [Char]
" ") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe Date -> Maybe OrgTime -> Parser Time
fixTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe Date)
pDate forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe OrgTime)
pOrgTime) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Priority
pPriority
, do [Char]
s <- (Char -> Bool) -> Parser [Char]
munch1 (forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)
let ([Char]
s', [Char]
p) = forall a. Int -> [a] -> ([a], [a])
splitAt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s forall a. Num a => a -> a -> a
- Int
3) [Char]
s
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case [Char] -> Maybe Priority
tryPrio [Char]
p of
Just Priority
prio -> [Char] -> Priority -> Note
NormalMsg (Int -> [Char] -> [Char]
dropStripEnd Int
0 [Char]
s') Priority
prio
Maybe Priority
Nothing -> [Char] -> Priority -> Note
NormalMsg [Char]
s Priority
NoPriority
]
where
fixTime :: Maybe Date -> Maybe OrgTime -> Parser Time
fixTime :: Maybe Date -> Maybe OrgTime -> Parser Time
fixTime Maybe Date
d Maybe OrgTime
tod = case (Maybe Date
d, Maybe OrgTime
tod) of
(Maybe Date
Nothing, Maybe OrgTime
Nothing) -> forall a. Monoid a => a
mempty
(Maybe Date
Nothing, Just{}) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Date -> Maybe OrgTime -> Time
Time Date
Today Maybe OrgTime
tod)
(Just Date
d', Maybe OrgTime
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Date -> Maybe OrgTime -> Time
Time Date
d' Maybe OrgTime
tod)
tryPrio :: String -> Maybe Priority
tryPrio :: [Char] -> Maybe Priority
tryPrio [Char
' ', Char
'#', Char
x]
| Char
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
"Aa" :: String) = forall a. a -> Maybe a
Just Priority
A
| Char
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
"Bb" :: String) = forall a. a -> Maybe a
Just Priority
B
| Char
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
"Cc" :: String) = forall a. a -> Maybe a
Just Priority
C
tryPrio [Char]
_ = forall a. Maybe a
Nothing
dropStripEnd :: Int -> String -> String
dropStripEnd :: Int -> [Char] -> [Char]
dropStripEnd Int
n = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Char
' ') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse
getLast :: String -> Parser String
getLast :: [Char] -> Parser [Char]
getLast [Char]
ptn = Int -> [Char] -> [Char]
dropStripEnd (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
ptn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a sep. Parser a -> Parser sep -> Parser [a]
endBy1 ([Char] -> Parser [Char]
go [Char]
"") (forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
ptn)
where
go :: String -> Parser String
go :: [Char] -> Parser [Char]
go [Char]
consumed = do
[Char]
str <- (Char -> Bool) -> Parser [Char]
munch (forall a. Eq a => a -> a -> Bool
/= forall a. NonEmpty a -> a
NE.head (forall a. HasCallStack => [a] -> NonEmpty a
notEmpty [Char]
ptn))
[Char]
word <- (Char -> Bool) -> Parser [Char]
munch1 (forall a. Eq a => a -> a -> Bool
/= Char
' ')
forall a. a -> a -> Bool -> a
bool [Char] -> Parser [Char]
go forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char]
word forall a. Eq a => a -> a -> Bool
== [Char]
ptn) forall a b. (a -> b) -> a -> b
$ [Char]
consumed forall a. Semigroup a => a -> a -> a
<> [Char]
str forall a. Semigroup a => a -> a -> a
<> [Char]
word
pPriority :: Parser Priority
pPriority :: Parser Priority
pPriority = forall a. a -> Parser a -> Parser a
option Priority
NoPriority forall a b. (a -> b) -> a -> b
$
Parser ()
skipSpaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. [Parser a] -> Parser a
choice
[ Parser [Char]
"#" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Char] -> Parser [Char]
foldCase [Char]
"a" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Priority
A
, Parser [Char]
"#" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Char] -> Parser [Char]
foldCase [Char]
"b" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Priority
B
, Parser [Char]
"#" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Char] -> Parser [Char]
foldCase [Char]
"c" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Priority
C
]
pOrgTime :: Parser (Maybe OrgTime)
pOrgTime :: Parser (Maybe OrgTime)
pOrgTime = forall a. a -> Parser a -> Parser a
option forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$
forall open close a.
Parser open -> Parser close -> Parser a -> Parser a
between Parser ()
skipSpaces (forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser [Char]
" " forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ()
eof) forall a b. (a -> b) -> a -> b
$
forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [Parser a] -> Parser a
choice
[ TimeOfDay -> TimeOfDay -> OrgTime
TimeSpan forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser TimeOfDay
pTimeOfDay forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser [Char]
"--" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Char]
"-" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Char]
"–")) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TimeOfDay
pTimeOfDay
, do from :: TimeOfDay
from@(HHMM Int
h Int
m) <- Parser TimeOfDay
pTimeOfDay forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser [Char]
"+"
Int
off <- Parser Int
pHour
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ TimeOfDay -> TimeOfDay -> OrgTime
TimeSpan TimeOfDay
from (Int -> Int -> TimeOfDay
HHMM (Int
h forall a. Num a => a -> a -> a
+ Int
off) Int
m)
, TimeOfDay -> OrgTime
MomentInTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TimeOfDay
pTimeOfDay
]
where
pTimeOfDay :: Parser TimeOfDay
pTimeOfDay :: Parser TimeOfDay
pTimeOfDay = forall a. [Parser a] -> Parser a
choice
[ Int -> Int -> TimeOfDay
HHMM forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
pHour forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser [Char]
":" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int
pMinute
, Parser TimeOfDay
pHHMM
, Int -> Int -> TimeOfDay
HHMM forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
pHour forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
]
pHHMM :: Parser TimeOfDay
pHHMM :: Parser TimeOfDay
pHHMM = do
let getTwo :: Parser [Char]
getTwo = forall a. Int -> Parser a -> Parser [a]
count Int
2 ((Char -> Bool) -> Parser Char
satisfy Char -> Bool
isDigit)
Int
hh <- forall a. Read a => [Char] -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [Char]
getTwo
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
hh forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
hh forall a. Ord a => a -> a -> Bool
<= Int
23)
Int
mm <- forall a. Read a => [Char] -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [Char]
getTwo
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
mm forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
mm forall a. Ord a => a -> a -> Bool
<= Int
59)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> Int -> TimeOfDay
HHMM Int
hh Int
mm
Parser Int
pHour :: Parser Int = Int -> Int -> Parser Int
pNumBetween Int
0 Int
23
Parser Int
pMinute :: Parser Int = Int -> Int -> Parser Int
pNumBetween Int
0 Int
59
pDate :: Parser (Maybe Date)
pDate :: Parser (Maybe Date)
pDate = Parser ()
skipSpaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall a. [Parser a] -> Parser a
choice
[ forall a. [Char] -> [Char] -> a -> Parser a
pPrefix [Char]
"tod" [Char]
"ay" Date
Today
, forall a. [Char] -> [Char] -> a -> Parser a
pPrefix [Char]
"tom" [Char]
"orrow" Date
Tomorrow
, DayOfWeek -> Date
Next forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DayOfWeek
pNext
, (Int, Maybe Int, Maybe Integer) -> Date
Date forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Int, Maybe Int, Maybe Integer)
pDate'
])
where
Parser DayOfWeek
pNext :: Parser DayOfWeek = forall a. [Parser a] -> Parser a
choice
[ forall a. [Char] -> [Char] -> a -> Parser a
pPrefix [Char]
"m" [Char]
"onday" DayOfWeek
Monday , forall a. [Char] -> [Char] -> a -> Parser a
pPrefix [Char]
"tu" [Char]
"esday" DayOfWeek
Tuesday
, forall a. [Char] -> [Char] -> a -> Parser a
pPrefix [Char]
"w" [Char]
"ednesday" DayOfWeek
Wednesday, forall a. [Char] -> [Char] -> a -> Parser a
pPrefix [Char]
"th" [Char]
"ursday" DayOfWeek
Thursday
, forall a. [Char] -> [Char] -> a -> Parser a
pPrefix [Char]
"f" [Char]
"riday" DayOfWeek
Friday , forall a. [Char] -> [Char] -> a -> Parser a
pPrefix [Char]
"sa" [Char]
"turday" DayOfWeek
Saturday
, forall a. [Char] -> [Char] -> a -> Parser a
pPrefix [Char]
"su" [Char]
"nday" DayOfWeek
Sunday
]
numWithoutColon :: Parser Int
numWithoutColon :: Parser Int
numWithoutColon = do
Int
str <- Int -> Int -> Parser Int
pNumBetween Int
1 Int
12
Char
c <- Parser Char
get
if Char
c forall a. Eq a => a -> a -> Bool
== Char
':'
then forall a. Parser a
pfail
else forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
str
pDate' :: Parser (Int, Maybe Int, Maybe Integer)
pDate' :: Parser (Int, Maybe Int, Maybe Integer)
pDate' =
(,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Int -> Parser Int
pNumBetween Int
1 Int
31 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser [Char]
" " forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ()
eof))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ()
skipSpaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. [Parser a] -> Parser a
choice
[ forall a. [Char] -> [Char] -> a -> Parser a
pPrefix [Char]
"ja" [Char]
"nuary" Int
1 , forall a. [Char] -> [Char] -> a -> Parser a
pPrefix [Char]
"f" [Char]
"ebruary" Int
2
, forall a. [Char] -> [Char] -> a -> Parser a
pPrefix [Char]
"mar" [Char]
"ch" Int
3 , forall a. [Char] -> [Char] -> a -> Parser a
pPrefix [Char]
"ap" [Char]
"ril" Int
4
, forall a. [Char] -> [Char] -> a -> Parser a
pPrefix [Char]
"may" [Char]
"" Int
5 , forall a. [Char] -> [Char] -> a -> Parser a
pPrefix [Char]
"jun" [Char]
"e" Int
6
, forall a. [Char] -> [Char] -> a -> Parser a
pPrefix [Char]
"jul" [Char]
"y" Int
7 , forall a. [Char] -> [Char] -> a -> Parser a
pPrefix [Char]
"au" [Char]
"gust" Int
8
, forall a. [Char] -> [Char] -> a -> Parser a
pPrefix [Char]
"s" [Char]
"eptember" Int
9 , forall a. [Char] -> [Char] -> a -> Parser a
pPrefix [Char]
"o" [Char]
"ctober" Int
10
, forall a. [Char] -> [Char] -> a -> Parser a
pPrefix [Char]
"n" [Char]
"ovember" Int
11, forall a. [Char] -> [Char] -> a -> Parser a
pPrefix [Char]
"d" [Char]
"ecember" Int
12
, Parser Int
numWithoutColon
])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ()
skipSpaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. (Read a, Integral a) => Parser a
num forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
i -> forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Integer
i forall a. Ord a => a -> a -> Bool
>= Integer
25) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Integer
i)
pPrefix :: String -> String -> a -> Parser a
pPrefix :: forall a. [Char] -> [Char] -> a -> Parser a
pPrefix [Char]
start (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower -> [Char]
leftover) a
ret = do
forall (f :: * -> *) a. Functor f => f a -> f ()
void ([Char] -> Parser [Char]
foldCase [Char]
start)
[Char]
l <- forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser [Char]
munch (forall a. Eq a => a -> a -> Bool
/= Char
' ')
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ([Char]
l forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
leftover)
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
ret
pNumBetween :: Int -> Int -> Parser Int
pNumBetween :: Int -> Int -> Parser Int
pNumBetween Int
lo Int
hi = do
Int
n <- forall a. (Read a, Integral a) => Parser a
num
Int
n forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
n forall a. Ord a => a -> a -> Bool
>= Int
lo Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= Int
hi)
foldCase :: String -> Parser String
foldCase :: [Char] -> Parser [Char]
foldCase = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Char
c -> Char -> Parser Char
char (Char -> Char
toLower Char
c) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser Char
char (Char -> Char
toUpper Char
c))
data Heading = Heading
{ Heading -> Natural
level :: Natural
, Heading -> [Char]
headingText :: String
}
pOrgFile :: Parser [Heading]
pOrgFile :: Parser [Heading]
pOrgFile = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Heading
pHeading
pHeading :: Parser Heading
pHeading :: Parser Heading
pHeading = Parser ()
skipSpaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> do
Natural
level <- forall i a. Num i => [a] -> i
genericLength forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser [Char]
munch1 (forall a. Eq a => a -> a -> Bool
== Char
'*') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser [Char]
" "
[Char]
headingText <- Parser [Char]
pLine
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser [Char]
pLine forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Char]
line -> forall (f :: * -> *). Alternative f => Bool -> f ()
guard ([Char] -> Bool
isNotHeading [Char]
line) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> [Char]
line)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Heading{Natural
[Char]
headingText :: [Char]
level :: Natural
level :: Natural
headingText :: [Char]
..}
pLine :: Parser String
pLine :: Parser [Char]
pLine = (Char -> Bool) -> Parser [Char]
munch (forall a. Eq a => a -> a -> Bool
/= Char
'\n') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser [Char]
"\n"
isNotHeading :: String -> Bool
isNotHeading :: [Char] -> Bool
isNotHeading [Char]
str = case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
/= Char
'*') [Char]
str of
([Char]
"", [Char]
_) -> Bool
True
([Char]
_ , Char
' ' : [Char]
_) -> Bool
False
([Char], [Char])
_ -> Bool
True