{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeFamilies    #-}

-- |
-- Module      : Data.List.Kleene.Star
-- Description : A list type isomorphic to 'Data.List.NonEmpty.NonEmpty' based on the Kleene plus.
-- Copyright   : (c) Donnacha Oisín Kidney, 2020
-- License     : Apache
-- Maintainer  : mail@doisinkidney.com
-- Stability   : experimental
-- Portability : ghc
--
-- This module provides a simple list type isomorphic to 'Data.List.NonEmpty.NonEmpty',
-- but which is defined in terms of a possibly empty list
-- type. This can make moving between one type and another
-- easier.

module Data.List.Kleene.Plus
  ( -- * The list type
   Plus(..)
  ,pattern (:+)
  ,pattern One
  ,Star(..)
  -- * Utility functions
  ,last
  ,filter
  ,reverse
  ,take
  ,(!!)
  -- * Building lists
  ,unfoldr
  ,iterate
  ,cycle
  -- * scans
  ,scanr
  ,scanl
  ,prescanr
  ,prescanl
  -- * Sorting
  ,sortBy
  ,sortOn
  ,sort
  )
  where

import           Data.List.Kleene.Internal

import           Data.Ord

import           Prelude                   hiding (cycle, filter, head, iterate,
                                            last, reverse, scanl, scanr, take,
                                            (!!))

-- | Sort given a comparison function. Stable.
-- \(\mathcal{O}(n \log n)\).
--
-- >>> sortBy (\x y -> compare (fst x) (fst y)) [(4,1),(3,2),(1,3),(3,4)]
-- [(1,3),(3,2),(3,4),(4,1)]
sortBy :: (a -> a -> Ordering) -> Plus a -> Plus a
sortBy :: (a -> a -> Ordering) -> Plus a -> Plus a
sortBy cmp :: a -> a -> Ordering
cmp = (a -> Plus a) -> (Plus a -> Plus a -> Plus a) -> Plus a -> Plus a
forall a b. (a -> b) -> (b -> b -> b) -> Plus a -> b
treeFoldMap a -> Plus a
forall a. a -> Plus a
One ((a -> a -> Ordering) -> Plus a -> Plus a -> Plus a
forall a. (a -> a -> Ordering) -> Plus a -> Plus a -> Plus a
mergelr a -> a -> Ordering
cmp)

-- | Sort given a selector function. Stable.
-- \(\mathcal{O}(n \log n)\).
--
-- >>> sortOn fst [(4,1),(3,2),(1,3),(3,4)]
-- [(1,3),(3,2),(3,4),(4,1)]
sortOn :: Ord b => (a -> b) -> Plus a -> Plus a
sortOn :: (a -> b) -> Plus a -> Plus a
sortOn c :: a -> b
c = ((a, b) -> a) -> Plus (a, b) -> Plus a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> a
forall a b. (a, b) -> a
fst (Plus (a, b) -> Plus a)
-> (Plus a -> Plus (a, b)) -> Plus a -> Plus a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Plus (a, b))
-> (Plus (a, b) -> Plus (a, b) -> Plus (a, b))
-> Plus a
-> Plus (a, b)
forall a b. (a -> b) -> (b -> b -> b) -> Plus a -> b
treeFoldMap (\x :: a
x -> (a, b) -> Plus (a, b)
forall a. a -> Plus a
One (a
x, a -> b
c a
x)) (((a, b) -> (a, b) -> Ordering)
-> Plus (a, b) -> Plus (a, b) -> Plus (a, b)
forall a. (a -> a -> Ordering) -> Plus a -> Plus a -> Plus a
mergelr (((a, b) -> b) -> (a, b) -> (a, b) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (a, b) -> b
forall a b. (a, b) -> b
snd))

-- | Stable sort.
-- \(\mathcal{O}(n \log n)\).
--
-- >>> sort [4,3,1,3]
-- [1,3,3,4]
sort :: Ord a => Plus a -> Plus a
sort :: Plus a -> Plus a
sort = (a -> a -> Ordering) -> Plus a -> Plus a
forall a. (a -> a -> Ordering) -> Plus a -> Plus a
sortBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

-- | Return the last element of a finite list.
--
-- >>> last [1..10]
-- 10
last :: Plus a -> a
last :: Plus a -> a
last = (a -> a -> a) -> Plus a -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (\_ x :: a
x -> a
x)

-- | Unfold a list from a seed.
unfoldr :: (b -> (a, Maybe b)) -> b -> Plus a
unfoldr :: (b -> (a, Maybe b)) -> b -> Plus a
unfoldr f :: b -> (a, Maybe b)
f b :: b
b = a
x a -> Star a -> Plus a
forall a. a -> Star a -> Plus a
:- Star a -> (b -> Star a) -> Maybe b -> Star a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Star a
forall a. Star a
Nil (Plus a -> Star a
forall a. Plus a -> Star a
Cons (Plus a -> Star a) -> (b -> Plus a) -> b -> Star a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> (a, Maybe b)) -> b -> Plus a
forall b a. (b -> (a, Maybe b)) -> b -> Plus a
unfoldr b -> (a, Maybe b)
f) Maybe b
xs
  where
    (x :: a
x,xs :: Maybe b
xs) = b -> (a, Maybe b)
f b
b

-- | Cycle a list infinitely
--
-- >>> take 10 (cycle [1..3])
-- [1,2,3,1,2,3,1,2,3,1]
cycle :: Plus a -> Plus a
cycle :: Plus a -> Plus a
cycle xs :: Plus a
xs = Plus a
ys
  where
    ys :: Plus a
ys = Plus a
xs Plus a -> Plus a -> Plus a
forall a. Semigroup a => a -> a -> a
<> Plus a
ys

-- | Repeatedly apply a function, listing its output.
--
-- >>> take 5 (iterate (+1) 1)
-- [1,2,3,4,5]
iterate :: (a -> a) -> a -> Plus a
iterate :: (a -> a) -> a -> Plus a
iterate f :: a -> a
f x :: a
x = a
x a -> Plus a -> Plus a
forall a. a -> Plus a -> Plus a
:+ (a -> a) -> a -> Plus a
forall a. (a -> a) -> a -> Plus a
iterate a -> a
f (a -> a
f a
x)

-- | Like 'scanr', but without including the initial element in the output.
--
-- >>> prescanr (+) 0 [1,2,3]
-- [6,5,3]
prescanr :: (a -> b -> b) -> b -> Plus a -> Plus b
prescanr :: (a -> b -> b) -> b -> Plus a -> Plus b
prescanr f :: a -> b -> b
f b :: b
b (One x :: a
x) = b -> Plus b
forall a. a -> Plus a
One (a -> b -> b
f a
x b
b)
prescanr f :: a -> b -> b
f b :: b
b (x :: a
x :+ xs :: Plus a
xs) = a -> b -> b
f a
x (Plus b -> b
forall a. Plus a -> a
head Plus b
ys) b -> Plus b -> Plus b
forall a. a -> Plus a -> Plus a
:+ Plus b
ys
  where
    ys :: Plus b
ys = (a -> b -> b) -> b -> Plus a -> Plus b
forall a b. (a -> b -> b) -> b -> Plus a -> Plus b
prescanr a -> b -> b
f b
b Plus a
xs

-- | Like 'scanl', but without including the initial element in the output.
--
-- >>> prescanl (+) 0 [1,2,3]
-- [1,3,6]
prescanl :: (b -> a -> b) -> b -> Plus a -> Plus b
prescanl :: (b -> a -> b) -> b -> Plus a -> Plus b
prescanl = (b -> a -> b) -> b -> Plus a -> Plus b
forall b a. (b -> a -> b) -> b -> Plus a -> Plus b
prescanlPlus

-- | Reverse a list.
--
-- >>> reverse [1..5]
-- [5,4,3,2,1]
reverse :: Plus a -> Plus a
reverse :: Plus a -> Plus a
reverse (x :: a
x :- xs :: Star a
xs) = (Plus a -> a -> Plus a) -> Plus a -> Star a -> Plus a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((a -> Plus a -> Plus a) -> Plus a -> a -> Plus a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Plus a -> Plus a
forall a. a -> Plus a -> Plus a
(:+)) (a -> Plus a
forall a. a -> Plus a
One a
x) Star a
xs

-- | @'take' n xs@ takes the first @n@ elements from @xs@.
--
-- >>> take 5 [1..]
-- [1,2,3,4,5]
--
-- >>> take 5 [1..3]
-- [1,2,3]
take :: Int -> Plus a -> Star a
take :: Int -> Plus a -> Star a
take = Int -> Plus a -> Star a
forall a. Int -> Plus a -> Star a
takePlus

-- | Index into a list.
--
-- >>> [0..] !! 3
-- 3
--
-- >>> [0..5] !! 6
-- *** Exception: index: empty list!
(!!) :: Plus a -> Int -> a
!! :: Plus a -> Int -> a
(!!) = Plus a -> Int -> a
forall a. Plus a -> Int -> a
indexPlus

-- $setup
-- >>> :set -XOverloadedLists