New module: XMonad.Prelude

This is a convenience module in order to have less import noise.  It
re-exports the following:

  a) Commonly used modules in full (Data.Foldable, Data.Applicative, and
     so on); though only those that play nicely with each other, so that
     XMonad.Prelude can be imported unqualified without any problems.
     This prevents things like `Prelude.(.)` and `Control.Category.(.)`
     fighting with each other.

  b) Helper functions that don't necessarily fit in any other module;
     e.g., the often used abbreviation `fi = fromIntegral`.
This commit is contained in:
slotThe
2021-03-28 20:22:56 +02:00
parent 6ece010c01
commit 2469269119
186 changed files with 365 additions and 609 deletions

View File

@@ -37,16 +37,12 @@ module XMonad.Prompt.OrgMode (
OrgMode, -- abstract
) where
import XMonad.Prelude
import XMonad (X, io)
import XMonad.Prompt (XPConfig, XPrompt (showXPrompt), mkXPrompt)
import XMonad.Util.XSelection (getSelection)
import Control.Applicative (empty)
import Control.Monad ((<=<))
import Data.Char (isDigit)
import Data.Functor ((<&>))
import Data.List (foldl')
import Data.Maybe (fromMaybe, listToMaybe)
import Data.Time (Day (ModifiedJulianDay), NominalDiffTime, UTCTime (utctDay), addUTCTime, defaultTimeLocale, formatTime, fromGregorian, getCurrentTime, iso8601DateFormat, nominalDay, toGregorian)
import System.Directory (getHomeDirectory)
import System.IO (IOMode (AppendMode), hPutStrLn, withFile)
@@ -382,10 +378,3 @@ pInt = read <$> munch1 isDigit
-- parsing when the left-most parser succeeds.
lchoice :: [ReadP a] -> ReadP a
lchoice = foldl' (<++) empty
------------------------------------------------------------------------
-- Util
-- | Multivariant composition.
(.:) :: (a -> b) -> (c -> d -> a) -> c -> d -> b
(.:) = (.) . (.)