AdaptiveTuple.hs

-- |This module provides support for adaptive tuples.
-- An `AdaptiveTuple` is a tuple type with the size chosen at run-time and
-- minimal overhead.  All elements must be of the same type.  Calculations
-- are generated by combining adaptive tuples, which are then given an
-- initial input with the `reifyTuple` function or its strict variant.
--
-- Example: suppose you have a list of numbers that is either a single list
-- or multiple interleaved lists.  You wish to determine the maximum value
-- of the single list or maximums of all interleaved lists.
--
-- >  -- |The second  argument is a dummy argument to fix the type of c s ()
-- >  -- so this function can be used directly with reifyTuple
-- >  deinterleave :: AdaptiveTuple c s => [Int] -> c s () -> [c s Int]
-- >  deinterleave [] _ = []
-- >  deinterleave xs n = let (h, rest) = splitAt (tupLength n) xs
-- >                      in toATuple h : deinterleave n rest
-- >
-- >  maxVals :: AdaptiveTuple c s => [c s Int] -> c s Int
-- >  maxVals = foldl' (\a b -> max <$> a <*> b) (pure 0)
-- >
-- >  runner :: Int -> [Int] -> [Int]
-- >  runner n xs = reifyStrictTuple n (repeat ())
-- >                  (fromATuple . maxVals . deinterleave xs)
--
-- using AdaptiveTuple is similar to the `ZipList` applicative instance, except
-- without the overhead.

{-# LANGUAGE MultiParamTypeClasses,
             FlexibleInstances,
             FlexibleContexts,
             ScopedTypeVariables,
             Rank2Types,
             GeneralizedNewtypeDeriving,
             TemplateHaskell #-}

{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

module Data.AdaptiveTuple (
  -- * Types
  -- ** Classes
  AdaptiveTuple (..)
  -- ** Exceptions
  ,AdaptiveTupleException (..)
  -- * Functions
  ,reifyTuple
  ,reifyStrictTuple
  ,invert
  ,mapIndexed
)

where

import Prelude -- hiding (take, drop, splitAt, foldl)
import qualified Prelude as P

import Data.AdaptiveTuple.AdaptiveTuple
import qualified Data.AdaptiveTuple.Reps.Lazy as L
import qualified Data.AdaptiveTuple.Reps.Strict as S

import Data.TypeLevel.Num

import Control.Arrow
import Control.Applicative

-- helper function
fI :: (Integral a, Num b) => a -> b
fI = fromIntegral

-- --------------------------------------------------

-- |Lazily convert a list of AdaptiveTuples into an AdaptiveTuple of lists.
invert :: (AdaptiveTuple c s) => [c s a] -> c s [a]
invert []     = pure []
invert (x:xs) = (:) <$> x <*> invert xs

-- |Map a 0-indexed function over an AdaptiveTuple
mapIndexed :: (AdaptiveTuple c s) => (Int -> a -> b) -> c s a -> c s b
mapIndexed f a = f <$> toATuple [0..] <*> a

--reification function

-- |run a computation using a lazy AdaptiveTuple
reifyTuple :: forall el r. Int -> [el] -> (forall c s. (AdaptiveTuple c s, Nat s) => c s el -> r) -> r
reifyTuple 0 xs f = f (toATuple xs :: ATuple0 D0 el)
reifyTuple 1  xs f = f (toATuple xs :: L.ATuple1 D1  el)
reifyTuple 2  xs f = f (toATuple xs :: L.ATuple2 D2  el)
reifyTuple 3  xs f = f (toATuple xs :: L.ATuple3 D3  el)
reifyTuple 4  xs f = f (toATuple xs :: L.ATuple4 D4  el)
reifyTuple 5  xs f = f (toATuple xs :: L.ATuple5 D5  el)
reifyTuple 6  xs f = f (toATuple xs :: L.ATuple6 D6  el)
reifyTuple 7  xs f = f (toATuple xs :: L.ATuple7 D7  el)
reifyTuple 8  xs f = f (toATuple xs :: L.ATuple8 D8  el)
reifyTuple 9  xs f = f (toATuple xs :: L.ATuple9 D9  el)
reifyTuple 10 xs f = f (toATuple xs :: L.ATuple10 D10 el)
reifyTuple 11 xs f = f (toATuple xs :: L.ATuple11 D11 el)
reifyTuple 12 xs f = f (toATuple xs :: L.ATuple12 D12 el)
reifyTuple 13 xs f = f (toATuple xs :: L.ATuple13 D13 el)
reifyTuple 14 xs f = f (toATuple xs :: L.ATuple14 D14 el)
reifyTuple 15 xs f = f (toATuple xs :: L.ATuple15 D15 el)
reifyTuple 16 xs f = f (toATuple xs :: L.ATuple16 D16 el)
reifyTuple 17 xs f = f (toATuple xs :: L.ATuple17 D17 el)
reifyTuple 18 xs f = f (toATuple xs :: L.ATuple18 D18 el)
reifyTuple 19 xs f = f (toATuple xs :: L.ATuple19 D19 el)
reifyTuple 20 xs f = f (toATuple xs :: L.ATuple20 D20 el)
reifyTuple n xs f = reifyIntegral n $ \n' -> f (makeListTuple n' xs)

-- |run a computation using a strict AdaptiveTuple
reifyStrictTuple :: forall el r. Int -> [el] -> (forall c s. (AdaptiveTuple c s, Nat s) => c s el -> r) -> r
reifyStrictTuple 0 xs f = f (toATuple xs :: ATuple0 D0 el)
reifyStrictTuple 1  xs f = f (toATuple xs :: S.ATuple1 D1  el)
reifyStrictTuple 2  xs f = f (toATuple xs :: S.ATuple2 D2  el)
reifyStrictTuple 3  xs f = f (toATuple xs :: S.ATuple3 D3  el)
reifyStrictTuple 4  xs f = f (toATuple xs :: S.ATuple4 D4  el)
reifyStrictTuple 5  xs f = f (toATuple xs :: S.ATuple5 D5  el)
reifyStrictTuple 6  xs f = f (toATuple xs :: S.ATuple6 D6  el)
reifyStrictTuple 7  xs f = f (toATuple xs :: S.ATuple7 D7  el)
reifyStrictTuple 8  xs f = f (toATuple xs :: S.ATuple8 D8  el)
reifyStrictTuple 9  xs f = f (toATuple xs :: S.ATuple9 D9  el)
reifyStrictTuple 10 xs f = f (toATuple xs :: S.ATuple10 D10 el)
reifyStrictTuple 11 xs f = f (toATuple xs :: S.ATuple11 D11 el)
reifyStrictTuple 12 xs f = f (toATuple xs :: S.ATuple12 D12 el)
reifyStrictTuple 13 xs f = f (toATuple xs :: S.ATuple13 D13 el)
reifyStrictTuple 14 xs f = f (toATuple xs :: S.ATuple14 D14 el)
reifyStrictTuple 15 xs f = f (toATuple xs :: S.ATuple15 D15 el)
reifyStrictTuple 16 xs f = f (toATuple xs :: S.ATuple16 D16 el)
reifyStrictTuple 17 xs f = f (toATuple xs :: S.ATuple17 D17 el)
reifyStrictTuple 18 xs f = f (toATuple xs :: S.ATuple18 D18 el)
reifyStrictTuple 19 xs f = f (toATuple xs :: S.ATuple19 D19 el)
reifyStrictTuple 20 xs f = f (toATuple xs :: S.ATuple20 D20 el)
reifyStrictTuple n xs f = reifyIntegral n $ \n' -> f (makeListTuple n' xs)

-- -------------------------------------------------------
-- no-element tuple

data ATuple0 s el = ATuple0 deriving (Eq, Show)

instance Functor (ATuple0 D0) where
  fmap _ _ = ATuple0

instance Applicative (ATuple0 D0) where
  pure _  = ATuple0
  _ <*> _ = ATuple0

instance AdaptiveTuple ATuple0 D0 where
  getIndex _ n   = oObExcp "getIndex"
  setIndex _ _ _ = ATuple0
  mapIndex _ _ _ = ATuple0
  toATuple _     = ATuple0
  fromATuple _   = []


-- |A ListTuple is a List with a type-level length.
-- to be used when there isn't a more specific adaptive tuple defined
newtype Nat s => ListTuple s a = ListTuple {getListTuple :: [a]}
  deriving (Eq, Functor, Show)

-- |Create a ListTuple
makeListTuple :: Nat s => s -> [a] -> ListTuple s a
makeListTuple s xs | toInt s P.< P.length xs =
  error $ "input list to short to make ListTuple of length " ++
          (show $ toInt s)
makeListTuple s xs = ListTuple . P.take (toInt s) $ xs

instance Nat s => Applicative (ListTuple s) where
  pure    = pureLT
  a <*> b = ListTuple $ zipWith ($) (getListTuple a) (getListTuple b)

pureLT :: forall s a. (Nat s) => a -> ListTuple s a
pureLT = ListTuple . replicate (toInt (undefined :: s))

instance forall s. (Nat s) => AdaptiveTuple ListTuple s where
  getIndex z i = getListTuple z !! (fI i)
  setIndex i el = ListTuple . uncurry (++) . ((++ [el]) *** P.drop 1) .
                        P.splitAt (fI i) . getListTuple
  mapIndex f i  = ListTuple . uncurry (++) . second (\(x:xs) -> f x : xs) .
                        P.splitAt (fI i) . getListTuple
  toATuple      = makeListTuple (undefined :: s)
  fromATuple    = getListTuple