module Data.Container.Resizable where
import Prelude hiding ((.))
import Control.Lens
import Control.Monad.Identity
import Data.Container.Class
import Data.Container.List
import Data.Container.Opts (Query(..), ModsOf, ParamsOf)
import qualified Data.Container.Opts as M
import Data.Container.Proxy
import Data.Default
import Data.Layer
import Data.Functor.Utils
data Resizable style a = Resizable !style !a deriving (Show, Functor, Foldable, Traversable, Monoid)
type instance Index (Resizable s a) = Index (Container a)
type instance Item (Resizable s a) = Item (Container a)
type instance Container (Resizable s a) = Resizable s a
type instance DataStore (Resizable s a) = Container a
instance Monad m => IsContainerM m (Resizable s a) where fromContainerM = return
instance Monad m => HasContainerM m (Resizable s a) where viewContainerM = return
setContainerM = const . return
type instance Unlayered (Resizable s a) = a
instance Layered (Resizable s a) where layered = lens (\(Resizable _ a) -> a) (\(Resizable s _) a -> Resizable s a)
instance Monad m => LayeredM m (Resizable s a)
instance (IsContainer a, FromList (Container a), Default s)
=> FromList (Resizable s a) where fromList = Resizable def . fromContainer . fromList
instance (Default s, Default a) => Default (Resizable s a) where def = Resizable def def
instance (ToList (Container a), HasContainer a) => ToList (Resizable s a) where toList = toList . view container . unlayer
style :: Lens' (Resizable s a) s
style = lens (\(Resizable s _) -> s) (\(Resizable _ a) s -> Resizable s a)
data Minimal = Minimal deriving (Show)
data Exponential = Exponential deriving (Show)
data Linear = Linear Int deriving (Show)
instance Default Minimal where def = Minimal
instance Default Exponential where def = Exponential
instance Default Linear where def = Linear 1
class ResizeStep s t where resizeStep :: Resizable s t -> Int
instance ResizeStep Minimal t where resizeStep _ = 1
instance ResizeStep Linear t where resizeStep (view style -> Linear i) = i
instance Measurable (Resizable Exponential t) => ResizeStep Exponential t where resizeStep = checkZeroSize . size
instance Measurable (Resizable Double t) => ResizeStep Double t where resizeStep = (2 *) . checkZeroSize . size
checkZeroSize :: (Num a, Eq a) => a -> a
checkZeroSize s = if s == 0 then 1 else s
type instance ParamsOf MeasurableOp (Resizable s a) = ParamsOf MeasurableOp (Container a)
type instance ModsOf MeasurableOp (Resizable s a) = ModsOf MeasurableOp (Container a)
type instance ParamsOf MinBoundedOp (Resizable s a) = ParamsOf MinBoundedOp (Container a)
type instance ModsOf MinBoundedOp (Resizable s a) = ModsOf MinBoundedOp (Container a)
type instance ParamsOf MaxBoundedOp (Resizable s a) = ParamsOf MaxBoundedOp (Container a)
type instance ModsOf MaxBoundedOp (Resizable s a) = ModsOf MaxBoundedOp (Container a)
instance (MeasurableQM (GetOpts ms) (GetOpts ps) m a) => MeasurableQM_ ms ps m (Resizable s a) where sizeM_ _ = sizeQM (Query :: Query (GetOpts ms) (GetOpts ps)) . unlayer
instance (MinBoundedQM (GetOpts ms) (GetOpts ps) m idx a) => MinBoundedQM_ ms ps m idx (Resizable s a) where minBoundM_ _ = minBoundQM (Query :: Query (GetOpts ms) (GetOpts ps)) . unlayer
instance (MaxBoundedQM (GetOpts ms) (GetOpts ps) m idx a) => MaxBoundedQM_ ms ps m idx (Resizable s a) where maxBoundM_ _ = maxBoundQM (Query :: Query (GetOpts ms) (GetOpts ps)) . unlayer
type instance ParamsOf SingletonOp (Resizable s a) = ParamsOf SingletonOp (Container a)
type instance ModsOf SingletonOp (Resizable s a) = ModsOf SingletonOp (Container a)
type instance ParamsOf AllocableOp (Resizable s a) = ParamsOf AllocableOp (Container a)
type instance ModsOf AllocableOp (Resizable s a) = ModsOf AllocableOp (Container a)
type instance ParamsOf ExpandableOp (Resizable s a) = ParamsOf GrowableOp (Container a)
type instance ModsOf ExpandableOp (Resizable s a) = ModsOf GrowableOp (Container a)
type instance ParamsOf GrowableOp (Resizable s a) = ParamsOf GrowableOp (Container a)
type instance ModsOf GrowableOp (Resizable s a) = ModsOf GrowableOp (Container a)
instance (SingletonQM (GetOpts ms) (GetOpts ps) m el a, Default s) => SingletonQM_ ms ps m el (Resizable s a) where singletonM_ _ = fmap2 (Resizable def) . singletonQM (Query :: Query (GetOpts ms) (GetOpts ps))
instance (AllocableQM (GetOpts ms) (GetOpts ps) m a, Default s) => AllocableQM_ ms ps m (Resizable s a) where allocM_ _ = fmap2 (Resizable def) . allocQM (Query :: Query (GetOpts ms) (GetOpts ps))
instance ( GrowableQM (GetOpts ms) (GetOpts ps) m a, ResizeStep s a
, Result_ GrowableOp (PrimInfo (Container a)) (GetOpts ms) ~ Result_ ExpandableOp (PrimInfo (Resizable s a)) (GetOpts ms)
) => ExpandableQM_ ms ps m (Resizable s a) where expandM_ _ t = nested layered (growQM (Query :: Query (GetOpts ms) (GetOpts ps)) $ resizeStep t) t
type instance ParamsOf AppendableOp (Resizable s a) = ParamsOf AppendableOp (Container a)
type instance ModsOf AppendableOp (Resizable s a) = ModsOf AppendableOp (Container a)
type instance ParamsOf PrependableOp (Resizable s a) = ParamsOf PrependableOp (Container a)
type instance ModsOf PrependableOp (Resizable s a) = ModsOf PrependableOp (Container a)
type instance ParamsOf AddableOp (Resizable s a) = ParamsOf AddableOp (Container a)
type instance ModsOf AddableOp (Resizable s a) = ModsOf AddableOp (Container a)
type instance ParamsOf RemovableOp (Resizable s a) = ParamsOf RemovableOp (Container a)
type instance ModsOf RemovableOp (Resizable s a) = ModsOf RemovableOp (Container a)
type instance ParamsOf InsertableOp (Resizable s a) = ParamsOf InsertableOp (Container a)
type instance ModsOf InsertableOp (Resizable s a) = ModsOf InsertableOp (Container a)
type instance ParamsOf FreeableOp (Resizable s a) = ParamsOf FreeableOp (Container a)
type instance ModsOf FreeableOp (Resizable s a) = ModsOf FreeableOp (Container a)
instance (AppendableQM (GetOpts ms) (GetOpts ps) m el a) => AppendableQM_ ms ps m el (Resizable s a) where appendM_ _ = nested layered . appendQM (Query :: Query (GetOpts ms) (GetOpts ps))
instance (PrependableQM (GetOpts ms) (GetOpts ps) m el a) => PrependableQM_ ms ps m el (Resizable s a) where prependM_ _ = nested layered . prependQM (Query :: Query (GetOpts ms) (GetOpts ps))
instance (AddableQM (GetOpts ms) (GetOpts ps) m el a) => AddableQM_ ms ps m el (Resizable s a) where addM_ _ = nested layered . addQM (Query :: Query (GetOpts ms) (GetOpts ps))
instance (RemovableQM (GetOpts ms) (GetOpts ps) m el a) => RemovableQM_ ms ps m el (Resizable s a) where removeM_ _ = nested layered . removeQM (Query :: Query (GetOpts ms) (GetOpts ps))
instance (InsertableQM (GetOpts ms) (GetOpts ps) m idx el a) => InsertableQM_ ms ps m idx el (Resizable s a) where insertM_ _ = nested layered .: insertQM (Query :: Query (GetOpts ms) (GetOpts ps))
instance (FreeableQM (GetOpts ms) (GetOpts ps) m idx a) => FreeableQM_ ms ps m idx (Resizable s a) where freeM_ _ = nested layered . freeQM (Query :: Query (GetOpts ms) (GetOpts ps))
type instance ParamsOf IndexableOp (Resizable s a) = ParamsOf IndexableOp (Container a)
type instance ModsOf IndexableOp (Resizable s a) = ModsOf IndexableOp (Container a)
type instance ParamsOf TracksIxesOp (Resizable s a) = ParamsOf TracksIxesOp (Container a)
type instance ModsOf TracksIxesOp (Resizable s a) = ModsOf TracksIxesOp (Container a)
type instance ParamsOf TracksFreeIxesOp (Resizable s a) = ParamsOf TracksFreeIxesOp (Container a)
type instance ModsOf TracksFreeIxesOp (Resizable s a) = ModsOf TracksFreeIxesOp (Container a)
type instance ParamsOf TracksUsedIxesOp (Resizable s a) = ParamsOf TracksUsedIxesOp (Container a)
type instance ModsOf TracksUsedIxesOp (Resizable s a) = ModsOf TracksUsedIxesOp (Container a)
type instance ParamsOf TracksElemsOp (Resizable s a) = ParamsOf TracksElemsOp (Container a)
type instance ModsOf TracksElemsOp (Resizable s a) = ModsOf TracksElemsOp (Container a)
instance (IndexableQM (GetOpts ms) (GetOpts ps) m idx el a) => IndexableQM_ ms ps m idx el (Resizable s a) where indexM_ _ idx = indexQM (Query :: Query (GetOpts ms) (GetOpts ps)) idx . unlayer
instance (TracksIxesQM (GetOpts ms) (GetOpts ps) m idx a) => TracksIxesQM_ ms ps m idx (Resizable s a) where ixesM_ _ = ixesQM (Query :: Query (GetOpts ms) (GetOpts ps)) . unlayer
instance (TracksFreeIxesQM (GetOpts ms) (GetOpts ps) m idx a) => TracksFreeIxesQM_ ms ps m idx (Resizable s a) where freeIxesM_ _ = freeIxesQM (Query :: Query (GetOpts ms) (GetOpts ps)) . unlayer
instance (TracksUsedIxesQM (GetOpts ms) (GetOpts ps) m idx a) => TracksUsedIxesQM_ ms ps m idx (Resizable s a) where usedIxesM_ _ = usedIxesQM (Query :: Query (GetOpts ms) (GetOpts ps)) . unlayer
instance (TracksElemsQM (GetOpts ms) (GetOpts ps) m el a) => TracksElemsQM_ ms ps m el (Resizable s a) where elemsM_ _ = elemsQM (Query :: Query (GetOpts ms) (GetOpts ps)) . unlayer