{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE CPP #-}

-- | BasicPrelude mostly re-exports
-- several key libraries in their entirety.
-- The exception is Data.List,
-- where various functions are replaced
-- by similar versions that are either
-- generalized, operate on Text,
-- or are implemented strictly.
module BasicPrelude
  ( -- * Module exports
    module CorePrelude
  , module Data.List
  , module Control.Monad

    -- ** Folds and traversals
  , Foldable
    (
      foldMap
    , foldr
    , foldr'
    , foldl
    , foldl'
    , foldr1
    , foldl1
    )
    -- In base-4.8, these are instance methods.
  , elem
  , maximum
  , minimum
  , traverse_
  , sequenceA_
  , for_
  , maximumBy
  , minimumBy
  , Traversable
    (
      traverse
    , sequenceA
    , mapM
    , sequence
    )
  , for

    -- * Enhanced exports
    -- ** Simpler name for a typeclassed operation
  , map
  , empty
  , (++)
  , concat
  , intercalate
    -- ** Strict implementation
  , BasicPrelude.sum
  , BasicPrelude.product
    -- ** Text for Read and Show operations
  , tshow
  , fromShow
  , read
  , readIO
    -- ** FilePath for file operations
  , readFile
  , writeFile
  , appendFile

    -- * Text exports
    -- ** Text operations (Pure)
  , Text.lines
  , Text.words
  , Text.unlines
  , Text.unwords
  , textToString
  , ltextToString
  , fpToText
  , fpFromText
  , fpToString
  , encodeUtf8
  , decodeUtf8
    -- ** Text operations (IO)
  , getLine
  , getContents
  , interact

    -- * Miscellaneous prelude re-exports
    -- ** Math
  , Prelude.gcd
  , Prelude.lcm
    -- ** Show and Read
  , Prelude.Show (..)
  , Prelude.ShowS
  , Prelude.shows
  , Prelude.showChar
  , Prelude.showString
  , Prelude.showParen
  , Prelude.ReadS
  , Prelude.readsPrec
  , Prelude.readList
  , Prelude.reads
  , Prelude.readParen
  , Prelude.lex
  , readMay
    -- ** IO operations
  , getChar
  , putChar
  , readLn
  ) where

import CorePrelude

import Data.List hiding
  ( -- prefer monoid versions instead
    (++)
  , concat
  , intercalate
    -- prefer Text versions instead
  , lines
  , words
  , unlines
  , unwords
    -- prefer map = fmap instead
  , map
    -- prefer strict versions
  , sum
  , product
    -- prefer Foldable versions
  , elem
  , foldl
  , foldl'
  , foldl1
  , foldr
  , foldr1
  , maximum
  , minimum
  , maximumBy
  , minimumBy
  )

-- Import *all of the things* from Control.Monad,
-- specifically, the list-based things that
-- CorePrelude doesn't export
import Control.Monad hiding
  ( -- Also exported by Data.Traversable.
    mapM
  , sequence
  )


import Data.Foldable (Foldable(..), elem, maximum, minimum, traverse_, sequenceA_, for_)
import Data.Traversable (Traversable(..), for)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import qualified Data.Text.Lazy as LText
import qualified Data.Text.Lazy.IO as LText
import qualified Prelude
import Data.Text.Encoding (encodeUtf8, decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
import qualified Text.Read

#if MIN_VERSION_base(4,10,0)
import Data.Foldable (maximumBy, minimumBy)
#else
maximumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a
maximumBy cmp = foldl1 max'
  where max' x y = case cmp x y of
                     GT -> x
                     _  -> y

minimumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a
minimumBy cmp = foldl1 min'
  where min' x y = case cmp x y of
                     GT -> y
                     _  -> x
#endif

-- | > map = fmap
map :: (Functor f) => (a -> b) -> f a -> f b
map :: (a -> b) -> f a -> f b
map = (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

-- | > empty = mempty
empty :: Monoid w => w
empty :: w
empty = w
forall a. Monoid a => a
mempty
{-# DEPRECATED empty "Use mempty" #-}

infixr 5 ++

-- | > (++) = mappend
(++) :: Monoid w => w -> w -> w
++ :: w -> w -> w
(++) = w -> w -> w
forall a. Monoid a => a -> a -> a
mappend

-- | > concat = mconcat
concat :: Monoid w => [w] -> w
concat :: [w] -> w
concat = [w] -> w
forall a. Monoid a => [a] -> a
mconcat

-- | > intercalate = mconcat .: intersperse
intercalate :: Monoid w => w -> [w] -> w
intercalate :: w -> [w] -> w
intercalate xs :: w
xs xss :: [w]
xss = [w] -> w
forall a. Monoid a => [a] -> a
mconcat (w -> [w] -> [w]
forall a. a -> [a] -> [a]
Data.List.intersperse w
xs [w]
xss)


-- | Compute the sum of a finite list of numbers.
sum :: (Foldable f, Num a) => f a -> a
sum :: f a -> a
sum = (a -> a -> a) -> a -> f a -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.Foldable.foldl' a -> a -> a
forall a. Num a => a -> a -> a
(+) 0

-- | Compute the product of a finite list of numbers.
product :: (Foldable f, Num a) => f a -> a
product :: f a -> a
product = (a -> a -> a) -> a -> f a -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.Foldable.foldl' a -> a -> a
forall a. Num a => a -> a -> a
(*) 1


-- | Convert a value to readable Text
--
-- @since 0.6.0
tshow :: Show a => a -> Text
tshow :: a -> Text
tshow = String -> Text
Text.pack (String -> Text) -> (a -> String) -> a -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> String
forall a. Show a => a -> String
Prelude.show

-- | Convert a value to readable IsString
--
-- Since 0.3.12
fromShow :: (Show a, IsString b) => a -> b
fromShow :: a -> b
fromShow = String -> b
forall a. IsString a => String -> a
fromString (String -> b) -> (a -> String) -> a -> b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> String
forall a. Show a => a -> String
Prelude.show

-- | Parse Text to a value
read :: Read a => Text -> a
read :: Text -> a
read = String -> a
forall a. Read a => String -> a
Prelude.read (String -> a) -> (Text -> String) -> Text -> a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> String
Text.unpack

-- | The readIO function is similar to read
-- except that it signals parse failure to the IO monad
-- instead of terminating the program.
--
-- @since 0.7.0
readIO :: (MonadIO m, Read a) => Text -> m a
readIO :: Text -> m a
readIO = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (Text -> IO a) -> Text -> m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IO a
forall a. Read a => String -> IO a
Prelude.readIO (String -> IO a) -> (Text -> String) -> Text -> IO a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> String
Text.unpack


-- | Read a file and return the contents of the file as Text.
-- The entire file is read strictly.
--
-- @since 0.7.0
readFile :: MonadIO m => FilePath -> m Text
readFile :: String -> m Text
readFile = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> (String -> IO Text) -> String -> m Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IO Text
Text.readFile

-- | Write Text to a file.
-- The file is truncated to zero length before writing begins.
--
-- @since 0.7.0
writeFile :: MonadIO m => FilePath -> Text -> m ()
writeFile :: String -> Text -> m ()
writeFile p :: String
p = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Text -> IO ()) -> Text -> m ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text -> IO ()
Text.writeFile String
p

-- | Write Text to the end of a file.
--
-- @since 0.7.0
appendFile :: MonadIO m => FilePath -> Text -> m ()
appendFile :: String -> Text -> m ()
appendFile p :: String
p = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Text -> IO ()) -> Text -> m ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text -> IO ()
Text.appendFile String
p

textToString :: Text -> Prelude.String
textToString :: Text -> String
textToString = Text -> String
Text.unpack

ltextToString :: LText -> Prelude.String
ltextToString :: LText -> String
ltextToString = LText -> String
LText.unpack

-- | This function assumes file paths are encoded in UTF8. If it
-- cannot decode the 'FilePath', the result is just an approximation.
--
-- Since 0.3.13
fpToText :: FilePath -> Text
fpToText :: String -> Text
fpToText = String -> Text
Text.pack
{-# DEPRECATED fpToText "Use Data.Text.pack" #-}

-- |
-- Since 0.3.13
fpFromText :: Text -> FilePath
fpFromText :: Text -> String
fpFromText = Text -> String
Text.unpack
{-# DEPRECATED fpFromText "Use Data.Text.unpack" #-}

-- |
-- Since 0.3.13
fpToString :: FilePath -> Prelude.String
fpToString :: String -> String
fpToString = String -> String
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
{-# DEPRECATED fpToString "Use id" #-}

-- | Note that this is /not/ the standard @Data.Text.Encoding.decodeUtf8@. That
-- function will throw impure exceptions on any decoding errors. This function
-- instead uses @decodeLenient@.
decodeUtf8 :: ByteString -> Text
decodeUtf8 :: ByteString -> Text
decodeUtf8 = OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode

-- |
-- @since 0.7.0
getLine :: MonadIO m => m Text
getLine :: m Text
getLine = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Text
Text.getLine

-- |
-- @since 0.7.0
getContents :: MonadIO m => m LText
getContents :: m LText
getContents = IO LText -> m LText
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO LText
LText.getContents

-- |
-- @since 0.7.0
interact :: MonadIO m => (LText -> LText) -> m ()
interact :: (LText -> LText) -> m ()
interact = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> ((LText -> LText) -> IO ()) -> (LText -> LText) -> m ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (LText -> LText) -> IO ()
LText.interact

readMay :: Read a => Text -> Maybe a
readMay :: Text -> Maybe a
readMay = String -> Maybe a
forall a. Read a => String -> Maybe a
Text.Read.readMaybe (String -> Maybe a) -> (Text -> String) -> Text -> Maybe a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> String
Text.unpack

-- |
-- @since 0.7.0
getChar :: MonadIO m => m Char
getChar :: m Char
getChar = IO Char -> m Char
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Char
Prelude.getChar

-- |
-- @since 0.7.0
putChar :: MonadIO m => Char -> m ()
putChar :: Char -> m ()
putChar = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Char -> IO ()) -> Char -> m ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> IO ()
Prelude.putChar

-- | The 'readLn' function combines 'getLine' and 'readIO'.
--
-- @since 0.7.0
readLn :: (MonadIO m, Read a) => m a
readLn :: m a
readLn = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
forall a. Read a => IO a
Prelude.readLn