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

-- |
-- Module      : Data.List.Kleene.Star
-- Description : A list type isomorphic to [] based on the Kleene star.
-- 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 Haskell's
-- standard @[]@, but which is defined in terms of a non-empty list
-- type. This can make moving between one type and another
-- easier.

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

import           Data.List.Kleene.Internal
import           Data.Ord
import           Prelude                   hiding (filter, head, 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) -> Star a -> Star a
sortBy :: (a -> a -> Ordering) -> Star a -> Star a
sortBy _   Nil       = Star a
forall a. Star a
Nil
sortBy cmp :: a -> a -> Ordering
cmp (Cons xs :: Plus a
xs) = Plus a -> Star a
forall a. Plus a -> Star a
Cons ((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) Plus a
xs)

-- | 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) -> Star a -> Star a
sortOn :: (a -> b) -> Star a -> Star a
sortOn _ Nil = Star a
forall a. Star a
Nil
sortOn c :: a -> b
c (Cons xs :: Plus a
xs) = Plus a -> Star a
forall a. Plus a -> Star a
Cons (((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 ((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)) Plus a
xs))

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

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

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

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

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

-- | Convert to a 'Plus' list.
uncons :: Star a -> Maybe (Plus a)
uncons :: Star a -> Maybe (Plus a)
uncons Nil       = Maybe (Plus a)
forall a. Maybe a
Nothing
uncons (Cons xs :: Plus a
xs) = Plus a -> Maybe (Plus a)
forall a. a -> Maybe a
Just Plus 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 -> Star a -> Star a
take :: Int -> Star a -> Star a
take = Int -> Star a -> Star a
forall a. Int -> Star a -> Star a
takeStar

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

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