{-# LANGUAGE GADTs #-}
module Data.HashMap.InsOrd.Internal where
import Prelude ()
import Prelude.Compat 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 f (Pure a) = Pure (f a)
fmap f (SortedAp i x y) = SortedAp i x ((f .) <$> y)
instance Applicative (SortedAp f) where
pure = Pure
Pure f <*> y = fmap f y
-- This is different from real Ap
f <*> Pure y = fmap ($ y) f
f@(SortedAp i x y) <*> z@(SortedAp j u v)
| i < j = SortedAp i x (flip <$> y <*> z)
| otherwise = SortedAp j u ((.) <$> f <*> v)
liftSortedAp :: Int -> f a -> SortedAp f a
liftSortedAp i x = SortedAp i x (Pure id)
retractSortedAp :: Applicative f => SortedAp f a -> f a
retractSortedAp (Pure x) = pure x
retractSortedAp (SortedAp _ f x) = f <**> retractSortedAp x