{-# LANGUAGE CPP #-}

-- | This module provides common utilities.
--
-- @since 0.1
module Pythia.Utils
  ( -- * Folding
    foldAlt,
    foldMap1,
    mAlt,

    -- * Parsing
    takeLine,
    takeLineLabel,
    takeLine_,
    exeSupported,

    -- * Miscellaneous
    headMaybe,
    eitherToBool,
  )
where

import Data.Maybe qualified as May
import Effects.FileSystem.PathReader qualified as Dir
import Pythia.Prelude
import Text.Megaparsec (Parsec, Stream, Token, Tokens)
import Text.Megaparsec qualified as MP
import Text.Megaparsec.Char qualified as MPC

-- $setup
-- >>> import Pythia.Prelude
-- >>> import Text.Megaparsec (parseTest)

-- | Similar to 'foldMap' but for 'Alternative'.
--
-- ==== __Examples__
--
-- >>> foldAlt (\c -> if even c then Just c else Nothing) [1,2,3,4]
-- Just 2
--
-- >>> foldAlt (\c -> if even c then Just c else Nothing) [1,3]
-- Nothing
--
-- @since 0.1
foldAlt :: (Foldable t, Alternative f) => (a -> f b) -> t a -> f b
foldAlt :: forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Foldable t, Alternative f) =>
(a -> f b) -> t a -> f b
foldAlt a -> f b
f = (a -> f b -> f b) -> f b -> t a -> f b
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (f b -> f b -> f b
forall a. f a -> f a -> f a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
(<|>) (f b -> f b -> f b) -> (a -> f b) -> a -> f b -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
f) f b
forall a. f a
forall (f :: Type -> Type) a. Alternative f => f a
empty
{-# INLINEABLE foldAlt #-}

-- | Relaxes 'foldMap'\'s 'Monoid' constraint to 'Semigroup'. Requires a
-- starting value. This will have to do until semigroupoids' Foldable1 is
-- in base.
--
-- @since 0.1
foldMap1 :: (Foldable f, Semigroup s) => (a -> s) -> a -> f a -> s
foldMap1 :: forall (f :: Type -> Type) s a.
(Foldable f, Semigroup s) =>
(a -> s) -> a -> f a -> s
foldMap1 a -> s
f a
x f a
xs = (a -> (a -> s) -> a -> s) -> (a -> s) -> f a -> a -> s
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
b a -> s
g a
y -> a -> s
f a
y s -> s -> s
forall a. Semigroup a => a -> a -> a
<> a -> s
g a
b) a -> s
f f a
xs a
x
{-# INLINEABLE foldMap1 #-}

-- | Convenience function for mapping a 'Maybe' to its underlying
-- 'Alternative'.
--
-- ==== __Examples__
--
-- >>> mAlt @[] Nothing
-- []
--
-- >>> mAlt @[] (Just [1,2,3])
-- [1,2,3]
--
-- @since 0.1
mAlt :: (Alternative f) => Maybe (f a) -> f a
mAlt :: forall (f :: Type -> Type) a. Alternative f => Maybe (f a) -> f a
mAlt = f a -> Maybe (f a) -> f a
forall a. a -> Maybe a -> a
fromMaybe f a
forall a. f a
forall (f :: Type -> Type) a. Alternative f => f a
empty
{-# INLINEABLE mAlt #-}

-- | 'takeLineLabel' with no label.
--
-- ==== __Examples__
--
-- >>> parseTest @Void takeLine "some text 123 \n"
-- "some text 123 "
--
-- >>> parseTest @Void takeLine "some text 123"
-- 1:14:
--   |
-- 1 | some text 123
--   |              ^
-- unexpected end of input
-- expecting end of line
--
-- @since 0.1
takeLine :: (Ord e, Stream s, Token s ~ Char) => Parsec e s (Tokens s)
takeLine :: forall e s.
(Ord e, Stream s, Token s ~ Char) =>
Parsec e s (Tokens s)
takeLine = Maybe String -> ParsecT e s Identity (Tokens s)
forall e s.
(Ord e, Stream s, Token s ~ Char) =>
Maybe String -> Parsec e s (Tokens s)
takeLineLabel Maybe String
forall a. Maybe a
Nothing
{-# INLINEABLE takeLine #-}

-- | Variant of 'takeLine' taking in a label.
--
-- ==== __Examples__
--
-- >>> parseTest @Void (takeLineLabel (Just "a label")) "some text 123"
-- 1:14:
--   |
-- 1 | some text 123
--   |              ^
-- unexpected end of input
-- expecting a label or end of line
--
-- @since 0.1
takeLineLabel :: (Ord e, Stream s, Token s ~ Char) => Maybe String -> Parsec e s (Tokens s)
takeLineLabel :: forall e s.
(Ord e, Stream s, Token s ~ Char) =>
Maybe String -> Parsec e s (Tokens s)
takeLineLabel Maybe String
desc = Maybe String
-> (Token s -> Bool) -> ParsecT e s Identity (Tokens s)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
MP.takeWhileP Maybe String
desc (Token s -> Token s -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
Token s
'\n') ParsecT e s Identity (Tokens s)
-> ParsecT e s Identity (Tokens s)
-> ParsecT e s Identity (Tokens s)
forall a b.
ParsecT e s Identity a
-> ParsecT e s Identity b -> ParsecT e s Identity a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* ParsecT e s Identity (Tokens s)
forall e s (m :: Type -> Type).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
MPC.eol
{-# INLINEABLE takeLineLabel #-}

-- | Takes everything up to the first new line, returns unit.
--
-- ==== __Examples__
--
-- >>> parseTest @Void takeLine_ "some text 123\n"
-- ()
--
-- @since 0.1
takeLine_ :: (Ord e, Stream s, Token s ~ Char) => Parsec e s ()
takeLine_ :: forall e s. (Ord e, Stream s, Token s ~ Char) => Parsec e s ()
takeLine_ = Maybe String
-> (Token s -> Bool) -> ParsecT e s Identity (Tokens s)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
MP.takeWhileP Maybe String
forall a. Maybe a
Nothing (Token s -> Token s -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
Token s
'\n') ParsecT e s Identity (Tokens s)
-> ParsecT e s Identity () -> ParsecT e s Identity ()
forall a b.
ParsecT e s Identity a
-> ParsecT e s Identity b -> ParsecT e s Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> ParsecT e s Identity (Tokens s) -> ParsecT e s Identity ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void ParsecT e s Identity (Tokens s)
forall e s (m :: Type -> Type).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
MPC.eol
{-# INLINEABLE takeLine_ #-}

-- | Maps 'Left' to 'False', 'Right' to 'True'.
--
-- ==== __Examples__
--
-- >>> eitherToBool (Left ())
-- False
--
-- >>> eitherToBool (Right ())
-- True
--
-- @since 0.1
eitherToBool :: Either a b -> Bool
eitherToBool :: forall a b. Either a b -> Bool
eitherToBool = (a -> Bool) -> (b -> Bool) -> Either a b -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
False) (Bool -> b -> Bool
forall a b. a -> b -> a
const Bool
True)
{-# INLINEABLE eitherToBool #-}

-- | Determines if the executable represented by the string parameter is
-- supported on this system.
--
-- @since 0.1
exeSupported :: (MonadPathReader m) => OsPath -> m Bool
exeSupported :: forall (m :: Type -> Type). MonadPathReader m => OsPath -> m Bool
exeSupported OsPath
exeName = Maybe OsPath -> Bool
forall a. Maybe a -> Bool
May.isJust (Maybe OsPath -> Bool) -> m (Maybe OsPath) -> m Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> OsPath -> m (Maybe OsPath)
forall (m :: Type -> Type).
(MonadPathReader m, HasCallStack) =>
OsPath -> m (Maybe OsPath)
Dir.findExecutable OsPath
exeName
{-# INLINEABLE exeSupported #-}