{-# LANGUAGE DeriveFoldable    #-}
{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE DeriveTraversable #-}

{-# LANGUAGE Safe              #-}

module Data.Function.Step (
    -- * Step Function
    -- $setup
    SF (..),
    Bound (..),
    -- * Construction
    constant,
    step,
    fromList,
    -- * Normalisation
    normalise,
    -- * Operators
    (!),
    values,
    -- * Debug
    showSF,
    putSF,
    ) where

import Control.Applicative  (Applicative (pure, (<*>)), liftA2, (<$>))
import Control.DeepSeq      (NFData (..))
import Control.Monad        (ap)
import Data.Functor.Classes
import Data.List            (intercalate)
import Data.Map             (Map)

import Prelude
       (Eq (..), Functor, IO, Maybe (..), Monad (..), Ord (..), Ordering (..),
       Show (..), String, fst, length, map, otherwise, putStrLn, replicate,
       uncurry, ($), (++), (-), (.))

import Data.Foldable    (Foldable, foldr, maximum)
import Data.Monoid      (Monoid (..))
import Data.Semigroup   (Semigroup (..))
import Data.Traversable (Traversable (traverse))

import Text.Show (showListWith)

import qualified Data.Map        as Map
import qualified Test.QuickCheck as QC

-- | Step function. Piecewise constant function, having finitely many pieces.
-- See <https://en.wikipedia.org/wiki/Step_function>.
--
-- @'SF' (fromList [('Open' k1, v1), ('Closed' k2, v2)]) v3 :: 'SF' k v@ describes a piecewise constant function \(f : k \to v\):
--
-- \[
-- f\,x = \begin{cases}
-- v_1, \quad x < k_1 \newline
-- v_2, \quad k_1 \le x \le k_2 \newline
-- v_3, \quad k_2 < x
-- \end{cases}
-- \]
--
-- or as you would write in Haskell
--
-- @
-- f x | x <  k1   = v1
--     | x <= k2   = v2
--     | otherwise = v3
-- @
--
-- /Note:/ [total-map](https://hackage.haskell.org/package/total-map-0.0.6/docs/Data-TotalMap.html) package,
-- which provides /function with finite support/.
--
-- Constructor is exposed as you cannot construct non-valid 'SF'.
--
-- === Merging
--
-- You can use 'Applicative' instance to /merge/ 'SF'.
--
-- >>> putSF $ liftA2 (+) (step 0 0 1) (step 1 0 1)
-- \x -> if
--     | x < 0     -> 0
--     | x < 1     -> 1
--     | otherwise -> 2
--
-- Following property holds, i.e. 'SF' and ordinary function 'Applicative' instances
-- are compatible (and '!' is a homomorphism).
--
-- prop> liftA2 (applyFun2 f) g h ! x == liftA2 (applyFun2 f :: A -> B -> C) (g !) (h !) (x :: Int)
--
-- Recall that for ordinary functions @'liftA2' f g h x = f (g x) (h x)@.
--
-- === Dense?
--
-- This dense variant is useful with [dense ordered](https://en.wikipedia.org/wiki/Dense_order) domains, e.g. 'Rational'.
-- 'Integer' is not dense, so you could use "Data.Function.Step.Discrete" variant instead.
--
-- >>> let s = fromList [(Open 0, -1),(Closed 0, 0)] 1 :: SF Rational Int
-- >>> putSF s
-- \x -> if
--     | x <  0 % 1 -> -1
--     | x <= 0 % 1 -> 0
--     | otherwise  -> 1
--
-- >>> import Data.Ratio ((%))
-- >>> map (s !) [-1, -0.5, 0, 0.5, 1]
-- [-1,-1,0,1,1]
--
data SF k v = SF !(Map (Bound k) v) !v
  deriving (SF k v -> SF k v -> Bool
(SF k v -> SF k v -> Bool)
-> (SF k v -> SF k v -> Bool) -> Eq (SF k v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v. (Eq k, Eq v) => SF k v -> SF k v -> Bool
$c== :: forall k v. (Eq k, Eq v) => SF k v -> SF k v -> Bool
== :: SF k v -> SF k v -> Bool
$c/= :: forall k v. (Eq k, Eq v) => SF k v -> SF k v -> Bool
/= :: SF k v -> SF k v -> Bool
Eq, Eq (SF k v)
Eq (SF k v) =>
(SF k v -> SF k v -> Ordering)
-> (SF k v -> SF k v -> Bool)
-> (SF k v -> SF k v -> Bool)
-> (SF k v -> SF k v -> Bool)
-> (SF k v -> SF k v -> Bool)
-> (SF k v -> SF k v -> SF k v)
-> (SF k v -> SF k v -> SF k v)
-> Ord (SF k v)
SF k v -> SF k v -> Bool
SF k v -> SF k v -> Ordering
SF k v -> SF k v -> SF k v
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k v. (Ord k, Ord v) => Eq (SF k v)
forall k v. (Ord k, Ord v) => SF k v -> SF k v -> Bool
forall k v. (Ord k, Ord v) => SF k v -> SF k v -> Ordering
forall k v. (Ord k, Ord v) => SF k v -> SF k v -> SF k v
$ccompare :: forall k v. (Ord k, Ord v) => SF k v -> SF k v -> Ordering
compare :: SF k v -> SF k v -> Ordering
$c< :: forall k v. (Ord k, Ord v) => SF k v -> SF k v -> Bool
< :: SF k v -> SF k v -> Bool
$c<= :: forall k v. (Ord k, Ord v) => SF k v -> SF k v -> Bool
<= :: SF k v -> SF k v -> Bool
$c> :: forall k v. (Ord k, Ord v) => SF k v -> SF k v -> Bool
> :: SF k v -> SF k v -> Bool
$c>= :: forall k v. (Ord k, Ord v) => SF k v -> SF k v -> Bool
>= :: SF k v -> SF k v -> Bool
$cmax :: forall k v. (Ord k, Ord v) => SF k v -> SF k v -> SF k v
max :: SF k v -> SF k v -> SF k v
$cmin :: forall k v. (Ord k, Ord v) => SF k v -> SF k v -> SF k v
min :: SF k v -> SF k v -> SF k v
Ord, (forall a b. (a -> b) -> SF k a -> SF k b)
-> (forall a b. a -> SF k b -> SF k a) -> Functor (SF k)
forall a b. a -> SF k b -> SF k a
forall a b. (a -> b) -> SF k a -> SF k b
forall k a b. a -> SF k b -> SF k a
forall k a b. (a -> b) -> SF k a -> SF k b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall k a b. (a -> b) -> SF k a -> SF k b
fmap :: forall a b. (a -> b) -> SF k a -> SF k b
$c<$ :: forall k a b. a -> SF k b -> SF k a
<$ :: forall a b. a -> SF k b -> SF k a
Functor, (forall m. Monoid m => SF k m -> m)
-> (forall m a. Monoid m => (a -> m) -> SF k a -> m)
-> (forall m a. Monoid m => (a -> m) -> SF k a -> m)
-> (forall a b. (a -> b -> b) -> b -> SF k a -> b)
-> (forall a b. (a -> b -> b) -> b -> SF k a -> b)
-> (forall b a. (b -> a -> b) -> b -> SF k a -> b)
-> (forall b a. (b -> a -> b) -> b -> SF k a -> b)
-> (forall a. (a -> a -> a) -> SF k a -> a)
-> (forall a. (a -> a -> a) -> SF k a -> a)
-> (forall a. SF k a -> [a])
-> (forall a. SF k a -> Bool)
-> (forall a. SF k a -> Int)
-> (forall a. Eq a => a -> SF k a -> Bool)
-> (forall a. Ord a => SF k a -> a)
-> (forall a. Ord a => SF k a -> a)
-> (forall a. Num a => SF k a -> a)
-> (forall a. Num a => SF k a -> a)
-> Foldable (SF k)
forall a. Eq a => a -> SF k a -> Bool
forall a. Num a => SF k a -> a
forall a. Ord a => SF k a -> a
forall m. Monoid m => SF k m -> m
forall a. SF k a -> Bool
forall a. SF k a -> Int
forall a. SF k a -> [a]
forall a. (a -> a -> a) -> SF k a -> a
forall k a. Eq a => a -> SF k a -> Bool
forall k a. Num a => SF k a -> a
forall k a. Ord a => SF k a -> a
forall m a. Monoid m => (a -> m) -> SF k a -> m
forall k m. Monoid m => SF k m -> m
forall k a. SF k a -> Bool
forall k a. SF k a -> Int
forall k a. SF k a -> [a]
forall b a. (b -> a -> b) -> b -> SF k a -> b
forall a b. (a -> b -> b) -> b -> SF k a -> b
forall k a. (a -> a -> a) -> SF k a -> a
forall k m a. Monoid m => (a -> m) -> SF k a -> m
forall k b a. (b -> a -> b) -> b -> SF k a -> b
forall k a b. (a -> b -> b) -> b -> SF k a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall k m. Monoid m => SF k m -> m
fold :: forall m. Monoid m => SF k m -> m
$cfoldMap :: forall k m a. Monoid m => (a -> m) -> SF k a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> SF k a -> m
$cfoldMap' :: forall k m a. Monoid m => (a -> m) -> SF k a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> SF k a -> m
$cfoldr :: forall k a b. (a -> b -> b) -> b -> SF k a -> b
foldr :: forall a b. (a -> b -> b) -> b -> SF k a -> b
$cfoldr' :: forall k a b. (a -> b -> b) -> b -> SF k a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> SF k a -> b
$cfoldl :: forall k b a. (b -> a -> b) -> b -> SF k a -> b
foldl :: forall b a. (b -> a -> b) -> b -> SF k a -> b
$cfoldl' :: forall k b a. (b -> a -> b) -> b -> SF k a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> SF k a -> b
$cfoldr1 :: forall k a. (a -> a -> a) -> SF k a -> a
foldr1 :: forall a. (a -> a -> a) -> SF k a -> a
$cfoldl1 :: forall k a. (a -> a -> a) -> SF k a -> a
foldl1 :: forall a. (a -> a -> a) -> SF k a -> a
$ctoList :: forall k a. SF k a -> [a]
toList :: forall a. SF k a -> [a]
$cnull :: forall k a. SF k a -> Bool
null :: forall a. SF k a -> Bool
$clength :: forall k a. SF k a -> Int
length :: forall a. SF k a -> Int
$celem :: forall k a. Eq a => a -> SF k a -> Bool
elem :: forall a. Eq a => a -> SF k a -> Bool
$cmaximum :: forall k a. Ord a => SF k a -> a
maximum :: forall a. Ord a => SF k a -> a
$cminimum :: forall k a. Ord a => SF k a -> a
minimum :: forall a. Ord a => SF k a -> a
$csum :: forall k a. Num a => SF k a -> a
sum :: forall a. Num a => SF k a -> a
$cproduct :: forall k a. Num a => SF k a -> a
product :: forall a. Num a => SF k a -> a
Foldable, Functor (SF k)
Foldable (SF k)
(Functor (SF k), Foldable (SF k)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> SF k a -> f (SF k b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    SF k (f a) -> f (SF k a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> SF k a -> m (SF k b))
-> (forall (m :: * -> *) a. Monad m => SF k (m a) -> m (SF k a))
-> Traversable (SF k)
forall k. Functor (SF k)
forall k. Foldable (SF k)
forall k (m :: * -> *) a. Monad m => SF k (m a) -> m (SF k a)
forall k (f :: * -> *) a. Applicative f => SF k (f a) -> f (SF k a)
forall k (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SF k a -> m (SF k b)
forall k (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SF k a -> f (SF k b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => SF k (m a) -> m (SF k a)
forall (f :: * -> *) a. Applicative f => SF k (f a) -> f (SF k a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SF k a -> m (SF k b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SF k a -> f (SF k b)
$ctraverse :: forall k (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SF k a -> f (SF k b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SF k a -> f (SF k b)
$csequenceA :: forall k (f :: * -> *) a. Applicative f => SF k (f a) -> f (SF k a)
sequenceA :: forall (f :: * -> *) a. Applicative f => SF k (f a) -> f (SF k a)
$cmapM :: forall k (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SF k a -> m (SF k b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SF k a -> m (SF k b)
$csequence :: forall k (m :: * -> *) a. Monad m => SF k (m a) -> m (SF k a)
sequence :: forall (m :: * -> *) a. Monad m => SF k (m a) -> m (SF k a)
Traversable)

-- | Bound operations
data Bound k
    = Open k   -- ^ less-than, @<@
    | Closed k -- ^ less-than-or-equal, @≤@.
  deriving (Bound k -> Bound k -> Bool
(Bound k -> Bound k -> Bool)
-> (Bound k -> Bound k -> Bool) -> Eq (Bound k)
forall k. Eq k => Bound k -> Bound k -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall k. Eq k => Bound k -> Bound k -> Bool
== :: Bound k -> Bound k -> Bool
$c/= :: forall k. Eq k => Bound k -> Bound k -> Bool
/= :: Bound k -> Bound k -> Bool
Eq, Int -> Bound k -> ShowS
[Bound k] -> ShowS
Bound k -> String
(Int -> Bound k -> ShowS)
-> (Bound k -> String) -> ([Bound k] -> ShowS) -> Show (Bound k)
forall k. Show k => Int -> Bound k -> ShowS
forall k. Show k => [Bound k] -> ShowS
forall k. Show k => Bound k -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall k. Show k => Int -> Bound k -> ShowS
showsPrec :: Int -> Bound k -> ShowS
$cshow :: forall k. Show k => Bound k -> String
show :: Bound k -> String
$cshowList :: forall k. Show k => [Bound k] -> ShowS
showList :: [Bound k] -> ShowS
Show, (forall a b. (a -> b) -> Bound a -> Bound b)
-> (forall a b. a -> Bound b -> Bound a) -> Functor Bound
forall a b. a -> Bound b -> Bound a
forall a b. (a -> b) -> Bound a -> Bound b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Bound a -> Bound b
fmap :: forall a b. (a -> b) -> Bound a -> Bound b
$c<$ :: forall a b. a -> Bound b -> Bound a
<$ :: forall a b. a -> Bound b -> Bound a
Functor, (forall m. Monoid m => Bound m -> m)
-> (forall m a. Monoid m => (a -> m) -> Bound a -> m)
-> (forall m a. Monoid m => (a -> m) -> Bound a -> m)
-> (forall a b. (a -> b -> b) -> b -> Bound a -> b)
-> (forall a b. (a -> b -> b) -> b -> Bound a -> b)
-> (forall b a. (b -> a -> b) -> b -> Bound a -> b)
-> (forall b a. (b -> a -> b) -> b -> Bound a -> b)
-> (forall a. (a -> a -> a) -> Bound a -> a)
-> (forall a. (a -> a -> a) -> Bound a -> a)
-> (forall a. Bound a -> [a])
-> (forall a. Bound a -> Bool)
-> (forall a. Bound a -> Int)
-> (forall a. Eq a => a -> Bound a -> Bool)
-> (forall a. Ord a => Bound a -> a)
-> (forall a. Ord a => Bound a -> a)
-> (forall a. Num a => Bound a -> a)
-> (forall a. Num a => Bound a -> a)
-> Foldable Bound
forall a. Eq a => a -> Bound a -> Bool
forall a. Num a => Bound a -> a
forall a. Ord a => Bound a -> a
forall m. Monoid m => Bound m -> m
forall a. Bound a -> Bool
forall a. Bound a -> Int
forall a. Bound a -> [a]
forall a. (a -> a -> a) -> Bound a -> a
forall m a. Monoid m => (a -> m) -> Bound a -> m
forall b a. (b -> a -> b) -> b -> Bound a -> b
forall a b. (a -> b -> b) -> b -> Bound a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Bound m -> m
fold :: forall m. Monoid m => Bound m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Bound a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Bound a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Bound a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Bound a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Bound a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Bound a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Bound a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Bound a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Bound a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Bound a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Bound a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Bound a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Bound a -> a
foldr1 :: forall a. (a -> a -> a) -> Bound a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Bound a -> a
foldl1 :: forall a. (a -> a -> a) -> Bound a -> a
$ctoList :: forall a. Bound a -> [a]
toList :: forall a. Bound a -> [a]
$cnull :: forall a. Bound a -> Bool
null :: forall a. Bound a -> Bool
$clength :: forall a. Bound a -> Int
length :: forall a. Bound a -> Int
$celem :: forall a. Eq a => a -> Bound a -> Bool
elem :: forall a. Eq a => a -> Bound a -> Bool
$cmaximum :: forall a. Ord a => Bound a -> a
maximum :: forall a. Ord a => Bound a -> a
$cminimum :: forall a. Ord a => Bound a -> a
minimum :: forall a. Ord a => Bound a -> a
$csum :: forall a. Num a => Bound a -> a
sum :: forall a. Num a => Bound a -> a
$cproduct :: forall a. Num a => Bound a -> a
product :: forall a. Num a => Bound a -> a
Foldable, Functor Bound
Foldable Bound
(Functor Bound, Foldable Bound) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Bound a -> f (Bound b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Bound (f a) -> f (Bound a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Bound a -> m (Bound b))
-> (forall (m :: * -> *) a. Monad m => Bound (m a) -> m (Bound a))
-> Traversable Bound
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Bound (m a) -> m (Bound a)
forall (f :: * -> *) a. Applicative f => Bound (f a) -> f (Bound a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bound a -> m (Bound b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Bound a -> f (Bound b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Bound a -> f (Bound b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Bound a -> f (Bound b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Bound (f a) -> f (Bound a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Bound (f a) -> f (Bound a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bound a -> m (Bound b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bound a -> m (Bound b)
$csequence :: forall (m :: * -> *) a. Monad m => Bound (m a) -> m (Bound a)
sequence :: forall (m :: * -> *) a. Monad m => Bound (m a) -> m (Bound a)
Traversable)

-- | Order is like @'Open' k = (k, False)@, @'Closed' k = (k, True)@.
--
instance Ord k => Ord (Bound k) where
    compare :: Bound k -> Bound k -> Ordering
compare (Open k
k)   (Open k
k')   = k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
k'
    compare (Closed k
k) (Closed k
k') = k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
k'
    compare (Open k
k)   (Closed k
k') = case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
k' of
        Ordering
LT -> Ordering
LT
        Ordering
EQ -> Ordering
LT
        Ordering
GT -> Ordering
GT
    compare (Closed k
k) (Open k
k')   = case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
k' of
        Ordering
LT -> Ordering
LT
        Ordering
EQ -> Ordering
GT
        Ordering
GT -> Ordering
GT

-------------------------------------------------------------------------------
-- Instances
-------------------------------------------------------------------------------

-- | 'pure' is a constant function.
instance Ord k => Applicative (SF k) where
    pure :: forall a. a -> SF k a
pure  = a -> SF k a
forall a k. a -> SF k a
constant
    <*> :: forall a b. SF k (a -> b) -> SF k a -> SF k b
(<*>) = SF k (a -> b) -> SF k a -> SF k b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Ord k => Monad (SF k) where
    return :: forall a. a -> SF k a
return = a -> SF k a
forall a. a -> SF k a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

    SF Map (Bound k) a
m a
def0 >>= :: forall a b. SF k a -> (a -> SF k b) -> SF k b
>>= a -> SF k b
f = Map (Bound k) b -> b -> SF k b
forall k v. Map (Bound k) v -> v -> SF k v
SF
        ([(Bound k, b)] -> Map (Bound k) b
forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList ([(Bound k, b)] -> Map (Bound k) b)
-> [(Bound k, b)] -> Map (Bound k) b
forall a b. (a -> b) -> a -> b
$ [(Bound k, b)] -> [(Bound k, b)]
forall k b. Ord k => [(k, b)] -> [(k, b)]
mkDistinctAscList ([(Bound k, b)] -> [(Bound k, b)])
-> [(Bound k, b)] -> [(Bound k, b)]
forall a b. (a -> b) -> a -> b
$ [(Bound k, b)]
pieces [(Bound k, b)] -> [(Bound k, b)] -> [(Bound k, b)]
forall a. [a] -> [a] -> [a]
++ [(Bound k, b)]
pieces1)
        b
def1
      where
        pieces :: [(Bound k, b)]
pieces =
            [ (Bound k -> Bound k -> Bound k
forall a. Ord a => a -> a -> a
min Bound k
k Bound k
k', b
v')
            | (Bound k
k, a
v) <- Map (Bound k) a -> [(Bound k, a)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Bound k) a
m
            , let SF Map (Bound k) b
m' b
def = a -> SF k b
f a
v
            , (Bound k
k', b
v') <- Map (Bound k) b -> [(Bound k, b)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Bound k) b
m' [(Bound k, b)] -> [(Bound k, b)] -> [(Bound k, b)]
forall a. [a] -> [a] -> [a]
++ [(Bound k
k, b
def)]
            ]
        ([(Bound k, b)]
pieces1, b
def1) = let SF Map (Bound k) b
m' b
def = a -> SF k b
f a
def0 in (Map (Bound k) b -> [(Bound k, b)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Bound k) b
m', b
def)

-- | Piecewise '<>'.
--
-- >>> putSF $ step 0 "a" "b" <> step 1 "c" "d"
-- \x -> if
--     | x < 0     -> "ac"
--     | x < 1     -> "bc"
--     | otherwise -> "bd"
--
instance (Ord k, Semigroup v) => Semigroup (SF k v) where
    <> :: SF k v -> SF k v -> SF k v
(<>) = (v -> v -> v) -> SF k v -> SF k v -> SF k v
forall a b c. (a -> b -> c) -> SF k a -> SF k b -> SF k c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 v -> v -> v
forall a. Semigroup a => a -> a -> a
(<>)

instance (Ord k, Monoid v) => Monoid (SF k v) where
    mempty :: SF k v
mempty = v -> SF k v
forall a. a -> SF k a
forall (f :: * -> *) a. Applicative f => a -> f a
pure v
forall a. Monoid a => a
mempty
    mappend :: SF k v -> SF k v -> SF k v
mappend = (v -> v -> v) -> SF k v -> SF k v -> SF k v
forall a b c. (a -> b -> c) -> SF k a -> SF k b -> SF k c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 v -> v -> v
forall a. Monoid a => a -> a -> a
mappend

instance (Ord k, QC.Arbitrary k, QC.Arbitrary v) => QC.Arbitrary (SF k v) where
    arbitrary :: Gen (SF k v)
arbitrary = [(Bound k, v)] -> v -> SF k v
forall k v. Ord k => [(Bound k, v)] -> v -> SF k v
fromList ([(Bound k, v)] -> v -> SF k v)
-> Gen [(Bound k, v)] -> Gen (v -> SF k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [(Bound k, v)]
forall a. Arbitrary a => Gen a
QC.arbitrary Gen (v -> SF k v) -> Gen v -> Gen (SF k v)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen v
forall a. Arbitrary a => Gen a
QC.arbitrary
    shrink :: SF k v -> [SF k v]
shrink (SF Map (Bound k) v
m v
v) = ([(Bound k, v)] -> v -> SF k v) -> ([(Bound k, v)], v) -> SF k v
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [(Bound k, v)] -> v -> SF k v
forall k v. Ord k => [(Bound k, v)] -> v -> SF k v
fromList (([(Bound k, v)], v) -> SF k v)
-> [([(Bound k, v)], v)] -> [SF k v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([(Bound k, v)], v) -> [([(Bound k, v)], v)]
forall a. Arbitrary a => a -> [a]
QC.shrink (Map (Bound k) v -> [(Bound k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Bound k) v
m, v
v)

instance QC.Arbitrary k => QC.Arbitrary (Bound k) where
    arbitrary :: Gen (Bound k)
arbitrary = [Gen (Bound k)] -> Gen (Bound k)
forall a. HasCallStack => [Gen a] -> Gen a
QC.oneof [k -> Bound k
forall k. k -> Bound k
Open (k -> Bound k) -> Gen k -> Gen (Bound k)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen k
forall a. Arbitrary a => Gen a
QC.arbitrary, k -> Bound k
forall k. k -> Bound k
Closed (k -> Bound k) -> Gen k -> Gen (Bound k)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen k
forall a. Arbitrary a => Gen a
QC.arbitrary]

instance NFData k => NFData (Bound k) where
    rnf :: Bound k -> ()
rnf (Open k
k) = k -> ()
forall a. NFData a => a -> ()
rnf k
k
    rnf (Closed k
k) = k -> ()
forall a. NFData a => a -> ()
rnf k
k

instance (NFData k, NFData v) => NFData (SF k v) where
    rnf :: SF k v -> ()
rnf (SF Map (Bound k) v
m v
v) = (Map (Bound k) v, v) -> ()
forall a. NFData a => a -> ()
rnf (Map (Bound k) v
m, v
v)

-------------------------------------------------------------------------------
-- Show
-------------------------------------------------------------------------------

instance Show2 SF where
    liftShowsPrec2 :: forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> SF a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
spk [a] -> ShowS
slk Int -> b -> ShowS
spv [b] -> ShowS
slv Int
d (SF Map (Bound a) b
m b
v) = (Int -> [(Bound a, b)] -> ShowS)
-> (Int -> b -> ShowS)
-> String
-> Int
-> [(Bound a, b)]
-> b
-> ShowS
forall a b.
(Int -> a -> ShowS)
-> (Int -> b -> ShowS) -> String -> Int -> a -> b -> ShowS
showsBinaryWith
        (\Int
_ -> ((Bound a, b) -> ShowS) -> [(Bound a, b)] -> ShowS
forall a. (a -> ShowS) -> [a] -> ShowS
showListWith (((Bound a, b) -> ShowS) -> [(Bound a, b)] -> ShowS)
-> ((Bound a, b) -> ShowS) -> [(Bound a, b)] -> ShowS
forall a b. (a -> b) -> a -> b
$ (Int -> Bound a -> ShowS)
-> ([Bound a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> (Bound a, b)
-> ShowS
forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> (a, b)
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 ((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Bound a -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Bound a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
spk [a] -> ShowS
slk) ((Int -> a -> ShowS) -> ([a] -> ShowS) -> [Bound a] -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [Bound a] -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
liftShowList Int -> a -> ShowS
spk [a] -> ShowS
slk) Int -> b -> ShowS
spv [b] -> ShowS
slv Int
0)
        Int -> b -> ShowS
spv
        String
"fromList" Int
d (Map (Bound a) b -> [(Bound a, b)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Bound a) b
m) b
v

instance Show k => Show1 (SF k) where
    liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> SF k a -> ShowS
liftShowsPrec = (Int -> k -> ShowS)
-> ([k] -> ShowS)
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> SF k a
-> ShowS
forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> SF a b
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> k -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [k] -> ShowS
forall a. Show a => [a] -> ShowS
showList

instance (Show k, Show v) => Show (SF k v) where
    showsPrec :: Int -> SF k v -> ShowS
showsPrec = Int -> SF k v -> ShowS
forall (f :: * -> * -> *) a b.
(Show2 f, Show a, Show b) =>
Int -> f a b -> ShowS
showsPrec2

instance Show1 Bound where
    liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Bound a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
_ Int
d (Open a
k)   = (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> a -> ShowS
sp String
"Open"   Int
d a
k
    liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
_ Int
d (Closed a
k) = (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> a -> ShowS
sp String
"Closed" Int
d a
k

-------------------------------------------------------------------------------
-- Helpers
-------------------------------------------------------------------------------

mkDistinctAscList :: Ord k => [(k, b)] -> [(k, b)]
mkDistinctAscList :: forall k b. Ord k => [(k, b)] -> [(k, b)]
mkDistinctAscList []            = []
mkDistinctAscList ((k
k, b
v) : [(k, b)]
kv) = (k
k, b
v) (k, b) -> [(k, b)] -> [(k, b)]
forall a. a -> [a] -> [a]
: k -> [(k, b)] -> [(k, b)]
forall k b. Ord k => k -> [(k, b)] -> [(k, b)]
mkDistinctAscList' k
k [(k, b)]
kv

mkDistinctAscList' :: Ord k => k -> [(k, b)] -> [(k, b)]
mkDistinctAscList' :: forall k b. Ord k => k -> [(k, b)] -> [(k, b)]
mkDistinctAscList' k
_ [] = []
mkDistinctAscList' k
k (p :: (k, b)
p@(k
k', b
_) : [(k, b)]
kv)
    | k
k k -> k -> Bool
forall a. Ord a => a -> a -> Bool
< k
k'    = (k, b)
p (k, b) -> [(k, b)] -> [(k, b)]
forall a. a -> [a] -> [a]
: k -> [(k, b)] -> [(k, b)]
forall k b. Ord k => k -> [(k, b)] -> [(k, b)]
mkDistinctAscList' k
k' [(k, b)]
kv
    | Bool
otherwise =     k -> [(k, b)] -> [(k, b)]
forall k b. Ord k => k -> [(k, b)] -> [(k, b)]
mkDistinctAscList' k
k  [(k, b)]
kv

-------------------------------------------------------------------------------
-- Operators
-------------------------------------------------------------------------------

infixl 9 !

-- | Apply 'SF'.
--
-- >>> heaviside ! 2
-- 1
(!) :: Ord k => SF k v -> k -> v
SF Map (Bound k) v
m v
def ! :: forall k v. Ord k => SF k v -> k -> v
! k
x = case Bound k -> Map (Bound k) v -> Maybe (Bound k, v)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupGE (k -> Bound k
forall k. k -> Bound k
Closed k
x) Map (Bound k) v
m of
    Maybe (Bound k, v)
Nothing     -> v
def
    Just (Bound k
_, v
v) -> v
v

-------------------------------------------------------------------------------
-- Construction
-------------------------------------------------------------------------------

-- | Constant function
--
-- >>> putSF $ constant 1
-- \_ -> 1
--
constant :: a -> SF k a
constant :: forall a k. a -> SF k a
constant = Map (Bound k) a -> a -> SF k a
forall k v. Map (Bound k) v -> v -> SF k v
SF Map (Bound k) a
forall k a. Map k a
Map.empty

-- | Step function.
--
-- @'step' k v1 v2 = \\ x -> if x < k then v1 else v2@.
--
-- >>> putSF $ step 1 2 3
-- \x -> if
--     | x < 1     -> 2
--     | otherwise -> 3
--
step :: k -> v -> v -> SF k v
step :: forall k v. k -> v -> v -> SF k v
step k
k = Map (Bound k) v -> v -> SF k v
forall k v. Map (Bound k) v -> v -> SF k v
SF (Map (Bound k) v -> v -> SF k v)
-> (v -> Map (Bound k) v) -> v -> v -> SF k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bound k -> v -> Map (Bound k) v
forall k a. k -> a -> Map k a
Map.singleton (k -> Bound k
forall k. k -> Bound k
Open k
k)

-- | Create function from list of cases and default value.
--
-- >>> let f = fromList [(Open 1,2),(Closed 3,4),(Open 4,5)] 6
-- >>> putSF f
-- \x -> if
--     | x <  1    -> 2
--     | x <= 3    -> 4
--     | x <  4    -> 5
--     | otherwise -> 6
--
-- >>> map (f !) [0..10]
-- [2,4,4,4,6,6,6,6,6,6,6]
--
fromList :: Ord k => [(Bound k, v)] -> v -> SF k v
fromList :: forall k v. Ord k => [(Bound k, v)] -> v -> SF k v
fromList = Map (Bound k) v -> v -> SF k v
forall k v. Map (Bound k) v -> v -> SF k v
SF (Map (Bound k) v -> v -> SF k v)
-> ([(Bound k, v)] -> Map (Bound k) v)
-> [(Bound k, v)]
-> v
-> SF k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Bound k, v)] -> Map (Bound k) v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList

-------------------------------------------------------------------------------
-- Conversions to/from list
-------------------------------------------------------------------------------

-- | Possible values of 'SF'
--
-- >>> values heaviside
-- [-1,1]
--
values :: SF k v -> [v]
values :: forall k a. SF k a -> [a]
values (SF Map (Bound k) v
m v
v) = Map (Bound k) v -> [v]
forall k a. Map k a -> [a]
Map.elems Map (Bound k) v
m [v] -> [v] -> [v]
forall a. [a] -> [a] -> [a]
++ [v
v]

-------------------------------------------------------------------------------
-- Normalise
-------------------------------------------------------------------------------

-- | Merge adjustent pieces with same values.
--
-- /Note:/ 'SF' isn't normalised on construction.
-- Values don't necessarily are 'Eq'.
--
-- >>> putSF $ normalise heaviside
-- \x -> if
--     | x < 0     -> -1
--     | otherwise -> 1
--
-- >>> putSF $ normalise $ step 0 1 1
-- \_ -> 1
--
-- prop> normalise (liftA2 (+) p (fmap negate p)) == (pure 0 :: SF Int Int)
--
normalise :: Eq v => SF k v -> SF k v
normalise :: forall v k. Eq v => SF k v -> SF k v
normalise (SF Map (Bound k) v
m v
v) = ([(Bound k, v)] -> v -> SF k v) -> ([(Bound k, v)], v) -> SF k v
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [(Bound k, v)] -> v -> SF k v
forall {k} {p}. [(Bound k, v)] -> p -> SF k v
mk (([(Bound k, v)], v) -> SF k v) -> ([(Bound k, v)], v) -> SF k v
forall a b. (a -> b) -> a -> b
$ ((Bound k, v) -> ([(Bound k, v)], v) -> ([(Bound k, v)], v))
-> ([(Bound k, v)], v) -> [(Bound k, v)] -> ([(Bound k, v)], v)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Bound k, v) -> ([(Bound k, v)], v) -> ([(Bound k, v)], v)
forall {a} {a}. Eq a => (a, a) -> ([(a, a)], a) -> ([(a, a)], a)
go ([], v
v) (Map (Bound k) v -> [(Bound k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Bound k) v
m) where
    mk :: [(Bound k, v)] -> p -> SF k v
mk [(Bound k, v)]
m' p
_ = Map (Bound k) v -> v -> SF k v
forall k v. Map (Bound k) v -> v -> SF k v
SF ([(Bound k, v)] -> Map (Bound k) v
forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList [(Bound k, v)]
m') v
v

    go :: (a, a) -> ([(a, a)], a) -> ([(a, a)], a)
go p :: (a, a)
p@(a
_, a
v') p' :: ([(a, a)], a)
p'@([(a, a)]
m', a
x)
        | a
v' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x   = ([(a, a)], a)
p'
        | Bool
otherwise = ((a, a)
p (a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
: [(a, a)]
m', a
v')

-------------------------------------------------------------------------------
-- Pretty-printing
-------------------------------------------------------------------------------

-- | Show 'SF' as Haskell code
showSF :: (Show a, Show b) => SF a b -> String
showSF :: forall k v. (Show k, Show v) => SF k v -> String
showSF (SF Map (Bound a) b
m b
v) | Map (Bound a) b -> Bool
forall k a. Map k a -> Bool
Map.null Map (Bound a) b
m = String
"\\_ -> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Show a => a -> String
show b
v
showSF (SF Map (Bound a) b
m b
v) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
    String
"\\x -> if" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [ String
"    | " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
leftPad String
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" -> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x | (String
k, String
x) <- [(String, String)]
cases ]
  where
    cases :: [(String, String)]
cases     = [(String, String)]
cases' [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ [ (String
"otherwise", b -> String
forall a. Show a => a -> String
show b
v) ]

    m' :: [(Bound a, b)]
m' = Map (Bound a) b -> [(Bound a, b)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Bound a) b
m

    cases' :: [(String, String)]
cases' = case ((Bound a, b) -> Maybe (a, b)) -> [(Bound a, b)] -> Maybe [(a, b)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Bound a, b) -> Maybe (a, b)
forall {a} {b}. (Bound a, b) -> Maybe (a, b)
fromOpen [(Bound a, b)]
m' of
        Maybe [(a, b)]
Nothing  -> [ (String
"x " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Bound a -> String
forall k. Show k => Bound k -> String
showBound Bound a
k, b -> String
forall a. Show a => a -> String
show b
x) | (Bound a
k, b
x) <- [(Bound a, b)]
m' ]
        Just [(a, b)]
m'' -> [ (String
"x < " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
k,    b -> String
forall a. Show a => a -> String
show b
x) | (a
k, b
x) <- [(a, b)]
m'' ]

    fromOpen :: (Bound a, b) -> Maybe (a, b)
fromOpen (Open a
k, b
x) = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
k, b
x)
    fromOpen (Bound a, b)
_           = Maybe (a, b)
forall a. Maybe a
Nothing

    len :: Int
len       = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (((String, String) -> Int) -> [(String, String)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int)
-> ((String, String) -> String) -> (String, String) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst) [(String, String)]
cases)
    leftPad :: ShowS
leftPad String
s = String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Char
' '

showBound :: Show k => Bound k -> String
showBound :: forall k. Show k => Bound k -> String
showBound (Open k
k)   = String
"<  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> k -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
5 k
k String
""
showBound (Closed k
k) = String
"<= " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> k -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
5 k
k String
""

-- | @'putStrLn' . 'showSF'@
putSF :: (Show a, Show b) => SF a b -> IO ()
putSF :: forall a b. (Show a, Show b) => SF a b -> IO ()
putSF = String -> IO ()
putStrLn (String -> IO ()) -> (SF a b -> String) -> SF a b -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SF a b -> String
forall k v. (Show k, Show v) => SF k v -> String
showSF

-- $setup
--
-- >>> import Test.QuickCheck (applyFun2)
-- >>> import Test.QuickCheck.Poly (A, B, C)
-- >>> import Control.Applicative (liftA2, pure)
-- >>> import Data.Semigroup (Semigroup (..))
--
-- == Examples
--
-- >>> let heaviside = step 0 (-1) 1 :: SF Int Int
-- >>> putSF heaviside
-- \x -> if
--     | x < 0     -> -1
--     | otherwise -> 1
--
-- >>> map (heaviside !) [-3, 0, 4]
-- [-1,1,1]