module Data.AdaptiveTuple (
AdaptiveTuple (..)
,AdaptiveTupleException (..)
,reifyTuple
,reifyStrictTuple
,invert
,mapIndexed
)
where
import Prelude
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
fI :: (Integral a, Num b) => a -> b
fI = fromIntegral
invert :: (AdaptiveTuple c s) => [c s a] -> c s [a]
invert [] = pure []
invert (x:xs) = (:) <$> x <*> invert xs
mapIndexed :: (AdaptiveTuple c s) => (Int -> a -> b) -> c s a -> c s b
mapIndexed f a = f <$> toATuple [0..] <*> a
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)
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)
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 _ = []
newtype Nat s => ListTuple s a = ListTuple {getListTuple :: [a]}
deriving (Eq, Functor, Show)
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