{-# LANGUAGE GADTs #-}
module Data.HashMap.InsOrd.Internal where

import Prelude hiding (filter, foldr, lookup, map, null)

import Control.Applicative ((<**>))

-------------------------------------------------------------------------------
-- SortedAp
-------------------------------------------------------------------------------

-- Sort using insertion sort
-- Hopefully it's fast enough for where we need it
-- otherwise: https://gist.github.com/treeowl/9621f58d55fe0c4f9162be0e074b1b29
-- http://elvishjerricco.github.io/2017/03/23/applicative-sorting.html also related

-- Free applicative which re-orders effects
-- Mostly from Edward Kmett's `free` package.
data SortedAp f a where
    Pure :: a -> SortedAp f a
    SortedAp   :: !Int -> f a -> SortedAp f (a -> b) -> SortedAp f b

instance Functor (SortedAp f) where
    fmap :: forall a b. (a -> b) -> SortedAp f a -> SortedAp f b
fmap a -> b
f (Pure a
a)   = b -> SortedAp f b
forall a (f :: * -> *). a -> SortedAp f a
Pure (a -> b
f a
a)
    fmap a -> b
f (SortedAp Int
i f a
x SortedAp f (a -> a)
y)   = Int -> f a -> SortedAp f (a -> b) -> SortedAp f b
forall (f :: * -> *) a b.
Int -> f a -> SortedAp f (a -> b) -> SortedAp f b
SortedAp Int
i f a
x ((a -> b
f (a -> b) -> (a -> a) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((a -> a) -> a -> b) -> SortedAp f (a -> a) -> SortedAp f (a -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SortedAp f (a -> a)
y)

instance Applicative (SortedAp f) where
    pure :: forall a. a -> SortedAp f a
pure = a -> SortedAp f a
forall a (f :: * -> *). a -> SortedAp f a
Pure
    Pure a -> b
f <*> :: forall a b. SortedAp f (a -> b) -> SortedAp f a -> SortedAp f b
<*> SortedAp f a
y = (a -> b) -> SortedAp f a -> SortedAp f b
forall a b. (a -> b) -> SortedAp f a -> SortedAp f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f SortedAp f a
y
    -- This is different from real Ap
    SortedAp f (a -> b)
f <*> Pure a
y = ((a -> b) -> b) -> SortedAp f (a -> b) -> SortedAp f b
forall a b. (a -> b) -> SortedAp f a -> SortedAp f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
y) SortedAp f (a -> b)
f
    f :: SortedAp f (a -> b)
f@(SortedAp Int
i f a
x SortedAp f (a -> a -> b)
y) <*> z :: SortedAp f a
z@(SortedAp Int
j f a
u SortedAp f (a -> a)
v)
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
j     = Int -> f a -> SortedAp f (a -> b) -> SortedAp f b
forall (f :: * -> *) a b.
Int -> f a -> SortedAp f (a -> b) -> SortedAp f b
SortedAp Int
i f a
x ((a -> a -> b) -> a -> a -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a -> a -> b) -> a -> a -> b)
-> SortedAp f (a -> a -> b) -> SortedAp f (a -> a -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SortedAp f (a -> a -> b)
y SortedAp f (a -> a -> b) -> SortedAp f a -> SortedAp f (a -> b)
forall a b. SortedAp f (a -> b) -> SortedAp f a -> SortedAp f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SortedAp f a
z)
        | Bool
otherwise = Int -> f a -> SortedAp f (a -> b) -> SortedAp f b
forall (f :: * -> *) a b.
Int -> f a -> SortedAp f (a -> b) -> SortedAp f b
SortedAp Int
j f a
u ((a -> b) -> (a -> a) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ((a -> b) -> (a -> a) -> a -> b)
-> SortedAp f (a -> b) -> SortedAp f ((a -> a) -> a -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SortedAp f (a -> b)
f SortedAp f ((a -> a) -> a -> b)
-> SortedAp f (a -> a) -> SortedAp f (a -> b)
forall a b. SortedAp f (a -> b) -> SortedAp f a -> SortedAp f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SortedAp f (a -> a)
v)

liftSortedAp :: Int -> f a -> SortedAp f a
liftSortedAp :: forall (f :: * -> *) a. Int -> f a -> SortedAp f a
liftSortedAp Int
i f a
x = Int -> f a -> SortedAp f (a -> a) -> SortedAp f a
forall (f :: * -> *) a b.
Int -> f a -> SortedAp f (a -> b) -> SortedAp f b
SortedAp Int
i f a
x ((a -> a) -> SortedAp f (a -> a)
forall a (f :: * -> *). a -> SortedAp f a
Pure a -> a
forall a. a -> a
id)

retractSortedAp :: Applicative f => SortedAp f a -> f a
retractSortedAp :: forall (f :: * -> *) a. Applicative f => SortedAp f a -> f a
retractSortedAp (Pure a
x) = a -> f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
retractSortedAp (SortedAp Int
_ f a
f SortedAp f (a -> a)
x) = f a
f f a -> f (a -> a) -> f a
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> SortedAp f (a -> a) -> f (a -> a)
forall (f :: * -> *) a. Applicative f => SortedAp f a -> f a
retractSortedAp SortedAp f (a -> a)
x