Easy.hs

{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE CPP #-}
-- | @easy-data@ aims to make @'Either'@, @'List'@, @'Tuple'@, @'Monoid'@ and
-- @'Bool'@ counterparts to the functions originally defined in
-- "Data.Maybe", whenever applicable.
--
-- This module also adds some extra useful functions, that can be found
-- in otherwise disperse packages, pages, mailing lists, etc.
-- A relevant link will be included whenever appropriate, or just a simple
-- note regarding where to find the other implementations.
-- The main goal is to have a consistent set of sensible convertions
-- between types, providing either default values or custom error messages
-- when faced with partial functions (in a mathematical sense).
--
-- This module is undoubtably neither original, nor providing the \'best\'
-- implementations. Its goal is instead to provide a regular and consistent
-- set of functions, easy do memorize and use, for the Haskell beginner.
--
-- Most functions are one-liners, and you should read their actual code,
-- to either use it as a more idiomatic haskell code, or to develop a
-- better version yourself. Most of these functions are hand-picked from
-- one of the following libraries, that also feature a lot of other goodies,
-- so you should check them out.
--
-- @safe@      : <http://hackage.haskell.org/package/safe>
--
-- @either@    : <http://hackage.haskell.org/package/either>
--
-- @errors@    : <http://hackage.haskell.org/package/errors>
--
-- @basic-prelude@:<http://hackage.haskell.org/package/basic-prelude>
--
-- @missingh@   : <http://hackage.haskell.org/package/MissingH>
--
-- @utility-ht@ : <http://hackage.haskell.org/package/utility-ht>
--
-- Note that the "Safe" module is re-exported by this module.
-- Please notify me if you think I'm missing
-- some other library.
--
-- For monad related functions, check my other related module,
-- "Control.Monad.Trans.Convert", or the modules that inspired it, @either@ and
-- @errors@.
--
-- Some choices have been made, and I am open to discussion whether they
-- are adequate or not. Please contribute and help me make this a (even)
-- more easy and consistent module.
--
module Data.Easy
  ( -- * Module exports
    module Safe

  -- * Additional functions

  -- ** Maybe
  -- | Since this module maps the "Data.Maybe" functions to other data types,
  -- we mainly just import (and re-export) this module.
  -- The extra functions are dedicated to conversions to other types.
  , maybeToMonoid
  , monoidToMaybe

  -- ** Either
  -- | Copied most of the functions from "Data.Either.Combinators",
  -- from the "either" package. This package has a huge import list,
  -- unnecessary for such simple combinators.
  , fromLeft
  , fromRight
  , fromLeft'
  , fromRight'
  , mapBoth
  , mapLeft
  , mapRight
  , whenLeft
  , whenRight
  , unlessLeft
  , unlessRight
  , leftToMaybe
  , rightToMaybe

  , fromRightNote
  , fromLeftNote
  , fromEither
  , listToEither
  , eitherToList
  , catEithers
  , mapEither

  , maybeToEither
  , eitherToMaybe
  , eitherToMonoid
  , monoidToEither
  , joinEitherMonoid

  -- ** List
  -- | Data.Maybe counterparts for List, plus some extra functions.
  -- One special note for 'nubSort': this is the only \'optimized\'
  -- function in this library, mainly because the original
  -- @nub . sort@ performance is so bad.
  -- Nevertheless, never forget that you should probably not be using
  -- lists anyhow:
  -- <http://www.haskell.org/haskellwiki/Performance>
  , list
  , isFilled
  , notNull
  , isNull
  , fromHeadNote
  , fromList
  , catLists
  , mapList
  , singleton
  , mapV
  , nubSort
  , nubSort'
  , atLeast

  -- ** Tuple Pairs
  -- | Monoid class restriction will be used in tuple elements whenever
  -- necessary to create the concept of \'valid\' value.
  --
  -- Here we adopt the convention of a 'direct' mapping between @'Either'@ and
  -- a tuple pair, meaning that the second value of the pair is considered the
  -- \'main\' one, whenever applicable. However, if you prefer the first value
  -- to be considered instead, you can use the reciprocal \"function'\",
  -- like for example 'pairToMaybe''.
  --
  -- /Note/: if you need real heterogeneous lists, see the "HList" package.
  -- <http://hackage.haskell.org/package/HList>
   , pair
  , pairS
  , isPairNotEmpty
  , isPairEmpty
  , fromFst
  , fromSnd
  , fromPairNote
  , fromPair
  , listToPairNote
  , listToPairs
  , group2
  , pairToList
  , catPairs
  , mapPair
  , pairToEither
  , pairToEither'
  , pairBothToEither
  , eitherToPair
  , eitherToPair'
  , pairToMaybe
  , pairToMaybe'
  , pairFstToMaybe
  , pairSndToMaybe
  , maybeToPair
  , maybeToPair'
  , pairToMonoid
  , pairToMonoid'

  -- ** Tuple Triples
  -- | Monoid class restriction will be used in tuple elements whenever
  -- necessary to create the concept of \'valid\' value.
  --
  -- Since it does not make sense to map a triple to an Either, here we follow
  -- a different convention than from pairs, meaning that the first value
  -- is always considered the \'valid\' value, if the function needs to
  -- choose (the first \'valid\' value).
  --
  -- /Note/: if you need real heterogeneous lists, see the "HList" package.
  -- <http://hackage.haskell.org/package/HList>
  --
  -- /Note/: we use the postfix ' to distinguish from tuple pairs, for
  -- example in the @'snd''@ function. This clearly doesn't scale to bigger tuples.
  -- If you need those, you probably should be using a better
  -- library than this, no? See <http://hackage.haskell.org/package/lens>.
  --
  , triple
  , tripleS
  , isTripleNotEmpty
  , isTripleEmpty
  , fromFst'
  , fst'
  , fromSnd'
  , snd'
  , fromTrd'
  , trd'
  , fromTripleNote
  , fromTriple
  , listToTripleNote
  , listToTriples
  , group3
  , tripleToList
  , catTriples
  , mapTriple
  , toFstPairToTriple
  , toSndPairToTriple
  , toTrdPairToTriple
  , pairToTriple
  , dropFstTripleToPair
  , dropSndTripleToPair
  , dropTrdTripleToPair
  , tripleToPair
  , tripleToMaybe
  , tripleToMaybe'
  , tripleToMonoid
  , tripleToMonoid'
  , curry3
  , uncurry3

  -- ** Monoid
  -- | The monoid version of the functions
  -- deviate slightly from the others, in the sense no value is extracted
  -- from or promoted to a monoid. Instead, the value is just checked against
  -- mempty, and kept|discarded|operated on accordingly.
  -- See <http://hackage.haskell.org/package/monoid-subclasses> module on
  -- hackage for a perhaps saner approach.
  , monoid
  , isNotEmpty
  , notEmpty
  , isEmpty
  , fromNotEmptyNote
  , fromMonoid
  , (?+)
  , (<!>)
  , listToMonoid
  , monoidToList
  , catMonoids
  , nonEmpty
  , mapMonoid
  , getFirst'
  , getLast'
  , headF
  , lastF
  , atF
  , (@@)

  -- ** Bool
  -- | Some extra functions included, namely the simplified ternary operator
  -- modified from what is seen in <https://gist.github.com/Burgestrand/218987>
  --
  -- /Note/: This is probably not considered good practice.
  -- Use the standard @if-then-else@ instead, its almost always clearer.
  -- /You have been warned./
  --
  , fromBool
  , fromBoolC
  , catBools
  , (?)
  , (?$)
  , (?|)
  , boolToMaybe
  , ifToMaybe
  , boolCToMaybe
  , ifCToMaybe
  , boolToEither
  , boolCToEither
  , boolToList
  , boolCToList
  , boolToMonoid
  , boolCToMonoid
  , (?&&)
  , (?&&\)
  , allCond
  , anyCond

  ) where

import Data.Maybe
import Data.Either
-- #if __GLASGOW_HASKELL__ >= 707
-- import Data.Either.Combinators hiding (isLeft,isRight)
-- #else
-- import Data.Either.Combinators
-- #endif
import Safe
import qualified Data.List as L
import qualified Data.Set as Set
import qualified Data.Foldable as F

------------------------------------------------------------------------------
-- Maybe ---------------------------------------------------------------------
------------------------------------------------------------------------------
-- | Maybe to monoid conversion
maybeToMonoid :: (Monoid a) => Maybe a -> a
maybeToMonoid Nothing = mempty
maybeToMonoid (Just x) = x

-- | Convert a monoid value into a maybe value (Nothing if mempty).
--
-- > monoidToMaybe = monoid Nothing Just
monoidToMaybe :: (Eq a, Monoid a) => a -> Maybe a
monoidToMaybe = monoid Nothing Just


------------------------------------------------------------------------------
-- Either --------------------------------------------------------------------
------------------------------------------------------------------------------

-- From Data.Either.Combinators ----------------------------------------------

-- ---------------------------------------------------------------------------
-- Functions over Either

-- | Extracts the element out of a 'Left' and
-- throws an error if its argument take the form  @'Right' _@.
--
-- Using @Control.Lens@:
--
-- @
-- 'fromLeft'' x ≡ x^?!_Left
-- @
--
-- >>> fromLeft' (Left 12)
-- 12
fromLeft' :: Either a b -> a
fromLeft' (Right _) = error "Data.Easy.fromLeft: Argument takes form 'Right _'" -- yuck
fromLeft' (Left x)  = x

-- | Extracts the element out of a 'Right' and
-- throws an error if its argument take the form @'Left' _@.
--
-- Using @Control.Lens@:
--
-- @
-- 'fromRight'' x ≡ x^?!_Right
-- @
--
-- >>> fromRight' (Right 12)
-- 12
fromRight' :: Either a b -> b
fromRight' (Left _)  = error "Data.Easy.fromRight: Argument takes form 'Left _'" -- yuck
fromRight' (Right x) = x

-- | The 'mapBoth' function takes two functions and applies the first if iff the value
-- takes the form @'Left' _@ and the second if the value takes the form @'Right' _@.
--
-- Using @Data.Bifunctor@:
--
-- @
-- 'mapBoth' = bimap
-- @
--
-- Using @Control.Arrow@:
--
-- @
-- 'mapBoth' = ('Control.Arrow.+++')
-- @
--
-- >>> mapBoth (*2) (*3) (Left 4)
-- Left 8
--
-- >>> mapBoth (*2) (*3) (Right 4)
-- Right 12
mapBoth :: (a -> c) -> (b -> d) -> Either a b -> Either c d
mapBoth f _ (Left x)  = Left (f x)
mapBoth _ f (Right x) = Right (f x)

-- | The 'mapLeft' function takes a function and applies it to an Either value
-- iff the value takes the form @'Left' _@.
--
-- Using @Data.Bifunctor@:
--
-- @
-- 'mapLeft' = first
-- @
--
-- Using @Control.Arrow@:
--
-- @
-- 'mapLeft' = ('Control.Arrow.left')
-- @
--
-- Using @Control.Lens@:
--
-- @
-- 'mapLeft' = over _Left
-- @
--
-- >>> mapLeft (*2) (Left 4)
-- Left 8
--
-- >>> mapLeft (*2) (Right "hello")
-- Right "hello"
mapLeft :: (a -> c) -> Either a b -> Either c b
mapLeft f = mapBoth f id

-- | The 'mapRight' function takes a function and applies it to an Either value
-- iff the value takes the form @'Right' _@.
--
-- Using @Data.Bifunctor@:
--
-- @
-- 'mapRight' = second
-- @
--
-- Using @Control.Arrow@:
--
-- @
-- 'mapRight' = ('Control.Arrow.right')
-- @
--
-- Using @Control.Lens@:
--
-- @
-- 'mapRight' = over _Right
-- @
--
-- >>> mapRight (*2) (Left "hello")
-- Left "hello"
--
-- >>> mapRight (*2) (Right 4)
-- Right 8
mapRight :: (b -> c) -> Either a b -> Either a c
mapRight = mapBoth id

-- | The 'whenLeft' function takes an 'Either' value and a function which returns a monad.
-- The monad is only executed when the given argument takes the form @'Left' _@, otherwise
-- it does nothing.
--
-- Using @Control.Lens@:
--
-- @
-- 'whenLeft' ≡ forOf_ _Left
-- @
--
-- >>> whenLeft (Left 12) print
-- 12
whenLeft :: Applicative m => Either a b -> (a -> m ()) -> m ()
whenLeft (Left x) f = f x
whenLeft _        _ = pure ()

-- | The 'whenRight' function takes an 'Either' value and a function which returns a monad.
-- The monad is only executed when the given argument takes the form @'Right' _@, otherwise
-- it does nothing.
--
-- Using @Data.Foldable@:
--
-- @
-- 'whenRight' ≡ 'forM_'
-- @
--
-- Using @Control.Lens@:
--
-- @
-- 'whenRight' ≡ forOf_ _Right
-- @
--
-- >>> whenRight (Right 12) print
-- 12
whenRight :: Applicative m => Either a b -> (b -> m ()) -> m ()
whenRight (Right x) f = f x
whenRight _         _ = pure ()

-- | A synonym of 'whenRight'.
unlessLeft :: Applicative m => Either a b -> (b -> m ()) -> m ()
unlessLeft = whenRight

-- | A synonym of 'whenLeft'.
unlessRight :: Applicative m => Either a b -> (a -> m ()) -> m ()
unlessRight = whenLeft

-- | Extract the left value or a default.
--
-- @
-- 'fromLeft' ≡ 'either' 'id'
-- @
--
-- >>> fromLeft "hello" (Right 42)
-- "hello"
--
-- >>> fromLeft "hello" (Left "world")
-- "world"
fromLeft :: a -> Either a b -> a
fromLeft _ (Left x) = x
fromLeft x _ = x

-- | Extract the right value or a default.
--
-- @
-- 'fromRight' b ≡ 'either' b 'id'
-- @
--
-- >>> fromRight "hello" (Right "world")
-- "world"
--
-- >>> fromRight "hello" (Left 42)
-- "hello"
fromRight :: b -> Either a b -> b
fromRight _ (Right x) = x
fromRight x _ = x

-- | Maybe get the 'Left' side of an 'Either'.
--
-- @
-- 'leftToMaybe' ≡ 'either' 'Just' ('const' 'Nothing')
-- @
--
-- Using @Control.Lens@:
--
-- @
-- 'leftToMaybe' ≡ preview _Left
-- 'leftToMaybe' x ≡ x^?_Left
-- @
--
-- >>> leftToMaybe (Left 12)
-- Just 12
--
-- >>> leftToMaybe (Right 12)
-- Nothing
leftToMaybe :: Either a b -> Maybe a
leftToMaybe = either Just (const Nothing)

-- | Maybe get the 'Right' side of an 'Either'.
--
-- @
-- 'rightToMaybe' ≡ 'either' ('const' 'Nothing') 'Just'
-- @
--
-- Using @Control.Lens@:
--
-- @
-- 'rightToMaybe' ≡ preview _Right
-- 'rightToMaybe' x ≡ x^?_Right
-- @
--
-- >>> rightToMaybe (Left 12)
-- Nothing
--
-- >>> rightToMaybe (Right 12)
-- Just 12
rightToMaybe :: Either a b -> Maybe b
rightToMaybe = either (const Nothing) Just

-- New functions / Renamed functions -----------------------------------------

-- | Force a right value, or otherwise fail with provided error message
--
-- > fromRightNote err = either (error err) id
fromRightNote :: String -> Either a b -> b
fromRightNote err = either (error err) id

-- | Force a left value, or otherwise fail with provided error message
--
-- > fromLeftNote err = either id (error err)
fromLeftNote :: String -> Either a b -> a
fromLeftNote err = either id (error err)

-- | Force a right value, providing a default value if the Either is Left
fromEither :: b -> Either a b -> b
fromEither _ (Right x) = x
fromEither x _ = x

-- | Extract the first element of a list as a Right value, or else use the
-- default value provided as a Left value
listToEither :: a -> [b] -> Either a b
listToEither def = maybeToEither def . listToMaybe

-- | Extracts the right value of an either to a singleton list, or an
-- empty list if the Either value is a Left
--
-- /Note/: A Left value is lost in the convertion.
eitherToList :: Either a b -> [b]
eitherToList = either (const []) singleton

-- | The 'catEithers' function takes a list of 'Either's and returns
-- a list of all the 'Right' values.
--
-- This is just an alias for 'rights', defined in @Data.Either@
--
-- @
-- 'catEithers' = 'rights'
-- @
--
catEithers :: [Either a b] -> [b]
catEithers = rights

-- | The 'mapEither' function is a version of 'map' which can throw
-- out elements.  In particular, the functional argument returns
-- something of type @'Either' a b@.  If this is 'Left a', no element
-- is added on to the result list.  If it just @'Right' b@, then @b@ is
-- included in the result list.
--
-- > mapEither f = rights . map f
mapEither :: (a -> Either b c) -> [a] -> [c]
mapEither f = catEithers . map f

-- | Convert a Maybe value to an Either value, with the provided default used
-- as Left value if the Maybe value is Nothing
maybeToEither :: a -> Maybe b -> Either a b
maybeToEither def = maybe (Left def) Right

-- | Convert an Either value to a Maybe value
--
-- This function is provided with a different name convention on
-- @Data.Either.Combinators@:
--
-- @
-- 'eitherToMaybe' = 'rightToMaybe'
-- @
--
eitherToMaybe :: Either a b -> Maybe b
eitherToMaybe = either (const Nothing) Just


-- | eitherToMonoid extract the right sided monoid into a single monoid
-- value, or mempty in the case of a left value.
--
-- > eitherToMonoid = either mempty id
eitherToMonoid :: (Monoid b) => Either a b -> b
eitherToMonoid = either mempty id

-- | monoidToEither extracts a non-empty value to the right side, or
-- otherwise fills the 'Left' side with the provided value.
monoidToEither :: (Eq b, Monoid b) => a -> b -> Either a b
monoidToEither def = monoid (Left def) Right

-- | Case analysis for a either monoid. If the right side of the monoid
-- is @'mempty'@, then the value is transformed to a left value, using
-- the provided function.
joinEitherMonoid :: (Eq b, Monoid b) => a -> Either a b -> Either a b
joinEitherMonoid emptErr = either Left (monoidToEither emptErr)

------------------------------------------------------------------------------
-- Lists ---------------------------------------------------------------------
------------------------------------------------------------------------------

-- | Apply a function to a non-empty list, and retrieve its result
-- or the default provided value if the list is empty.
list :: b -> ([a] -> b) -> [a] -> b
list def f lst = if null lst then def else f lst
-- could be list = monoid, but would have to add Eq restriction

-- | Alias for @'not'@.@'null'@
{-# INLINE isFilled #-}
isFilled :: [a] -> Bool
isFilled = not . null

-- | Alias for 'not' . 'null' . Yeah, it saves 3 characters.
--
-- > notNull = not . null
{-# INLINE notNull #-}
notNull :: [a] -> Bool
notNull = not . null

-- | Alias for null
{-# INLINE isNull #-}
isNull :: [a] -> Bool
isNull = null

-- | Similar to @'headNote'@ from "Safe" package
-- However, no text is added to the provided string error,
-- for more deterministic error messages transparency.
fromHeadNote :: String -> [a] -> a
fromHeadNote err []  = error err
fromHeadNote _ (x:_) = x

-- | Returns the first value of a list if not empty, or the
-- provided default value if the list is empty
fromList :: a -> [a] -> a
fromList = headDef

-- | Alias for @'catMonoid'@.
catLists :: (Eq a) => [[a]] -> [[a]]
catLists = catMonoids

-- | Alias for concatMap
mapList :: (a -> [b]) -> [a] -> [b]
mapList = concatMap

-- | Insert a single value into a list
--
-- > singleton = return
--
-- or
--
-- > singleton = (:[])
{-# INLINE singleton #-}
singleton :: a -> [a]
singleton = return

-- | map a value over a list of functions, and return a list of values
--
-- /See/: <http://www.haskell.org/pipermail/haskell-cafe/2007-February/022694.html>
--
-- @
-- /Alternative 1/: mapV value = map ($ value)
-- @
--
-- @
-- /Alternative 2/: mapV value lst = sequence lst value
-- @
--
mapV :: a -> [a -> b] -> [b]
mapV value = map ($ value)

-- | Sort and nub (remove duplicates) from a list.
-- Specially for large lists, this is much more efficient than @nub . sort@.
--
-- /Note/: You shold probably be using "Data.Set".
--
-- > nubSort = Set.toAscList . Set.fromList
--
nubSort :: (Ord a) => [a] -> [a]
nubSort = Set.toAscList . Set.fromList

-- | Sort, nub (remove duplicates) and remove initial empty value, if it
-- exists. See 'nubSort'.
nubSort' :: (Ord a, Monoid a) => [a] -> [a]
nubSort' lst = case nubSort lst of
  []     -> []
  (x:xs) -> if isEmpty x then xs else x:xs

-- | Lazy length: determine if a list has a given size without computing
-- all of its elements.
--
-- See <http://www.haskell.org/haskellwiki/Haskell_programming_tips>
atLeast :: Int -> [a] -> Bool
atLeast 0 _      = True
atLeast _ []     = False
atLeast n (_:ys) = atLeast (n-1) ys

------------------------------------------------------------------------------
-- Tuple Pair ----------------------------------------------------------------
-- Monoid class restriction will be used when applicable ---------------------
------------------------------------------------------------------------------

-- | Case evaluation for a tuple pair, 'reducing' it to a single value
pair :: (Monoid c) => (a -> c) -> (b -> c) -> (a,b) -> c
pair f g (a,b) = f a `mappend` g b

-- | Case evaluation for single type tuple pairs, simplification of 'pair'.
pairS :: (Monoid b) => (a -> b) -> (a,a) -> b
pairS f (a,b) = f a `mappend` f b

-- | Is the pair tuple \'valid\', i.e., does it have at least one
-- non-empty (monoid) value?
isPairNotEmpty :: (Eq a, Monoid a, Eq b, Monoid b) => (a, b) -> Bool
isPairNotEmpty (x,y) = isNotEmpty x || isNotEmpty y
--
-- | Is the pair tuple \'invalid\', i.e., are both (monoid) elements
-- 'mempty'?
isPairEmpty :: (Eq a, Monoid a, Eq b, Monoid b) => (a, b) -> Bool
isPairEmpty (x,y) = isEmpty x && isEmpty y

-- | Longer (??) alias for 'fst'.
--
-- /Note/: included just for \'consistency\' with the rest of the API.
-- Use @'fst'@.
fromFst :: (a,b) -> a
fromFst = fst

-- | Longer (??) alias for 'snd'.
fromSnd :: (a,b) -> b
--
-- /Note/: included just for \'consistency\' with the rest of the API.
-- Use @'snd'@.
fromSnd = snd

-- | 'mappend' the two monoid elements of a pair
fromPairNote :: (Eq a, Monoid a) => String -> (a,a) -> a
fromPairNote err (a,b) = fromMonoid (error err) (a `mappend` b)

-- | 'mappend' the two monoid elements of a pair
fromPair :: (Eq a, Monoid a) => a -> (a,a) -> a
fromPair def (a,b) = fromMonoid def (a `mappend` b)

-- | listToPair grabs the two first elements of a list, and inserts them
-- into a tuple. If not enough elements are available, raise the provided
-- error.
listToPairNote :: String -> [a] -> (a,a)
listToPairNote err []     = error err
listToPairNote err (_:[]) = error err
listToPairNote _ (x:y:_)  = (x,y)

-- | Groups the elements of a list two by two, also returning the (possible)
-- unpaired item not grouped.
listToPairs :: [a] -> ([(a,a)],[a])
listToPairs [] = ([],[])
listToPairs (x:[]) = ([],[x])
listToPairs (x0:x1:xs) = ( (x0,x1):(fst . listToPairs $ xs)
                          , snd . listToPairs $ xs)

-- | Similar to 'listToPairs', but discards the (possible) unpaired item.
group2 :: [a] -> [(a,a)]
group2 = fst . listToPairs

-- | Convert a single type pair into a two elements list
pairToList :: (a,a) -> [a]
pairToList (a,b) = [a,b]

-- | 'mappend' each pair in a list into a single value, and filter out
-- 'mempty' values
catPairs :: (Eq a, Monoid a) => [(a,a)] -> [a]
catPairs = mapMonoid (fromPair mempty)

-- | Applies a pair returning function to each list element,
-- and keeps only the non-empty mappend results (between the pair elements).
mapPair :: (Eq b, Monoid b) => (a -> (b,b)) -> [a] -> [b]
mapPair f = catPairs . fmap f

-- | Transform a pair into an either.
-- We adopt the convention that the second value is the one of interest.
-- It is matched against @'mempty'@, and if equal the first value is returned
-- as a @'Left'@ value.
pairToEither :: (Eq b, Monoid b) => (a,b) -> Either a b
pairToEither (a,b) = if isEmpty b then Left a else Right b

-- | Transform a pair into an either.
-- The same as 'pairToEither', but the first tuple element is considered.
pairToEither' :: (Eq a, Monoid a) => (a,b) -> Either b a
pairToEither' (a,b) = if isEmpty a then Left b else Right a

-- | Transform a pair into an either.
-- Both values are checked for a valid monoid (non-empty).
-- The first to be found is returned as a Right value.
-- If none is found, a default value is returned.
pairBothToEither :: (Eq a, Monoid a) => b -> (a,a) -> Either b a
pairBothToEither def (a,b) = monoid (monoid (Left def) Right b) Right a


-- | Transform an @'Either'@ value into a pair. This follows the same
-- convention as @'pairToEither'@, and thus transforms a @'Left' value@
-- into a @('Left' value,'mempty')@, and a @'Right' value@ into a @(def, value)@.
eitherToPair :: Monoid b => a -> Either a b -> (a, b)
eitherToPair def = either (\lft -> (,) lft mempty) ((,) def)

-- | Transform an @'Either'@ value into a pair. This follows the same
-- convention as @'pairToEither''@, and thus transforms a @'Left' value@
-- into a @('mempty', 'Left' value)@, and a @'Right' value@ into a @(value, def)@.
eitherToPair' :: Monoid a => b -> Either b a -> (a, b)
eitherToPair' def = either ((,) mempty) (\rgt -> (,) rgt def)

-- | Transform a pair onto a @'Maybe'@
-- This function follows the same convention as @'pairToEither'@, and thus
-- the second value is considered the most important one, and as such
-- will take precedence over the first if both are not empty.
-- If you prefer the first value to take precedence, see @'pairToMaybe''@.
-- If both elements of the pair are @'mempty'@, this function returns @'Nothing'@.
--
-- /Note/: the reciprocal of this function is @'pairToMaybe'@.
--
-- > pairToMaybe = monoid (monoid Nothing Just a) Just b
pairToMaybe :: (Eq a, Monoid a) => (a,a) -> Maybe a
pairToMaybe (a,b) = monoid (monoid Nothing Just a) Just b

-- | Transform a pair onto a @'Maybe'@
-- If both the values are non-empty, the first one is returned wrapped in
-- a Just. If just one value is not-empty, that value is returned,
-- irrespectively if it is the first or second.
-- Otherwise, this function returns Nothing.
--
-- /Note/: the reciprocal of this function is @'pairToMaybe'@.
--
-- > pairToMaybe' = monoid (monoid Nothing Just b) Just a
pairToMaybe' :: (Eq a, Monoid a) => (a,a) -> Maybe a
pairToMaybe' (a,b) = monoid (monoid Nothing Just b) Just a


-- | Transform the first element of a pair (if it is a monoid) into an @'Maybe'@.
-- Reciprocal to @'pairSndToMaybe'@.
--
-- > pairToMaybe' = monoitToMaybe . fst
pairFstToMaybe :: (Eq a, Monoid a) => (a,b) -> Maybe a
pairFstToMaybe = monoidToMaybe . fst


-- | Transform the second element of a pair (if it is a monoid) into a @'Maybe'@.
-- Reciprocal to @'pairFstToMaybe'@.
--
-- > pairToMaybe = monoitToMaybe . snd
pairSndToMaybe :: (Eq b, Monoid b) => (a,b) -> Maybe b
pairSndToMaybe = monoidToMaybe . snd

-- | Transform a @'Maybe'@ value into a pair. This follows the same
-- convention as @'pairToMaybe'@, and thus transforms a @'Nothing'@
-- into a @(def, 'mempty')@, and a @'Just' value@ into a @(def, value)@.
--
maybeToPair :: Monoid b => a -> Maybe b -> (a, b)
maybeToPair def = maybe (def,mempty) ((,) def)

-- | Transform a @'Maybe'@ value into a pair. This follows the same
-- convention as @'pairToMaybe''@, and thus transforms a @'Nothing'@
-- into a @('mempty', def)@, and a @'Just' value@ into a @(value,def)@.
--
maybeToPair' :: Monoid a => b -> Maybe a -> (a, b)
maybeToPair' def = maybe (mempty,def) (\jst -> (,) jst def)

-- | Finds the first non-empty monoid in a pair, and returns it.
-- If none found, returns @'mempty'@.
--
-- /Note/: reciprocal to @'pairToMonoid''@
pairToMonoid :: (Eq a, Monoid a) => (a,a) -> a
pairToMonoid (a,b) = fromMonoid (fromMonoid mempty b) a

-- | Finds the last non-empty monoid in a pair, and returns it.
-- If none found, returns @'mempty'@.
pairToMonoid' :: (Eq a, Monoid a) => (a,a) -> a
pairToMonoid' (a,b) = fromMonoid (fromMonoid mempty a) b

------------------------------------------------------------------------------
-- Tuple Triple --------------------------------------------------------------
-- Monoid class restriction will be used when applicable ---------------------
------------------------------------------------------------------------------

-- | Case evaluation for a tuple triple, 'reducing' it to a single value
triple :: (Monoid d) => (a -> d) -> (b -> d) -> (c -> d) -> (a,b,c) -> d
triple f g h (a,b,c) = mconcat [f a, g b, h c]

-- | Case evaluation for single type tuple triples, simplification of 'triple'.
tripleS :: (Monoid b) => (a -> b) -> (a,a,a) -> b
tripleS f (a,b,c) = mconcat [f a, f b, f c]

-- | Is the triple tuple \'valid\', i.e., does it have at least one
-- non-empty (monoid) value?
isTripleNotEmpty
  :: (Eq a, Monoid a, Eq b, Monoid b, Eq c, Monoid c)
  => (a, b, c)
  -> Bool
isTripleNotEmpty (x,y,z)
  = isNotEmpty x || isNotEmpty y || isNotEmpty z
--
-- | Is the pair tuple \'invalid\', i.e., are both (monoid) elements
-- 'mempty'?
isTripleEmpty
  :: (Eq a, Monoid a, Eq b, Monoid b, Eq c, Monoid c)
  => (a, b, c)
  -> Bool
isTripleEmpty (x,y,z)
  = isEmpty x && isEmpty y && isEmpty z

-- | Extract the first element from a triple
fromFst' :: (a,b,c) -> a
fromFst' (a,_,_) = a

-- | Alias for fromFst' (extract the first element of a triple).
fst' :: (a, b, c) -> a
fst' = fromFst'

-- | Extract the second element from a triple
fromSnd' :: (a,b,c) -> b
fromSnd' (_,a,_) = a

-- | Alias for fromSnd' (extract the second element of a triple).
snd' :: (a, b, c) -> b
snd' = fromSnd'

-- | Extract the third element from a triple
fromTrd' :: (a,b,c) -> c
fromTrd' (_,_,a) = a

-- | Alias for 'fromTrd''
trd' :: (a,b,c) -> c
trd' = fromTrd'

-- | 'mappend' the two monoid elements of a pair
fromTripleNote :: (Eq a, Monoid a) => String -> (a,a,a) -> a
fromTripleNote err (a,b,c) = fromMonoid (error err)
                                        (a `mappend` b `mappend` c)

-- | 'mappend' the three monoid elements of a triple
fromTriple :: (Eq a, Monoid a) => a -> (a,a,a) -> a
fromTriple def (a,b,c) = fromMonoid def (mconcat [a,b,c])

-- | listToTriple grabs the two three elements of a list, and inserts them
-- into a triple tuple. If not enough elements are available, raise the
-- provided error.
listToTripleNote :: String -> [a] -> (a,a,a)
listToTripleNote err []      = error err
listToTripleNote err (_:[])  = error err
listToTripleNote err (_:_:[])= error err
listToTripleNote _ (x:y:z:_) = (x,y,z)

-- | Groups the elements of a list three by three, also returning the
-- (possible) remaining item(s) (not grouped).
listToTriples :: [a] -> ([(a,a,a)],[a])
listToTriples []        = ([],[])
listToTriples (x:[])    = ([],[x])
listToTriples (x0:x1:[])= ([],[x0,x1])
listToTriples (x0:x1:x2:xs)
  = ( (x0,x1,x2):(fst . listToTriples $ xs)
    , snd . listToTriples $ xs)

-- | Similar to 'listToTriples', but discards the (possible) remaining item(s).
group3 :: [a] -> [(a,a,a)]
group3 = fst . listToTriples

-- | Convert a single type triple tuple into a three elements list
tripleToList :: (a,a,a) -> [a]
tripleToList (a,b,c) = [a,b,c]

-- | 'mappend' each triple in a list into a single value, and filter out
-- 'mempty' values
catTriples :: (Eq a, Monoid a) => [(a,a,a)] -> [a]
catTriples = mapMonoid (fromTriple mempty)
-- TODO

-- | Apply the provided function to each list element resulting in a triple,
-- and keep only the non-empty monoids concat results.
mapTriple :: (Eq b, Monoid b) => (a -> (b,b,b)) -> [a] -> [b]
mapTriple f = catTriples . fmap f

-- | Pair to Triple, inserting the missing element in first place
--
-- > toFstPairToTriple x (y,z) = (x,y,z)
toFstPairToTriple :: a -> (b, c) -> (a, b, c)
toFstPairToTriple x (y, z) = (x, y, z)

-- | Pair to Triple, inserting the missing element in second place
--
-- > toSndPairToTriple y (x, z) = (x, y, z)
toSndPairToTriple :: b -> (a, c) -> (a, b, c)
toSndPairToTriple y (x, z) = (x, y, z)

-- | Pair to Triple, inserting the missing element in third place
--
-- > toTrdPairToTriple z (x, y) = (x, y, z)
toTrdPairToTriple :: c -> (a, b) -> (a, b, c)
toTrdPairToTriple z (x, y) = (x, y, z)

-- | Alias for toTrdPairToTriple
pairToTriple :: c -> (a, b) -> (a, b, c)
pairToTriple = toTrdPairToTriple

-- | Triple to pair, removing the first element.
--
-- > \(_,y,z) -> (y,z)
dropFstTripleToPair :: (a,b,c) -> (b,c)
dropFstTripleToPair (_,y,z) = (y,z)

-- | Triple to pair, removing the second element.
--
-- > \(x,_,z) -> (x,z)
dropSndTripleToPair :: (a,b,c) -> (a,c)
dropSndTripleToPair (x,_,z) = (x,z)

-- | Triple to pair, removing the third element.
--
-- > \(x,y,_) -> (x,y)
dropTrdTripleToPair :: (a,b,c) -> (a,b)
dropTrdTripleToPair (x,y,_) = (x,y)

-- | Alias for 'dropTrdTripleToPair'.
tripleToPair :: (a, b, c) -> (a, b)
tripleToPair = dropTrdTripleToPair

-- | Triple to Maybe. Analogous to @'pairToMaybe'@, it keeps the first
-- non-empty monoid value.
tripleToMaybe :: (Eq a, Monoid a) => (a,a,a) -> Maybe a
tripleToMaybe (a,b,c)
  = monoid (monoid (monoid Nothing Just c) Just b) Just a

-- | Triple to Maybe. Analogous to @'pairToMaybe''@, it keeps the last
-- non-empty monoid value.
tripleToMaybe' :: (Eq a, Monoid a) => (a,a,a) -> Maybe a
tripleToMaybe' (a,b,c)
  = monoid (monoid (monoid Nothing Just a) Just b) Just c

-- | Triple to Monoid. Analogous to @'pairToMonoid'@, it keeps the first
-- non-empty monoid value.
tripleToMonoid :: (Eq a, Monoid a) => (a,a,a) -> a
tripleToMonoid (a,b,c)
  = fromMonoid (fromMonoid (fromMonoid mempty c) b) a

-- | Triple to Maybe. Analogous to @'pairToMonoid''@, it keeps the last
-- non-empty monoid value.
tripleToMonoid' :: (Eq a, Monoid a) => (a,a,a) -> a
tripleToMonoid' (a,b,c)
  = fromMonoid (fromMonoid (fromMonoid mempty a) b) c


curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d
curry3 f a b c = f (a,b,c)
{-# INLINE curry3 #-}

uncurry3 :: (a -> b -> c -> d) -> ((a, b, c) -> d)
uncurry3 f ~(a,b,c) = f a b c
{-# INLINE uncurry3 #-}

------------------------------------------------------------------------------
-- Monoid --------------------------------------------------------------------
------------------------------------------------------------------------------

-- | Apply a function to a non-empty monoid, and retrieve its result
-- or the default provided value if the monoid is mempty.
monoid :: (Monoid a, Eq a) => b -> (a -> b) -> a -> b
monoid def f mon = if isEmpty mon then def else f mon

-- | Check that a monoid is not mempty
{-# INLINE isNotEmpty #-}
isNotEmpty :: (Monoid a, Eq a) => a -> Bool
isNotEmpty = (/=) mempty

-- | Alias for @'isNotEmpty'@.
{-# INLINE notEmpty #-}
notEmpty :: (Monoid a, Eq a) => a -> Bool
notEmpty = isNotEmpty

-- | Check it is mempty
{-# INLINE isEmpty #-}
isEmpty :: (Monoid a, Eq a) => a -> Bool
isEmpty = (==) mempty

-- | fromNotEmptyNote keeps the monoid value if it is not empty,
-- otherwise it raises an error with the provided message.
--
-- /Note/: This differs from @fromJust@ in the sense it is not possible
-- to extract values from monoid
fromNotEmptyNote :: (Eq a, Monoid a) => String -> a -> a
fromNotEmptyNote err mon = if isEmpty mon then error err else mon

-- | fromMonoid keeps the monoid value if it is not empty,
-- otherwise it replaces it with the provided default value
--
-- /Note/: No check is made to see if default value is itself mempty
--
-- /Note/: This differs from @fromMaybe@ in the sense it is not possible
-- to extract values from monoid
--
-- /Note/: similar to @flip <|>@ for the appropriate types.
--
fromMonoid :: (Eq a, Monoid a) => a -> a -> a
fromMonoid def mon = if isEmpty mon then def else mon

-- | Infix fromMonoid. Equivalent to higher order ternary operator,
-- similar to python @if@ in expressions
--
-- Example usage:
--
-- > let x = valueThatCanBeEmpty ?+ defaultValue
infixr 1 ?+
(?+) :: (Eq a, Monoid a) => a -> a -> a
mon ?+ def = fromMonoid def mon

-- | Monoid choice operator.
-- See (obligatory reading, even if you don't understand it at first):
-- <http://stackoverflow.com/questions/13080606/confused-by-the-meaning-of-the-alternative-type-class-and-its-relationship-to>
--
-- This operator implements 'Alternative' like choice operator to 'Monoid's.
--
infixl 3 <!>
(<!>) :: (Eq a, Monoid a) => a -> a -> a
mon0 <!> mon1 = if isEmpty mon0 then mon1 else mon0


-- | listToMonoid extracts the first element from a monoid list
-- into a single monoid, or returns mempty if the list is empty
--
-- /Note/: This differs from @listToMaybe@ in the sense it is not possible
-- to promote values into a monoid
--
-- > listToMonoid = headDef mempty
listToMonoid :: (Monoid a) => [a] -> a
listToMonoid = headDef mempty

-- | monoidToList convert an empty monoid into an empty list,
-- otherwise it creates a singleton list with the monoid inside
--
-- /Note/: This differs from @maybeToList@ in the sense it is not possible
-- to extract the value from a monoid
--
-- > monoidToList = monoid [] singleton
monoidToList :: (Eq a, Monoid a) => a -> [a]
monoidToList = monoid [] singleton

-- | Filter out all empty monoids from a list.
--
-- > catMonoids = filter isNotEmpty
catMonoids :: (Eq a, Monoid a) => [a] -> [a]
catMonoids = filter isNotEmpty

-- | Alias for @'catMonoids'@.
nonEmpty :: (Eq a, Monoid a) => [a] -> [a]
nonEmpty = catMonoids

-- | Apply a function that returns a monoid to all elements of a list
-- and return a new list with only not mempty results.
--
-- /Note/: This differs from @mapMaybe@ in the sense it is not possible
-- to extract the value from a monoid.
mapMonoid :: (Eq b, Monoid b) => (a -> b) -> [a] -> [b]
mapMonoid _ [] = []
mapMonoid f (x:xs) =
  let rs = mapMonoid f xs in
  if isEmpty (f x) then rs else f x:rs

-- | Get the first non-empty element from a list. If all elements are 'mempty',
-- or the list is empty, it returns 'mempty'.
-- /Note/: A newtype based solution as done by maybe in "Data.Monoid" will
-- always be more efficient than this, so this is not really recommend.
-- However, it might come handy in some non-critical code.
getFirst' :: (Eq a, Monoid a) => [a] -> a
getFirst' = maybeToMonoid . L.find isNotEmpty

-- | Get the last non-empty element from a list. If all elements are 'mempty',
-- or the list is empty, it returns 'mempty'.
-- /Note/: A newtype based solution as done by maybe in "Data.Monoid" will
-- always be more efficient than this, so this is not really recommend.
-- However, it might come handy in some non-critical code.
getLast' :: (Eq a, Monoid a) => [a] -> a
getLast' = foldr (\x a -> if isNotEmpty a then a else x) mempty

-- | A @'head'@ that fails returning @'mempty'@.
-- Gets the first element of a foldable stucture of monoids.
--
-- Returns @'mempty'@ if the structure is empty.
headF :: (F.Foldable t, Monoid a) => t a -> a
headF = headDef mempty . F.toList

-- | A @'last'@ that fails returning @'mempty'@.
-- Gets the last element of a foldable stucture of monoids.
-- Returns @'mempty'@ if the structure is empty.
--
-- /Note/: this function starts by mapping the foldable structure to a list...
lastF :: (F.Foldable t, Monoid a) => t a -> a
lastF = lastDef mempty . F.toList

-- | A @'(!!)'@ that fails returning @'mempty'@.
--
-- /Note/: this function starts by mapping the foldable structure to a list...
atF :: (F.Foldable t, Monoid a) => t a -> Int -> a
atF lst index = flip (atDef mempty) index . F.toList $ lst

-- | Infix version of @'atF'@.
infixl 9 @@
(@@) :: (F.Foldable t, Monoid a) => t a -> Int -> a
lst @@ index = flip (atDef mempty) index . F.toList $ lst

------------------------------------------------------------------------------
-- Boolean -------------------------------------------------------------------
------------------------------------------------------------------------------

-- | fromBool is a 'if' rewrite following the call convention of fromMaybe.
fromBool :: a -> Bool -> a -> a
fromBool def b value = if b then value else def

-- | fromBoolC is similar to 'fromBool', but it takes a condition rather
-- than a simple boolean value
fromBoolC :: a -> (a -> Bool) -> a -> a
fromBoolC def f value = if f value then value else def

-- | Cat bools. Filter out False values from a list. Probably useless.
--
-- > catBools = filter id
catBools :: [Bool] -> [Bool]
catBools = filter id

-- catBoolsC == filter

-- | Ternary operator. Use like this:
--
-- > (i > 0) ? i $ 1
--
-- /Note/: this is non-idiomatic haskell. Use at your own risk.
--
-- /Note/: this may require additional parenthesis, so it may not be worth it.
infixr 1 ?
(?) :: Bool -> a -> a -> a
True ? x = const x
False ? _ = id

-- | Higher order ternary operator. Use like this:
--
-- > (not . null) ?$ "" $ "default value"
--
-- /Note/: this is non-idiomatic haskell. Use at your own risk.
infixr 1 ?$
(?$) :: (a -> Bool) -> a -> a -> a
f ?$ x = f x ? x

-- | Higher order ternary operator, similar to python @if@ in expressions.
-- Use like this:
--
-- > "" ?| (not . null) $ "default value"
--
-- /Note/: this is non-idiomatic haskell. Use at your own risk.
infixr 1 ?|
(?|) :: a -> (a -> Bool) -> a -> a
x ?| f = f x ? x

-- | Provided a default value, apply it to a maybe if the predicate holds
boolToMaybe :: a -> Bool -> Maybe a
boolToMaybe value cond = if cond then Just value else Nothing

-- | Same as boolToMaybe, but with a more familiar 'if-like' syntax
ifToMaybe :: Bool -> a -> Maybe a
ifToMaybe = flip boolToMaybe

-- | Test a value with a function returning a Bool, and apply it to a Maybe
--   accordingly.
boolCToMaybe :: a -> (a -> Bool) -> Maybe a
boolCToMaybe value f = if f value then Just value else Nothing

-- | Same as boolCToMaybe, but with a more familiar 'if-like' syntax
ifCToMaybe :: (a -> Bool) -> a -> Maybe a
ifCToMaybe = flip boolCToMaybe

-- | Provided two values, choose amongst them based on a 'Bool' value.
--
-- > \l r b = if b then Right r else Left l
boolToEither :: a -> b -> Bool -> Either a b
boolToEither l r b = if b then Right r else Left l

-- | Provided two values, choose amongst them based on a the provided
-- test on the second value.
--
-- > \l r f = if f r then Left l else Right r
boolCToEither :: a -> b -> (b -> Bool) -> Either a b
boolCToEither l r f = if f r then Right r else Left l

-- | Insert the provided value into a list if the 'Bool' value is 'True',
-- otherwise return an empty list.
boolToList :: a -> Bool -> [a]
boolToList value b = fromBool [] b [value]

-- | Insert the provided value into a list if the provided condition is
-- 'True', otherwise return an empty list.
--
-- Use a list comprehension instead:
--
-- > [value | f value]
boolCToList :: a -> (a -> Bool) -> [a]
boolCToList value f = [value | f value]


-- | Keep the provided value if the 'Bool' value is 'True', 'mempty'
-- otherwise.
boolToMonoid :: (Monoid a) => a -> Bool -> a
boolToMonoid value b = if b then value else mempty

-- | Keep the provided value if the 'Bool' value is 'True', 'mempty'
-- otherwise.
boolCToMonoid :: (Monoid a) => a -> (a -> Bool) -> a
boolCToMonoid value f = if f value then value else mempty


-- | Emulates @and@,@&&@ and @or@,@||@ from scripting languages like python,
-- in the sense you can mix booleans with a value to get the value when
-- the boolean is true (or 'mempty' otherwise).
--
-- However, in order to allow several @'?&&'@ in a row, the order
-- is not the one normally used in languages like bash, where the test comes
-- first.
--
-- /Usage/:
--
-- > value ?&& bool1 ?&& bool2 ?&& ...
--
-- /Note/: this is non-idiomatic haskell. Use at your own risk.
-- You should instead use the following code :
--
-- > if bool1 && bool2 && ...  then value else mempty
--
-- Or better yet:
--
-- > if and [bool1,bool2,...] then value else mempty
infixl 1 ?&&
(?&&) :: (Monoid a) => a -> Bool -> a
(?&&) = boolToMonoid

-- | Emulates @and@,@&&@ and @or@,@||@ from scripting languages like python,
-- in the sense you can mix boolean tests with a value to get the original
-- value when all the tests return true (or 'mempty' otherwise).
--
-- However, in order to allow several @'??&&'@ in a row, the order
-- is not the one normally used in languages like bash, where the test comes
-- first.
--
-- /Note/: an easy mnemonic to remember is that operators ending in \\ (lambda)
-- imply that their parameters are functions instead of values (in this particular
-- case, boolean tests)
--
-- /Usage/:
--
-- > value ?&&\ condition1 ?&&\ condition2 ?&&\ ...
--
-- /Note/: this is non-idiomatic haskell. Use at your own risk.
(?&&\) :: (Monoid a) => a -> (a -> Bool) -> a
(?&&\) value f = if f value then value else mempty
infixl 1 ?&&\{-This comment teaches CPP correct behaviour -}

-- ?||
-- Just use: ?&& value (bool1 || bool2 || ... )
--       or: ?&& value $ or [bool1,bool2,...]

-- ?$||
-- Just use: anyCond value [cond1, cond2,...]

-- | Apply a list of boolean checks/tests to a variable, and return (True)
-- if /all/ of them passed.
--
-- /Note/: See 'All' in "Data.Monoid" and 'all' in "Prelude" for reference.
--
-- /See/: <http://www.haskell.org/pipermail/haskell-cafe/2007-February/022694.html>
allCond :: a -> [a -> Bool] -> Bool
allCond _ [] = False
allCond value lst = and . mapV value $ lst

-- | Apply a list of boolean checks/tests to a variable, and return (True)
-- if /any/ of them passed.
--
-- /Note/: See 'Any' in "Data.Monoid" and 'any' in "Prelude" for reference.
--
-- /See/: <http://www.haskell.org/pipermail/haskell-cafe/2007-February/022694.html>
{-# INLINE anyCond #-}
anyCond :: a -> [a -> Bool] -> Bool
anyCond _ [] = False
anyCond value lst = or . mapV value $ lst