-- |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