Star.hs

{-# 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 _   Nil       = Nil
sortBy cmp (Cons xs) = Cons (treeFoldMap One (mergelr cmp) 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 _ Nil = Nil
sortOn c (Cons xs) = Cons (fmap fst (treeFoldMap (\x -> One (x, c x)) (mergelr (comparing snd)) 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 = sortBy compare

-- | Unfold a list from a seed.
unfoldr :: (b -> Maybe (a, b)) -> b -> Star a
unfoldr f b = maybe Nil (\(x, xs) -> x :* unfoldr f xs) (f 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 = 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 _ _ Nil = Nil
prescanr f b (Cons xs) = Cons (go xs)
  where
    go (One x) = One (f x b)
    go (y :+ ys) = f y (head zs) :+ zs
      where
        zs = go ys

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

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

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

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