-----------------------------------------------------------------------------
-- |
-- Module      :  Data.FMList
-- Copyright   :  (c) Sjoerd Visscher 2009
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  sjoerd@w3future.com
-- Stability   :  experimental
-- Portability :  portable
--
-- FoldMap lists: lists represented by their 'foldMap' function.
--
-- Examples:
--
-- > -- A right-infinite list
-- > c = 1 `cons` c
--
-- > -- A left-infinite list
-- > d = d `snoc` 2
--
-- > -- A middle-infinite list ??
-- > e = c `append` d
--
-- > *> head e
-- > 1
-- > *> last e
-- > 2
-----------------------------------------------------------------------------
{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}


module Data.FMList (

    FMList(..)
  , transform

  -- * Construction
  , empty
  , singleton
  , cons
  , snoc
  , pair
  , append

  , fromList
  , fromFoldable

  -- * Basic functions
  , null
  , length
  , genericLength

  , head
  , tail
  , last
  , init
  , reverse

  -- * Folding
  , toList
  , flatten
  , foldMapA

  , filter
  , take
  , drop
  , takeWhile
  , dropWhile

  , zip
  , zipWith

  -- * Unfolding
  , iterate
  , repeat
  , cycle
  , unfold
  , unfoldr

  ) where

import Prelude
  ( (.), ($), ($!), flip, const, error
  , Either(..), either
  , Bool(..), (&&)
  , Ord(..), Num(..), Int
  , Show(..), String, (++)
  )
import Data.Maybe (Maybe(..), maybe, fromMaybe, isNothing)
import Data.Monoid (Monoid, mempty, mappend, Dual(..), First(..), Last(..), Sum(..))

#if MIN_VERSION_base(4,9,0)
import Data.Semigroup (Semigroup((<>)))
#endif

import Data.Foldable (Foldable, foldMap, foldr, toList)
import Data.Traversable (Traversable, traverse)
import Control.Monad
import Control.Monad.Fail as MF
import Control.Applicative

-- | 'FMList' is a 'foldMap' function wrapped up in a newtype.
--
newtype FMList a = FM { forall a. FMList a -> forall m. Monoid m => (a -> m) -> m
unFM :: forall m . Monoid m => (a -> m) -> m }

-- | The function 'transform' transforms a list by changing
-- the map function that is passed to 'foldMap'.
--
-- It has the following property:
--
-- @transform a . transform b = transform (b . a)@
--
-- For example:
--
--  * @  m >>= g@
--
--  * @= flatten (fmap g m)@
--
--  * @= flatten . fmap g $ m@
--
--  * @= transform foldMap . transform (. g) $ m@
--
--  * @= transform ((. g) . foldMap) m@
--
--  * @= transform (\\f -> foldMap f . g) m@
--
transform :: (forall m. Monoid m => (a -> m) -> (b -> m)) -> FMList b -> FMList a
transform :: forall a b.
(forall m. Monoid m => (a -> m) -> b -> m) -> FMList b -> FMList a
transform forall m. Monoid m => (a -> m) -> b -> m
t (FM forall m. Monoid m => (b -> m) -> m
l) = (forall m. Monoid m => (a -> m) -> m) -> FMList a
forall a. (forall m. Monoid m => (a -> m) -> m) -> FMList a
FM ((b -> m) -> m
forall m. Monoid m => (b -> m) -> m
l ((b -> m) -> m) -> ((a -> m) -> b -> m) -> (a -> m) -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m) -> b -> m
forall m. Monoid m => (a -> m) -> b -> m
t)

-- shorthand constructors
nil          :: FMList a
nil :: forall a. FMList a
nil          = (forall m. Monoid m => (a -> m) -> m) -> FMList a
forall a. (forall m. Monoid m => (a -> m) -> m) -> FMList a
FM (a -> m) -> m
forall a. Monoid a => a
forall m. Monoid m => (a -> m) -> m
mempty

one          :: a -> FMList a
one :: forall a. a -> FMList a
one a
x        = (forall m. Monoid m => (a -> m) -> m) -> FMList a
forall a. (forall m. Monoid m => (a -> m) -> m) -> FMList a
FM ((a -> m) -> a -> m
forall a b. (a -> b) -> a -> b
$ a
x)

(><)         :: FMList a -> FMList a -> FMList a
FM forall m. Monoid m => (a -> m) -> m
l >< :: forall a. FMList a -> FMList a -> FMList a
>< FM forall m. Monoid m => (a -> m) -> m
r = (forall m. Monoid m => (a -> m) -> m) -> FMList a
forall a. (forall m. Monoid m => (a -> m) -> m) -> FMList a
FM ((a -> m) -> m
forall m. Monoid m => (a -> m) -> m
l ((a -> m) -> m) -> ((a -> m) -> m) -> (a -> m) -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> m
forall m. Monoid m => (a -> m) -> m
r)

-- exported constructors
singleton    :: a -> FMList a
singleton :: forall a. a -> FMList a
singleton    = a -> FMList a
forall a. a -> FMList a
one

cons         :: a -> FMList a -> FMList a
cons :: forall a. a -> FMList a -> FMList a
cons a
x FMList a
l     = a -> FMList a
forall a. a -> FMList a
one a
x FMList a -> FMList a -> FMList a
forall a. FMList a -> FMList a -> FMList a
>< FMList a
l

snoc         :: FMList a -> a -> FMList a
snoc :: forall a. FMList a -> a -> FMList a
snoc FMList a
l a
x     = FMList a
l FMList a -> FMList a -> FMList a
forall a. FMList a -> FMList a -> FMList a
>< a -> FMList a
forall a. a -> FMList a
one a
x

pair         :: a -> a -> FMList a
pair :: forall a. a -> a -> FMList a
pair a
l a
r     = a -> FMList a
forall a. a -> FMList a
one a
l FMList a -> FMList a -> FMList a
forall a. FMList a -> FMList a -> FMList a
>< a -> FMList a
forall a. a -> FMList a
one a
r

append       :: FMList a -> FMList a -> FMList a
append :: forall a. FMList a -> FMList a -> FMList a
append       = FMList a -> FMList a -> FMList a
forall a. FMList a -> FMList a -> FMList a
(><)



fromList     :: [a] -> FMList a
fromList :: forall a. [a] -> FMList a
fromList     = [a] -> FMList a
forall (f :: * -> *) a. Foldable f => f a -> FMList a
fromFoldable

fromFoldable :: Foldable f => f a -> FMList a
fromFoldable :: forall (f :: * -> *) a. Foldable f => f a -> FMList a
fromFoldable f a
l = (forall m. Monoid m => (a -> m) -> m) -> FMList a
forall a. (forall m. Monoid m => (a -> m) -> m) -> FMList a
FM ((forall m. Monoid m => (a -> m) -> m) -> FMList a)
-> (forall m. Monoid m => (a -> m) -> m) -> FMList a
forall a b. (a -> b) -> a -> b
$ ((a -> m) -> f a -> m) -> f a -> (a -> m) -> m
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> m) -> f a -> m
forall m a. Monoid m => (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap f a
l


mhead        :: FMList a -> Maybe a
mhead :: forall a. FMList a -> Maybe a
mhead FMList a
l      = First a -> Maybe a
forall a. First a -> Maybe a
getFirst (FMList a -> forall m. Monoid m => (a -> m) -> m
forall a. FMList a -> forall m. Monoid m => (a -> m) -> m
unFM FMList a
l (Maybe a -> First a
forall a. Maybe a -> First a
First (Maybe a -> First a) -> (a -> Maybe a) -> a -> First a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just))

null         :: FMList a -> Bool
null :: forall a. FMList a -> Bool
null         = Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe a -> Bool) -> (FMList a -> Maybe a) -> FMList a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FMList a -> Maybe a
forall a. FMList a -> Maybe a
mhead

length       :: FMList a -> Int
length :: forall a. FMList a -> Int
length       = FMList a -> Int
forall b a. Num b => FMList a -> b
genericLength

genericLength :: Num b => FMList a -> b
genericLength :: forall b a. Num b => FMList a -> b
genericLength FMList a
l = Sum b -> b
forall a. Sum a -> a
getSum (Sum b -> b) -> Sum b -> b
forall a b. (a -> b) -> a -> b
$ FMList a -> forall m. Monoid m => (a -> m) -> m
forall a. FMList a -> forall m. Monoid m => (a -> m) -> m
unFM FMList a
l (Sum b -> a -> Sum b
forall a b. a -> b -> a
const (Sum b -> a -> Sum b) -> Sum b -> a -> Sum b
forall a b. (a -> b) -> a -> b
$ b -> Sum b
forall a. a -> Sum a
Sum b
1)


head         :: FMList a -> a
head :: forall a. FMList a -> a
head FMList a
l       = FMList a -> Maybe a
forall a. FMList a -> Maybe a
mhead FMList a
l Maybe a -> String -> a
forall a. Maybe a -> String -> a
`fromMaybeOrError` String
"Data.FMList.head: empty list"

tail         :: FMList a -> FMList a
tail :: forall a. FMList a -> FMList a
tail FMList a
l       = if FMList a -> Bool
forall a. FMList a -> Bool
null FMList a
l then String -> FMList a
forall a. HasCallStack => String -> a
error String
"Data.FMList.tail: empty list" else Int -> FMList a -> FMList a
forall n a. (Ord n, Num n) => n -> FMList a -> FMList a
drop (Int
1::Int) FMList a
l

last         :: FMList a -> a
last :: forall a. FMList a -> a
last FMList a
l       = Last a -> Maybe a
forall a. Last a -> Maybe a
getLast (FMList a -> forall m. Monoid m => (a -> m) -> m
forall a. FMList a -> forall m. Monoid m => (a -> m) -> m
unFM FMList a
l (Maybe a -> Last a
forall a. Maybe a -> Last a
Last (Maybe a -> Last a) -> (a -> Maybe a) -> a -> Last a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just)) Maybe a -> String -> a
forall a. Maybe a -> String -> a
`fromMaybeOrError` String
"Data.FMList.last: empty list"

init         :: FMList a -> FMList a
init :: forall a. FMList a -> FMList a
init FMList a
l       = if FMList a -> Bool
forall a. FMList a -> Bool
null FMList a
l then String -> FMList a
forall a. HasCallStack => String -> a
error String
"Data.FMList.init: empty list" else FMList a -> FMList a
forall a. FMList a -> FMList a
reverse (FMList a -> FMList a)
-> (FMList a -> FMList a) -> FMList a -> FMList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FMList a -> FMList a
forall n a. (Ord n, Num n) => n -> FMList a -> FMList a
drop (Int
1::Int) (FMList a -> FMList a)
-> (FMList a -> FMList a) -> FMList a -> FMList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FMList a -> FMList a
forall a. FMList a -> FMList a
reverse (FMList a -> FMList a) -> FMList a -> FMList a
forall a b. (a -> b) -> a -> b
$ FMList a
l

reverse      :: FMList a -> FMList a
reverse :: forall a. FMList a -> FMList a
reverse FMList a
l    = (forall m. Monoid m => (a -> m) -> m) -> FMList a
forall a. (forall m. Monoid m => (a -> m) -> m) -> FMList a
FM ((forall m. Monoid m => (a -> m) -> m) -> FMList a)
-> (forall m. Monoid m => (a -> m) -> m) -> FMList a
forall a b. (a -> b) -> a -> b
$ Dual m -> m
forall a. Dual a -> a
getDual (Dual m -> m) -> ((a -> m) -> Dual m) -> (a -> m) -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FMList a -> forall m. Monoid m => (a -> m) -> m
forall a. FMList a -> forall m. Monoid m => (a -> m) -> m
unFM FMList a
l ((a -> Dual m) -> Dual m)
-> ((a -> m) -> a -> Dual m) -> (a -> m) -> Dual m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m -> Dual m
forall a. a -> Dual a
Dual (m -> Dual m) -> (a -> m) -> a -> Dual m
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)

flatten      :: Foldable t => FMList (t a) -> FMList a
flatten :: forall (t :: * -> *) a. Foldable t => FMList (t a) -> FMList a
flatten      = (forall m. Monoid m => (a -> m) -> t a -> m)
-> FMList (t a) -> FMList a
forall a b.
(forall m. Monoid m => (a -> m) -> b -> m) -> FMList b -> FMList a
transform (a -> m) -> t a -> m
forall m. Monoid m => (a -> m) -> t a -> m
forall m a. Monoid m => (a -> m) -> t a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap

filter       :: (a -> Bool) -> FMList a -> FMList a
filter :: forall a. (a -> Bool) -> FMList a -> FMList a
filter a -> Bool
p     = (forall m. Monoid m => (a -> m) -> a -> m) -> FMList a -> FMList a
forall a b.
(forall m. Monoid m => (a -> m) -> b -> m) -> FMList b -> FMList a
transform (\a -> m
f a
x -> if a -> Bool
p a
x then a -> m
f a
x else m
forall a. Monoid a => a
mempty)


-- transform the foldMap to foldr with state.
transformCS  :: (forall m. Monoid m => (b -> m) -> a -> (m -> s -> m) -> s -> m) -> s -> FMList a -> FMList b
transformCS :: forall b a s.
(forall m. Monoid m => (b -> m) -> a -> (m -> s -> m) -> s -> m)
-> s -> FMList a -> FMList b
transformCS forall m. Monoid m => (b -> m) -> a -> (m -> s -> m) -> s -> m
t s
s0 FMList a
l = (forall m. Monoid m => (b -> m) -> m) -> FMList b
forall a. (forall m. Monoid m => (a -> m) -> m) -> FMList a
FM ((forall m. Monoid m => (b -> m) -> m) -> FMList b)
-> (forall m. Monoid m => (b -> m) -> m) -> FMList b
forall a b. (a -> b) -> a -> b
$ \b -> m
f -> (a -> (s -> m) -> s -> m) -> (s -> m) -> FMList a -> s -> m
forall a b. (a -> b -> b) -> b -> FMList a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
e s -> m
r -> (b -> m) -> a -> (m -> s -> m) -> s -> m
forall m. Monoid m => (b -> m) -> a -> (m -> s -> m) -> s -> m
t b -> m
f a
e (\m
a -> m -> m -> m
forall a. Monoid a => a -> a -> a
mappend m
a (m -> m) -> (s -> m) -> s -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m
r)) s -> m
forall a. Monoid a => a
mempty FMList a
l s
s0

take         :: (Ord n, Num n) => n -> FMList a -> FMList a
take :: forall n a. (Ord n, Num n) => n -> FMList a -> FMList a
take         = (forall m. Monoid m => (a -> m) -> a -> (m -> n -> m) -> n -> m)
-> n -> FMList a -> FMList a
forall b a s.
(forall m. Monoid m => (b -> m) -> a -> (m -> s -> m) -> s -> m)
-> s -> FMList a -> FMList b
transformCS (\a -> m
f a
e m -> n -> m
c n
i -> if n
i n -> n -> Bool
forall a. Ord a => a -> a -> Bool
> n
0 then m -> n -> m
c (a -> m
f a
e) (n
in -> n -> n
forall a. Num a => a -> a -> a
-n
1) else m
forall a. Monoid a => a
mempty)

takeWhile    :: (a -> Bool) -> FMList a -> FMList a
takeWhile :: forall a. (a -> Bool) -> FMList a -> FMList a
takeWhile a -> Bool
p  = (forall m.
 Monoid m =>
 (a -> m) -> a -> (m -> Bool -> m) -> Bool -> m)
-> Bool -> FMList a -> FMList a
forall b a s.
(forall m. Monoid m => (b -> m) -> a -> (m -> s -> m) -> s -> m)
-> s -> FMList a -> FMList b
transformCS (\a -> m
f a
e m -> Bool -> m
c Bool
_ -> if a -> Bool
p a
e then m -> Bool -> m
c (a -> m
f a
e) Bool
True else m
forall a. Monoid a => a
mempty) Bool
True

drop         :: (Ord n, Num n) => n -> FMList a -> FMList a
drop :: forall n a. (Ord n, Num n) => n -> FMList a -> FMList a
drop         = (forall m. Monoid m => (a -> m) -> a -> (m -> n -> m) -> n -> m)
-> n -> FMList a -> FMList a
forall b a s.
(forall m. Monoid m => (b -> m) -> a -> (m -> s -> m) -> s -> m)
-> s -> FMList a -> FMList b
transformCS (\a -> m
f a
e m -> n -> m
c n
i -> if n
i n -> n -> Bool
forall a. Ord a => a -> a -> Bool
> n
0 then m -> n -> m
c m
forall a. Monoid a => a
mempty (n
in -> n -> n
forall a. Num a => a -> a -> a
-n
1) else m -> n -> m
c (a -> m
f a
e) n
0)

dropWhile    :: (a -> Bool) -> FMList a -> FMList a
dropWhile :: forall a. (a -> Bool) -> FMList a -> FMList a
dropWhile a -> Bool
p  = (forall m.
 Monoid m =>
 (a -> m) -> a -> (m -> Bool -> m) -> Bool -> m)
-> Bool -> FMList a -> FMList a
forall b a s.
(forall m. Monoid m => (b -> m) -> a -> (m -> s -> m) -> s -> m)
-> s -> FMList a -> FMList b
transformCS (\a -> m
f a
e m -> Bool -> m
c Bool
ok -> if Bool
ok Bool -> Bool -> Bool
&& a -> Bool
p a
e then m -> Bool -> m
c m
forall a. Monoid a => a
mempty Bool
True else m -> Bool -> m
c (a -> m
f a
e) Bool
False) Bool
True

zipWith      :: (a -> b -> c) -> FMList a -> FMList b -> FMList c
zipWith :: forall a b c. (a -> b -> c) -> FMList a -> FMList b -> FMList c
zipWith a -> b -> c
t    = (forall m.
 Monoid m =>
 (c -> m) -> b -> (m -> FMList a -> m) -> FMList a -> m)
-> FMList a -> FMList b -> FMList c
forall b a s.
(forall m. Monoid m => (b -> m) -> a -> (m -> s -> m) -> s -> m)
-> s -> FMList a -> FMList b
transformCS (\c -> m
f b
e2 m -> FMList a -> m
c FMList a
r1 -> (a -> m -> m) -> m -> FMList a -> m
forall a b. (a -> b -> b) -> b -> FMList a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
e1 m
_ -> m -> FMList a -> m
c (c -> m
f (a -> b -> c
t a
e1 b
e2)) (Int -> FMList a -> FMList a
forall n a. (Ord n, Num n) => n -> FMList a -> FMList a
drop (Int
1::Int) FMList a
r1)) m
forall a. Monoid a => a
mempty FMList a
r1)

zip          :: FMList a -> FMList b -> FMList (a,b)
zip :: forall a b. FMList a -> FMList b -> FMList (a, b)
zip          = (a -> b -> (a, b)) -> FMList a -> FMList b -> FMList (a, b)
forall a b c. (a -> b -> c) -> FMList a -> FMList b -> FMList c
zipWith (,)


iterate      :: (a -> a) -> a -> FMList a
iterate :: forall a. (a -> a) -> a -> FMList a
iterate a -> a
f a
x  = a
x a -> FMList a -> FMList a
forall a. a -> FMList a -> FMList a
`cons` (a -> a) -> a -> FMList a
forall a. (a -> a) -> a -> FMList a
iterate a -> a
f (a -> a
f a
x)

-- | 'repeat' buids an infinite list of a single value.
-- While infinite, the result is still accessible from both the start and end.
repeat       :: a -> FMList a
repeat :: forall a. a -> FMList a
repeat       = FMList a -> FMList a
forall a. FMList a -> FMList a
cycle (FMList a -> FMList a) -> (a -> FMList a) -> a -> FMList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FMList a
forall a. a -> FMList a
one

-- | 'cycle' repeats a list to create an infinite list.
-- It is also accessible from the end, where @last (cycle l)@ equals @last l@.
cycle        :: FMList a -> FMList a
cycle :: forall a. FMList a -> FMList a
cycle FMList a
l      = FMList a
l FMList a -> FMList a -> FMList a
forall a. FMList a -> FMList a -> FMList a
>< FMList a -> FMList a
forall a. FMList a -> FMList a
cycle FMList a
l FMList a -> FMList a -> FMList a
forall a. FMList a -> FMList a -> FMList a
>< FMList a
l

-- | 'unfoldr' builds an 'FMList' from a seed value from left to right.
-- The function takes the element and returns 'Nothing'
-- if it is done producing the list or returns 'Just' @(a,b)@, in which
-- case, @a@ is a appended to the result and @b@ is used as the next
-- seed value in a recursive call.
--
-- A simple use of 'unfoldr':
--
-- > *> unfoldr (\b -> if b == 0 then Nothing else Just (b, b-1)) 10
-- > fromList [10,9,8,7,6,5,4,3,2,1]
--
unfoldr      :: (b -> Maybe (a, b)) -> b -> FMList a
unfoldr :: forall b a. (b -> Maybe (a, b)) -> b -> FMList a
unfoldr b -> Maybe (a, b)
g    = (b -> FMList (Either b a)) -> b -> FMList a
forall b a. (b -> FMList (Either b a)) -> b -> FMList a
unfold (FMList (Either b a)
-> ((a, b) -> FMList (Either b a))
-> Maybe (a, b)
-> FMList (Either b a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FMList (Either b a)
forall a. FMList a
forall (f :: * -> *) a. Alternative f => f a
empty (\(a
a, b
b) -> a -> Either b a
forall a b. b -> Either a b
Right a
a Either b a -> Either b a -> FMList (Either b a)
forall a. a -> a -> FMList a
`pair` b -> Either b a
forall a b. a -> Either a b
Left b
b) (Maybe (a, b) -> FMList (Either b a))
-> (b -> Maybe (a, b)) -> b -> FMList (Either b a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe (a, b)
g)

-- | 'unfold' builds a list from a seed value.
-- The function takes the seed and returns an 'FMList' of values.
-- If the value is 'Right' @a@, then @a@ is appended to the result, and if the
-- value is 'Left' @b@, then @b@ is used as seed value in a recursive call.
--
-- A simple use of 'unfold' (simulating unfoldl):
--
-- > *> unfold (\b -> if b == 0 then empty else Left (b-1) `pair` Right b) 10
-- > fromList [1,2,3,4,5,6,7,8,9,10]
--
unfold       :: (b -> FMList (Either b a)) -> b -> FMList a
unfold :: forall b a. (b -> FMList (Either b a)) -> b -> FMList a
unfold b -> FMList (Either b a)
g     = (forall m. Monoid m => (a -> m) -> Either b a -> m)
-> FMList (Either b a) -> FMList a
forall a b.
(forall m. Monoid m => (a -> m) -> b -> m) -> FMList b -> FMList a
transform (\a -> m
f -> (b -> m) -> (a -> m) -> Either b a -> m
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((a -> m) -> FMList a -> m
forall m a. Monoid m => (a -> m) -> FMList a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f (FMList a -> m) -> (b -> FMList a) -> b -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> FMList (Either b a)) -> b -> FMList a
forall b a. (b -> FMList (Either b a)) -> b -> FMList a
unfold b -> FMList (Either b a)
g) a -> m
f) (FMList (Either b a) -> FMList a)
-> (b -> FMList (Either b a)) -> b -> FMList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> FMList (Either b a)
g


newtype WrapApp f m = WrapApp { forall (f :: * -> *) m. WrapApp f m -> f m
unWrapApp :: f m }

#if MIN_VERSION_base(4,9,0)
instance (Applicative f, Semigroup m) => Semigroup (WrapApp f m) where
  WrapApp f m
a <> :: WrapApp f m -> WrapApp f m -> WrapApp f m
<> WrapApp f m
b = f m -> WrapApp f m
forall (f :: * -> *) m. f m -> WrapApp f m
WrapApp (f m -> WrapApp f m) -> f m -> WrapApp f m
forall a b. (a -> b) -> a -> b
$ m -> m -> m
forall a. Semigroup a => a -> a -> a
(<>) (m -> m -> m) -> f m -> f (m -> m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f m
a f (m -> m) -> f m -> f m
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f m
b
#endif

instance (Applicative f, Monoid m) => Monoid (WrapApp f m) where
  mempty :: WrapApp f m
mempty                          = f m -> WrapApp f m
forall (f :: * -> *) m. f m -> WrapApp f m
WrapApp (f m -> WrapApp f m) -> f m -> WrapApp f m
forall a b. (a -> b) -> a -> b
$ m -> f m
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure m
forall a. Monoid a => a
mempty
  mappend :: WrapApp f m -> WrapApp f m -> WrapApp f m
mappend (WrapApp f m
a) (WrapApp f m
b) = f m -> WrapApp f m
forall (f :: * -> *) m. f m -> WrapApp f m
WrapApp (f m -> WrapApp f m) -> f m -> WrapApp f m
forall a b. (a -> b) -> a -> b
$ m -> m -> m
forall a. Monoid a => a -> a -> a
mappend (m -> m -> m) -> f m -> f (m -> m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f m
a f (m -> m) -> f m -> f m
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f m
b

-- | Map each element of a structure to an action, evaluate these actions from left to right,
-- and concat the monoid results.
foldMapA :: (Foldable t, Applicative f, Monoid m) => (a -> f m) -> t a -> f m
foldMapA :: forall (t :: * -> *) (f :: * -> *) m a.
(Foldable t, Applicative f, Monoid m) =>
(a -> f m) -> t a -> f m
foldMapA a -> f m
f = WrapApp f m -> f m
forall (f :: * -> *) m. WrapApp f m -> f m
unWrapApp (WrapApp f m -> f m) -> (t a -> WrapApp f m) -> t a -> f m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> WrapApp f m) -> t a -> WrapApp f m
forall m a. Monoid m => (a -> m) -> t a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (f m -> WrapApp f m
forall (f :: * -> *) m. f m -> WrapApp f m
WrapApp (f m -> WrapApp f m) -> (a -> f m) -> a -> WrapApp f m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f m
f)



instance Functor FMList where
  fmap :: forall a b. (a -> b) -> FMList a -> FMList b
fmap a -> b
g     = (forall m. Monoid m => (b -> m) -> a -> m) -> FMList a -> FMList b
forall a b.
(forall m. Monoid m => (a -> m) -> b -> m) -> FMList b -> FMList a
transform (\b -> m
f -> b -> m
f (b -> m) -> (a -> b) -> a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
g)
  a
a <$ :: forall a b. a -> FMList b -> FMList a
<$ FMList b
l     = (forall m. Monoid m => (a -> m) -> b -> m) -> FMList b -> FMList a
forall a b.
(forall m. Monoid m => (a -> m) -> b -> m) -> FMList b -> FMList a
transform (\a -> m
f -> m -> b -> m
forall a b. a -> b -> a
const (a -> m
f a
a)) FMList b
l

instance Foldable FMList where
  foldMap :: forall m a. Monoid m => (a -> m) -> FMList a -> m
foldMap a -> m
m FMList a
f = FMList a -> forall m. Monoid m => (a -> m) -> m
forall a. FMList a -> forall m. Monoid m => (a -> m) -> m
unFM FMList a
f a -> m
m

instance Traversable FMList where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FMList a -> f (FMList b)
traverse a -> f b
f = (a -> f (FMList b)) -> FMList a -> f (FMList b)
forall (t :: * -> *) (f :: * -> *) m a.
(Foldable t, Applicative f, Monoid m) =>
(a -> f m) -> t a -> f m
foldMapA ((b -> FMList b) -> f b -> f (FMList b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> FMList b
forall a. a -> FMList a
one (f b -> f (FMList b)) -> (a -> f b) -> a -> f (FMList b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
f)

instance Monad FMList where
  return :: forall a. a -> FMList a
return     = a -> FMList a
forall a. a -> FMList a
one
  FMList a
m >>= :: forall a b. FMList a -> (a -> FMList b) -> FMList b
>>= a -> FMList b
g    = (forall m. Monoid m => (b -> m) -> a -> m) -> FMList a -> FMList b
forall a b.
(forall m. Monoid m => (a -> m) -> b -> m) -> FMList b -> FMList a
transform (\b -> m
f -> (b -> m) -> FMList b -> m
forall m a. Monoid m => (a -> m) -> FMList a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap b -> m
f (FMList b -> m) -> (a -> FMList b) -> a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FMList b
g) FMList a
m
  FMList a
m >> :: forall a b. FMList a -> FMList b -> FMList b
>> FMList b
k     = (forall m. Monoid m => (b -> m) -> a -> m) -> FMList a -> FMList b
forall a b.
(forall m. Monoid m => (a -> m) -> b -> m) -> FMList b -> FMList a
transform (\b -> m
f -> m -> a -> m
forall a b. a -> b -> a
const ((b -> m) -> FMList b -> m
forall m a. Monoid m => (a -> m) -> FMList a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap b -> m
f FMList b
k)) FMList a
m

instance MF.MonadFail FMList where
  fail :: forall a. String -> FMList a
fail String
_ = FMList a
forall a. FMList a
nil

instance Applicative FMList where
  pure :: forall a. a -> FMList a
pure       = a -> FMList a
forall a. a -> FMList a
one
  FMList (a -> b)
gs <*> :: forall a b. FMList (a -> b) -> FMList a -> FMList b
<*> FMList a
xs  = (forall m. Monoid m => (b -> m) -> (a -> b) -> m)
-> FMList (a -> b) -> FMList b
forall a b.
(forall m. Monoid m => (a -> m) -> b -> m) -> FMList b -> FMList a
transform (\b -> m
f a -> b
g -> FMList a -> forall m. Monoid m => (a -> m) -> m
forall a. FMList a -> forall m. Monoid m => (a -> m) -> m
unFM FMList a
xs (b -> m
f (b -> m) -> (a -> b) -> a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
g)) FMList (a -> b)
gs
  FMList a
as <* :: forall a b. FMList a -> FMList b -> FMList a
<*  FMList b
bs  = (forall m. Monoid m => (a -> m) -> a -> m) -> FMList a -> FMList a
forall a b.
(forall m. Monoid m => (a -> m) -> b -> m) -> FMList b -> FMList a
transform (\a -> m
f a
a -> FMList b -> forall m. Monoid m => (b -> m) -> m
forall a. FMList a -> forall m. Monoid m => (a -> m) -> m
unFM FMList b
bs (m -> b -> m
forall a b. a -> b -> a
const (a -> m
f a
a))) FMList a
as
  FMList a
as  *> :: forall a b. FMList a -> FMList b -> FMList b
*> FMList b
bs  = (forall m. Monoid m => (b -> m) -> a -> m) -> FMList a -> FMList b
forall a b.
(forall m. Monoid m => (a -> m) -> b -> m) -> FMList b -> FMList a
transform (\b -> m
f   -> m -> a -> m
forall a b. a -> b -> a
const (FMList b -> forall m. Monoid m => (b -> m) -> m
forall a. FMList a -> forall m. Monoid m => (a -> m) -> m
unFM FMList b
bs b -> m
f)) FMList a
as

#if MIN_VERSION_base(4,9,0)
instance Semigroup (FMList a) where
  <> :: FMList a -> FMList a -> FMList a
(<>) = FMList a -> FMList a -> FMList a
forall a. FMList a -> FMList a -> FMList a
(><)
#endif

instance Monoid (FMList a) where
  mempty :: FMList a
mempty     = FMList a
forall a. FMList a
nil
  mappend :: FMList a -> FMList a -> FMList a
mappend    = FMList a -> FMList a -> FMList a
forall a. FMList a -> FMList a -> FMList a
(><)

instance MonadPlus FMList where
  mzero :: forall a. FMList a
mzero      = FMList a
forall a. FMList a
nil
  mplus :: forall a. FMList a -> FMList a -> FMList a
mplus      = FMList a -> FMList a -> FMList a
forall a. FMList a -> FMList a -> FMList a
(><)

instance Alternative FMList where
  empty :: forall a. FMList a
empty      = FMList a
forall a. FMList a
nil
  <|> :: forall a. FMList a -> FMList a -> FMList a
(<|>)      = FMList a -> FMList a -> FMList a
forall a. FMList a -> FMList a -> FMList a
(><)

instance Show a => Show (FMList a) where
  show :: FMList a -> String
show FMList a
l     = String
"fromList " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ([a] -> String
forall a. Show a => a -> String
show ([a] -> String) -> [a] -> String
forall a b. (a -> b) -> a -> b
$! FMList a -> [a]
forall a. FMList a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList FMList a
l)


fromMaybeOrError :: Maybe a -> String -> a
fromMaybeOrError :: forall a. Maybe a -> String -> a
fromMaybeOrError Maybe a
ma String
e = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (String -> a
forall a. HasCallStack => String -> a
error String
e) Maybe a
ma