container 0.3.4 → 1.0

raw patch · 23 files changed

+3110/−173 lines, 23 filesdep +data-defaultdep +data-layerdep +functor-utilsdep −convertdep ~basesetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: data-default, data-layer, functor-utils, lens-utils, mtl, template-haskell, transformers, transformers-base, typelevel, vector

Dependencies removed: convert

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Setup.hs +2/−0
• container.cabal +77/−38
• src/Data/Container.hs +8/−0
• src/Data/Container/Auto.hs +54/−0
• src/Data/Container/Class.hs +482/−0
• src/Data/Container/Hetero.hs +157/−0
• src/Data/Container/Immersed.hs +51/−0
• src/Data/Container/Instances.hs +4/−0
• src/Data/Container/Instances/IntSet.hs +12/−0
• src/Data/Container/Instances/Vector/Lazy.hs +213/−0
• src/Data/Container/List.hs +42/−0
• src/Data/Container/Opts.hs +168/−0
• src/Data/Container/Parametrized.hs +44/−0
• src/Data/Container/Poly.hs +611/−0
• src/Data/Container/Proxy.hs +227/−0
• src/Data/Container/Resizable.hs +358/−0
• src/Data/Container/Reusable.hs +197/−0
• src/Data/Container/Type.hs +15/−0
• src/Data/Container/Weak.hs +388/−0
• src/Data/Item.hs +0/−20
• src/Data/List/Class.hs +0/−28
• src/Data/Sequence/Class.hs +0/−53
• src/Data/Set/Mutable/Class.hs +0/−34

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -1,40 +1,79 @@--- This file has been generated from package.yaml by hpack version 0.20.0.------ see: https://github.com/sol/hpack------ hash: 33bcc177224f7b11ee2bedc766f0da717dbbed2bf70e49e7b81beb1bcd4f755a+name:                container+version:             1.0+synopsis:            Containers abstraction and utilities.+-- description:         +license:             Apache-2.0+license-file:        LICENSE+author:              Wojciech Danilo+maintainer:          Wojciech Danilo <wojciech.danilo@gmail.com>+stability:           experimental+homepage:            https://github.com/wdanilo/containers+bug-reports:         https://github.com/wdanilo/containers/issues+copyright:           Copyright (C) 2015 Wojciech Danilo+category:            Text+build-type:          Simple+-- extra-source-files:  +cabal-version:       >=1.10 -name:           container-version:        0.3.4-synopsis:       Containers abstraction and utilities.-category:       Data-stability:      experimental-homepage:       https://github.com/luna/container-bug-reports:    https://github.com/luna/container/issues-author:         Luna Team-maintainer:     Wojciech Danilo <wojciech.danilo@luna-lang.org>-copyright:      Copyright (C) 2018 Luna Team-license:        Apache-2.0-license-file:   LICENSE-build-type:     Simple-cabal-version:  >= 1.10 -library-  hs-source-dirs:-      src-  default-extensions: AllowAmbiguousTypes ApplicativeDo BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DoAndIfThenElse DuplicateRecordFields EmptyDataDecls FlexibleContexts FlexibleInstances FunctionalDependencies GeneralizedNewtypeDeriving InstanceSigs LambdaCase MonadComprehensions MultiWayIf NamedWildCards NegativeLiterals NoImplicitPrelude NumDecimals OverloadedLabels PackageImports QuasiQuotes PatternSynonyms RankNTypes RecursiveDo ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeFamilyDependencies TypeOperators UnicodeSyntax ViewPatterns LiberalTypeSynonyms RelaxedPolyRec-  ghc-options: -Wall -O2-  build-depends:-      base >=4.10 && <4.12-    , containers-    , convert-    , lens-    , text-  exposed-modules:-      Data.Item-      Data.List.Class-      Data.Sequence.Class-      Data.Set.Mutable.Class-  other-modules:-      Paths_container-  default-language: Haskell2010+Library+  hs-source-dirs:     src+  ghc-options:        -Wall -O2+  default-language:   Haskell2010++  default-extensions: ConstraintKinds+                      DataKinds+                      DefaultSignatures+                      DeriveDataTypeable+                      DeriveFoldable+                      DeriveFunctor+                      DeriveGeneric+                      DeriveTraversable+                      DoAndIfThenElse+                      EmptyDataDecls+                      FlexibleContexts+                      FlexibleInstances+                      GeneralizedNewtypeDeriving+                      InstanceSigs+                      LambdaCase+                      MultiParamTypeClasses+                      OverloadedStrings+                      StandaloneDeriving+                      TemplateHaskell+                      TupleSections+                      TypeOperators+                      ViewPatterns+                      TypeFamilies+  +  exposed-modules:    Data.Container+                      Data.Container.Auto+                      Data.Container.Class+                      Data.Container.Hetero+                      Data.Container.Immersed+                      Data.Container.Instances+                      Data.Container.Instances.IntSet+                      Data.Container.Instances.Vector.Lazy+                      Data.Container.List+                      Data.Container.Opts+                      Data.Container.Parametrized+                      Data.Container.Poly+                      Data.Container.Proxy+                      Data.Container.Resizable+                      Data.Container.Reusable+                      Data.Container.Type+                      Data.Container.Weak++  build-depends:      base >=4.6 && <4.9+                    , containers+                    , data-default+                    , data-layer+                    , functor-utils+                    , lens+                    , lens-utils+                    , mtl+                    , template-haskell+                    , transformers+                    , transformers-base+                    , typelevel+                    , vector+                    , text

@@ -0,0 +1,8 @@+module Data.Container (+    module Data.Container,+    module X+) where++import           Data.Container.Class as X+import           Data.Container.Opts  as X (ixed, raw, try, unchecked, unsafe, inplace)+import           Data.Container.Instances ()

@@ -0,0 +1,54 @@+{-# LANGUAGE CPP                  #-}+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE UndecidableInstances #-}++module Data.Container.Auto where++import Prelude++import Control.Lens+import Control.Lens.Utils+import Data.Container.Class+import Data.Container.Resizable+import Data.Container.Reusable+import Data.Container.List+import Data.Layer+import Data.Default+++#define AUTO (Reusable idx (Resizable style a))++newtype Auto idx style a = Auto AUTO deriving (Functor, Traversable, Foldable, Monoid, Default)+type    Auto'    style a = Auto (Index (Container a)) style a++deriving instance (IsContainer a, FromList (Container a), Default style) => FromList (Auto idx style a)++type instance Index (Auto idx style a) = Index   AUTO+type instance Item  (Auto idx style a) = Item AUTO++type instance            DataStore       (Auto idx style a) = DataStore AUTO+type instance            Container       (Auto idx style a) = Container AUTO+instance      Monad m => IsContainerM  m (Auto idx style a) where fromContainerM = fmap Auto . fromContainerM+instance      Monad m => HasContainerM m (Auto idx style a) where viewContainerM = viewContainerM . view layered+                                                                  setContainerM  = layered . setContainerM++instance (HasContainer a, ToList (Container a)) => ToList (Auto idx s a) where toList = toList . unwrap'++-- Wrappers & layers++type instance       Unlayered  (Auto idx style a) = AUTO+instance            Layered    (Auto idx style a)+instance Monad m => LayeredM m (Auto idx style a)+instance            Wrapped    (Auto idx style a) where+    type            Unwrapped  (Auto idx style a) = AUTO+    _Wrapped' = iso (\(Auto a) -> a) Auto+++deriving instance Show AUTO => Show (Auto idx style a)++--instance Show a => Show (Auto idx style a) where+--    showsPrec d (Auto a) = showParen (d > app_prec) $+--            showString "Auto " . showsPrec (succ app_prec) (view (layered . layered) a)+--            --showString $ "Auto " <> show (elems a :: [Item a]) -- . showsPrec (succ app_prec) (view (layered . layered) a)+--        where app_prec = 10+

@@ -0,0 +1,482 @@+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE FunctionalDependencies    #-}+{-# LANGUAGE TypeFamilies              #-}+{-# LANGUAGE UndecidableInstances      #-}+{-# LANGUAGE ScopedTypeVariables       #-}+{-# LANGUAGE FunctionalDependencies    #-}+++module Data.Container.Class (module Data.Container.Class, module X) where++--import Prologue hiding (Indexable, index, Bounded, Ixed, Simple, Indexed)+import Prelude hiding ((.))++import Control.Lens as X (Index)++import qualified Data.Container.Opts    as Opts+import           Data.Container.Opts    (Query(..), Opt(..), Knowledge(..), queryBuilder, withTransFunc)+import           Data.Container.Poly    (Simple)+import           GHC.Exts               (Constraint)+import           Data.Functor.Utils+import           Control.Monad.Identity+import           Control.Lens           hiding (Indexable, index, Bounded, Ixed, Simple, Indexed)+import           Data.List              (intersperse)+++data Impossible    = Impossible  deriving (Show)+data ImpossibleM a = ImpossibleM deriving (Show, Functor)+type ImpTL = '[Impossible] ++++impossible = error "Impossible happened."++----------------------------+-- === General utilities ===+----------------------------++type family Container a+type family Item      a++-- | Points to the real structure handling the data. Used mainly internally.+type family DataStore a++type  HasContainer = HasContainerM Identity+class HasContainerM m a where+    viewContainerM :: a -> m (Container a)+    setContainerM  :: Container a -> a -> m a+    default viewContainerM :: (Container a ~ Container (Unwrapped a), Wrapped a, HasContainerM m (Unwrapped a)) => a -> m (Container a)+    viewContainerM = viewContainerM . view _Wrapped'+    default setContainerM :: (Container a ~ Container (Unwrapped a), Wrapped a, HasContainerM m (Unwrapped a), Functor m) => Container a -> a -> m a+    setContainerM = _Wrapped' . setContainerM++type                    IsContainer  = IsContainerM Identity+class HasContainerM m a => IsContainerM m a where+    fromContainerM :: Container a -> m a+    --default fromContainerM :: (Monad m) => Container a -> m a+    --fromContainerM = view unwrapped' . fromContainerM+++container :: HasContainer a => Lens' a (Container a)+container = lens (runIdentity . viewContainerM) (runIdentity .: flip setContainerM)++fromContainer :: IsContainer a => Container a -> a+fromContainer = runIdentity . fromContainerM++withContainerM :: (Monad m, HasContainerM m a) => (Container a -> m (Container a)) -> a -> m a+withContainerM f l = viewContainerM l >>= f >>= flip setContainerM l++withContainerM' :: (Monad m, HasContainerM m a) => (Container a -> Container a) -> a -> m a+withContainerM' = withContainerM . (return .)++-- Type level utilities++type family PrimStoreOf    a where PrimStoreOf    a = PrimStoreOf' (DataStore a) a+type family PrimStoreOf' t a where PrimStoreOf' a a = a+                                   PrimStoreOf' t a = PrimStoreOf' (DataStore (Container (DataStore a))) (Container (DataStore a))+++----------------------------+-- === Results & Infos ===+----------------------------++-- === Info ===++data Info idx el cont = Info idx el cont++type PrimInfo         = 'Info 'Unknown     'Unknown+type ElInfo        el = 'Info 'Unknown     ('Known el)+type IdxInfo   idx    = 'Info ('Known idx) 'Unknown+type IdxElInfo idx el = 'Info ('Known idx) ('Known el)++++-- === Results ===++data Res datas a = Res datas a deriving (Show, Functor, Traversable, Foldable)++type Result op info mods = Res (Result_ op info mods)++type PrimResult  op ms        a = Result op (PrimInfo         a) ms+type ElResult    op ms     el a = Result op (ElInfo        el a) ms+type IdxResult   op ms idx    a = Result op (IdxInfo   idx    a) ms+type IdxElResult op ms idx el a = Result op (IdxElInfo idx el a) ms++type family Result_ op info (mods :: [*]) where+    Result_ op info '[]       = ()+    Result_ op info (m ': ms) = (ModResult op info m, Result_ op info ms)++++-- === Opts ===++type family IdxMod op ix++type family ModResult op (info :: Info (Knowledge *) (Knowledge *) *) mod++type family GetOpts (m :: [Opt *]) :: [*] where+    GetOpts '[] = '[]+    GetOpts (P a ': ms) = a ': GetOpts ms +    GetOpts (N   ': ms) = GetOpts ms ++++-- === >>> Mods ===++type instance ModResult op ('Info (Known idx) el cont) Opts.Ixed = IdxMod op idx+type instance ModResult op ('Info Unknown     el cont) Opts.Ixed = IdxMod op (Index cont)+++-----------------------------+-- === Operations classes ===+-----------------------------++-- === Finite ===++-- Measurable+-- MinBounded+-- MaxBounded++class Ctx ms m cont => MeasurableQM ms ps m     cont where sizeQM     :: Query ms ps -> cont -> m (PrimResult MeasurableOp ms     (Container cont) Int)+class Ctx ms m cont => MinBoundedQM ms ps m idx cont where minBoundQM :: Query ms ps -> cont -> m (IdxResult  MinBoundedOp ms idx (Container cont) idx)+class Ctx ms m cont => MaxBoundedQM ms ps m idx cont where maxBoundQM :: Query ms ps -> cont -> m (IdxResult  MaxBoundedOp ms idx (Container cont) idx)++data MeasurableOp      = MeasurableOp+type MeasurableM       = Simple MeasurableQM+type MeasurableQ ms ps = MeasurableQM ms ps Identity+type Measurable        = Simple MeasurableQM Identity++data MinBoundedOp      = MinBoundedOp+type MinBoundedM       = Simple MinBoundedQM+type MinBoundedQ ms ps = MinBoundedQM ms ps Identity+type MinBounded        = Simple MinBoundedQM Identity++data MaxBoundedOp      = MaxBoundedOp+type MaxBoundedM       = Simple MaxBoundedQM+type MaxBoundedQ ms ps = MaxBoundedQM ms ps Identity+type MaxBounded        = Simple MaxBoundedQM Identity++type BoundedQM ms ps m idx cont = (MinBoundedQM ms ps m idx cont, MaxBoundedQM ms ps m idx cont)+type BoundedM        m idx cont = Simple MaxBoundedQM m idx cont+type BoundedQ  ms ps m idx cont = MaxBoundedQM ms ps Identity idx cont+type Bounded           idx cont = BoundedM Identity idx cont++-- utils++sizeM'     = queryBuilder sizeQM+size'      = withTransFunc (fmap2 runIdentity) sizeM'+sizeM      = queryBuilder $ fmap formatResult .: sizeQM+size       = withTransFunc (fmap2 runIdentity) sizeM++minBoundM' = queryBuilder minBoundQM+minBound'  = withTransFunc (fmap2 runIdentity) minBoundM'+minBoundM  = queryBuilder $ fmap formatResult .: minBoundQM+minBound   = withTransFunc (fmap2 runIdentity) minBoundM++maxBoundM' = queryBuilder maxBoundQM+maxBound'  = withTransFunc (fmap2 runIdentity) maxBoundM'+maxBoundM  = queryBuilder $ fmap formatResult .: maxBoundQM+maxBound   = withTransFunc (fmap2 runIdentity) maxBoundM+++++-- === Construction ===++-- Singleton+-- Allocable+-- Expandable+-- Growable++class Ctx ms m cont => SingletonQM  ms ps m el cont where singletonQM :: Query ms ps         -> el   -> m (ElResult   SingletonOp  ms el (Container cont) cont)+class Ctx ms m cont => ExpandableQM ms ps m    cont where expandQM    :: Query ms ps         -> cont -> m (PrimResult ExpandableOp ms    (Container cont) cont)+class Ctx ms m cont => AllocableQM  ms ps m    cont where allocQM     :: Query ms ps -> Int          -> m (PrimResult AllocableOp  ms    (Container cont) cont)+class Ctx ms m cont => GrowableQM   ms ps m    cont where growQM      :: Query ms ps -> Int  -> cont -> m (PrimResult GrowableOp   ms    (Container cont) cont)++data  SingletonOp       = SingletonOp+type  SingletonM        = Simple SingletonQM+type  SingletonQ  ms ps = SingletonQM ms ps Identity+type  Singleton         = Simple SingletonQM Identity++data  AllocableOp       = AllocableOp+type  AllocableM        = Simple AllocableQM+type  AllocableQ ms ps  = AllocableQM ms ps Identity+type  Allocable         = Simple AllocableQM Identity++data  ExpandableOp      = ExpandableOp+type  ExpandableM       = Simple ExpandableQM+type  ExpandableQ ms ps = ExpandableQM ms ps Identity+type  Expandable        = Simple ExpandableQM Identity++data  GrowableOp        = GrowableOp+type  GrowableM         = Simple GrowableQM+type  GrowableQ ms ps   = GrowableQM ms ps Identity+type  Growable          = Simple GrowableQM Identity++type instance IdxMod SingletonOp  a = a+type instance IdxMod AllocableOp  a = [a]+type instance IdxMod ExpandableOp a = [a]+type instance IdxMod GrowableOp   a = [a]++-- utils++singletonM' = queryBuilder singletonQM+singleton'  = withTransFunc (fmap2 runIdentity) singletonM'+singletonM  = queryBuilder $ fmap formatResult .: singletonQM+singleton   = withTransFunc (fmap2 runIdentity) singletonM++allocM'     = queryBuilder allocQM+alloc'      = withTransFunc (fmap2 runIdentity) allocM'+allocM      = queryBuilder $ fmap formatResult .: allocQM+alloc       = withTransFunc (fmap2 runIdentity) allocM++expandM'    = queryBuilder expandQM+expand'     = withTransFunc (fmap2 runIdentity) expandM'+expandM     = queryBuilder $ fmap formatResult .: expandQM+expand      = withTransFunc (fmap2 runIdentity) expandM++growM'      = queryBuilder growQM+grow'       = withTransFunc (fmap3 runIdentity) growM'+growM       = queryBuilder $ fmap formatResult .:. growQM+grow        = withTransFunc (fmap3 runIdentity) growM++++-- === Modification ===+-- Appendable+-- Prependable+-- Addable+-- Removable+-- Insertable+-- Freeable++++class Ctx ms m cont => AppendableQM   ms ps m     el cont where appendQM  :: Query ms ps        -> el -> cont -> m (ElResult    AppendableOp    ms     el (Container cont) cont)+class Ctx ms m cont => PrependableQM  ms ps m     el cont where prependQM :: Query ms ps        -> el -> cont -> m (ElResult    PrependableOp   ms     el (Container cont) cont)+class Ctx ms m cont => AddableQM      ms ps m     el cont where addQM     :: Query ms ps        -> el -> cont -> m (ElResult    AddableOp       ms     el (Container cont) cont)+class Ctx ms m cont => RemovableQM    ms ps m     el cont where removeQM  :: Query ms ps        -> el -> cont -> m (ElResult    RemovableOp     ms     el (Container cont) cont)+class Ctx ms m cont => InsertableQM   ms ps m idx el cont where insertQM  :: Query ms ps -> idx -> el -> cont -> m (IdxElResult InsertableOp    ms idx el (Container cont) cont)+class Ctx ms m cont => FreeableQM     ms ps m idx    cont where freeQM    :: Query ms ps -> idx       -> cont -> m (IdxResult   FreeableOp      ms idx    (Container cont) cont)+class Ctx ms m cont => ReservableQM   ms ps m        cont where reserveQM :: Query ms ps              -> cont -> m (PrimResult  ReservableOp    ms        (Container cont) cont)++data  AppendableOp       = AppendableOp+type  AppendableM        = Simple AppendableQM+type  AppendableQ  ms ps = AppendableQM ms ps Identity+type  Appendable         = Simple AppendableQM Identity++data  PrependableOp      = PrependableOp+type  PrependableM       = Simple PrependableQM+type  PrependableQ ms ps = PrependableQM ms ps Identity+type  Prependable        = Simple PrependableQM Identity++data  AddableOp          = AddableOp+type  AddableM           = Simple AddableQM+type  AddableQ     ms ps = AddableQM ms ps Identity+type  Addable            = Simple AddableQM Identity++data  RemovableOp        = RemovableOp+type  RemovableM         = Simple RemovableQM+type  RemovableQ   ms ps = RemovableQM ms ps Identity+type  Removable          = Simple RemovableQM Identity++data  InsertableOp       = InsertableOp+type  InsertableM        = Simple InsertableQM+type  InsertableQ  ms ps = InsertableQM ms ps Identity+type  Insertable         = Simple InsertableQM Identity++data  FreeableOp         = FreeableOp+type  FreeableM          = Simple FreeableQM+type  FreeableQ    ms ps = FreeableQM ms ps Identity+type  Freeable           = Simple FreeableQM Identity++data  ReservableOp       = ReservableOp+type  ReservableM        = Simple ReservableQM+type  ReservableQ  ms ps = ReservableQM ms ps Identity+type  Reservable         = Simple ReservableQM Identity++type instance IdxMod AppendableOp  a = a+type instance IdxMod PrependableOp a = a+type instance IdxMod AddableOp     a = a+type instance IdxMod RemovableOp   a = a+type instance IdxMod InsertableOp  a = a+type instance IdxMod ReservableOp  a = a++appendM'  = queryBuilder appendQM+append'   = withTransFunc (fmap3 runIdentity) appendM'+appendM   = queryBuilder $ fmap formatResult .:. appendQM+append    = withTransFunc (fmap3 runIdentity) appendM++prependM' = queryBuilder prependQM+prepend'  = withTransFunc (fmap3 runIdentity) prependM'+prependM  = queryBuilder $ fmap formatResult .:. prependQM+prepend   = withTransFunc (fmap3 runIdentity) prependM++addM'     = queryBuilder addQM+add'      = withTransFunc (fmap3 runIdentity) addM'+addM      = queryBuilder $ fmap formatResult .:. addQM+add       = withTransFunc (fmap3 runIdentity) addM+add_      = withTransFunc (fmap3 res_) add'++removeM'  = queryBuilder removeQM+remove'   = withTransFunc (fmap3 runIdentity) removeM'+removeM   = queryBuilder $ fmap formatResult .:. removeQM+remove    = withTransFunc (fmap3 runIdentity) removeM++insertM'  = queryBuilder insertQM+insert'   = withTransFunc (fmap4 runIdentity) insertM'+insertM   = queryBuilder $ fmap formatResult .:: insertQM+insert    = withTransFunc (fmap4 runIdentity) insertM+insert_   = withTransFunc (fmap4 res_) insert'++freeM'    = queryBuilder freeQM+free'     = withTransFunc (fmap3 runIdentity) freeM'+freeM     = queryBuilder $ fmap formatResult .:. freeQM+free      = withTransFunc (fmap3 runIdentity) freeM+free_     = withTransFunc (fmap3 res_) free'++reserveM' = queryBuilder reserveQM+reserve'  = withTransFunc (fmap2 runIdentity) reserveM'+reserveM  = queryBuilder $ fmap formatResult .: reserveQM+reserve   = withTransFunc (fmap2 runIdentity) reserveM++++---- === Indexing ===++-- Indexable+-- TracksFreeIxes+-- TracksUsedIxes+-- TracksIxes+-- TracksElems++class Ctx ms m cont => IndexableQM      ms ps m idx el cont where indexQM    :: Query ms ps -> idx -> cont -> m (IdxElResult IndexableOp      ms idx el (Container cont) el   )+class Ctx ms m cont => TracksFreeIxesQM ms ps m idx    cont where freeIxesQM :: Query ms ps ->        cont -> m (IdxResult   TracksFreeIxesOp ms idx    (Container cont) [idx])+class Ctx ms m cont => TracksUsedIxesQM ms ps m idx    cont where usedIxesQM :: Query ms ps ->        cont -> m (IdxResult   TracksUsedIxesOp ms idx    (Container cont) [idx])+class Ctx ms m cont => TracksIxesQM     ms ps m idx    cont where ixesQM     :: Query ms ps ->        cont -> m (IdxResult   TracksIxesOp     ms idx    (Container cont) [idx])+class Ctx2 m => TracksElemsQM    ms ps m     el cont where elemsQM    :: Query ms ps ->        cont -> m (ElResult    TracksElemsOp    ms     el (Container cont) [el] )++data  IndexableOp            = IndexableOp+type  IndexableM             = Simple IndexableQM+type  IndexableQ       ms ps = IndexableQM ms ps Identity+type  Indexable              = Simple IndexableQM Identity++data  TracksFreeIxesOp       = TracksFreeIxesOp+type  TracksFreeIxesM        = Simple TracksFreeIxesQM+type  TracksFreeIxesQ  ms ps = TracksFreeIxesQM ms ps Identity+type  TracksFreeIxes         = Simple TracksFreeIxesQM Identity++data  TracksUsedIxesOp       = TracksUsedIxesOp+type  TracksUsedIxesM        = Simple TracksUsedIxesQM+type  TracksUsedIxesQ  ms ps = TracksUsedIxesQM ms ps Identity+type  TracksUsedIxes         = Simple TracksUsedIxesQM Identity++data  TracksIxesOp           = TracksIxesOp+type  TracksIxesM            = Simple TracksIxesQM+type  TracksIxesQ      ms ps = TracksIxesQM ms ps Identity+type  TracksIxes             = Simple TracksIxesQM Identity++data  TracksElemsOp          = TracksElemsOp+type  TracksElemsM           = Simple TracksElemsQM+type  TracksElemsQ     ms ps = TracksElemsQM ms ps Identity+type  TracksElems            = Simple TracksElemsQM Identity++type instance IdxMod IndexableOp   a = a+type instance IdxMod TracksElemsOp a = [a]++indexM'    = queryBuilder indexQM+index'     = withTransFunc (fmap3 runIdentity) indexM'+indexM     = queryBuilder $ fmap formatResult .:. indexQM+index      = withTransFunc (fmap3 runIdentity) indexM+index_     = withTransFunc (fmap3 res_) index'++freeIxesM' = queryBuilder freeIxesQM+freeIxes'  = withTransFunc (fmap2 runIdentity) freeIxesM'+freeIxesM  = queryBuilder $ fmap formatResult .: freeIxesQM+freeIxes   = withTransFunc (fmap2 runIdentity) freeIxesM++usedIxesM' = queryBuilder usedIxesQM+usedIxes'  = withTransFunc (fmap2 runIdentity) usedIxesM'+usedIxesM  = queryBuilder $ fmap formatResult .: usedIxesQM+usedIxes   = withTransFunc (fmap2 runIdentity) usedIxesM+usedIxes_  = withTransFunc (fmap2 res_) usedIxes'++ixesM'     = queryBuilder ixesQM+ixes'      = withTransFunc (fmap2 runIdentity) ixesM'+ixesM      = queryBuilder $ fmap formatResult .: ixesQM+ixes       = withTransFunc (fmap2 runIdentity) ixesM++elemsM'    = queryBuilder elemsQM+elems'     = withTransFunc (fmap2 runIdentity) elemsM'+elemsM     = queryBuilder $ fmap formatResult .: elemsQM+elems      = withTransFunc (fmap2 runIdentity) elemsM+elems_     = withTransFunc (fmap2 res_) elems'+++++++type family Tup2RTup t where+    Tup2RTup ()               = () +    Tup2RTup (t1, t2)         = (t1,(t2,())) +    Tup2RTup (t1, t2, t3)     = (t1,(t2,(t3,()))) +    Tup2RTup (t1, t2, t3, t4) = (t1,(t2,(t3,(t4,())))) +    Tup2RTup a                = (a,())++type family AppendedRT a rt where+    AppendedRT a ()     = (a,())+    AppendedRT a (r,rt) = (r, AppendedRT a rt)++--class    AppendRT a rt                      where appendRT :: a -> rt -> AppendedRT a rt+--instance AppendRT a ()                      where appendRT a _      = (a,())+--instance AppendRT a rt => AppendRT a (r,rt) where appendRT a (r,rt) = (r,appendRT a rt)++--class                         AppendRT a rt rt' | a rt -> rt', rt' -> rt a where appendRT :: a -> rt -> rt'+--instance                      AppendRT a ()     (a,())                     where appendRT a _      = (a,())+--instance AppendRT a rt rt' => AppendRT a (r,rt) (r,rt')                    where appendRT a (r,rt) = (r,appendRT a rt)++type family InitRT rt where+    InitRT (t,()) = ()+    InitRT (t,ts) = (t,InitRT ts)++instance ( AppendRT a rt rt'+         , InitRT (r, rt') ~ (r, rt)+         )               => AppendRT a (r,rt) (r,rt')                 where appendRT a (r,rt) = (r,appendRT a rt)+instance                    AppendRT a ()     (a,())                  where appendRT a _      = (a,())+class    rt ~ InitRT rt' => AppendRT a rt rt' | a rt -> rt', rt' -> a where appendRT :: a -> rt -> rt'++resToRTup (Res ds a) = (a,ds)+res_      (Res _  a) = a+--resToRTup (Res ds a) = appendRT a ds++formatResult = rtup2tupX . resToRTup++class rt ~ Tup2RTup t => RTup2TupX rt t | rt -> t where rtup2tupX :: rt -> t+instance {-# OVERLAPPABLE #-}                                      RTup2TupX () () where rtup2tupX = id+instance {-# OVERLAPPABLE #-} (Tup2RTup t1 ~ (t1,()), t1 ~ t1') => RTup2TupX (t1,()) t1' where rtup2tupX (t1,()) = t1+instance {-# OVERLAPPABLE #-} (t1 ~ t1', t2 ~ t2')              => RTup2TupX (t1,(t2,())) (t1',t2') where rtup2tupX (t1,(t2,())) = (t1,t2)+instance {-# OVERLAPPABLE #-} (t1 ~ t1', t2 ~ t2', t3 ~ t3')    => RTup2TupX (t1,(t2,(t3,()))) (t1',t2',t3') where rtup2tupX (t1,(t2,(t3,()))) = (t1,t2,t3)++++type family PrettyCtx ms a :: Constraint where +    PrettyCtx '[] a = Tup2RTup a ~ (a,())+    PrettyCtx ms  a = ()++type Ctx ms m cont = (Monad m, PrettyCtx ms cont)+type Ctx2 m = (Monad m)++++++++++-- Other utils, probably to generalize or refactor++intercalate :: Monoid a => a -> [a] -> a+intercalate delim l = mconcat (intersperse delim l)+

@@ -0,0 +1,157 @@+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GADTs                  #-}+{-# LANGUAGE KindSignatures         #-}+{-# LANGUAGE ScopedTypeVariables    #-}+{-# LANGUAGE TypeFamilies           #-}+{-# LANGUAGE UndecidableInstances   #-}++{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ < 710+{-# LANGUAGE OverlappingInstances #-}+#endif++module Data.Container.Hetero where++--import Flowbox.Prelude       hiding (Indexable, index, Repr, repr)+import Prelude+--import Control.Error.Util    (hush)+import Data.Container.Class+--import Data.Constraint.Void+--import Data.Convert.Errors   (TypeMismatch (TypeMismatch))+import Data.Typeable         hiding (cast)+import Unsafe.Coerce         (unsafeCoerce)+import Data.Container.Poly+--import Data.Reprx++--- === Unified values ===++--data Unified ctx where+--    Unified :: (ctx a, UnifiedEl a) => a -> Unified ctx++--type UnifiedEl a = (Typeable a, Show a)++---- instances++--instance Show (Unified ctx) where+--    show (Unified a) = show a++--instance Typeable a => MaybeConvertible (Unified ctx) TypeMismatch a where+--    tryConvert (Unified u) = if tu == ta then Right $ unsafeCoerce u+--                                         else Left  $ TypeMismatch tu ta+--        where tu = typeOf u+--              ta = typeOf (undefined :: a)++--instance {-# OVERLAPPABLE #-}                         Castable (Unified ctx) a where cast (Unified a) = unsafeCoerce a+--instance {-# OVERLAPPABLE #-} (ctx a, UnifiedEl a) => Castable a (Unified ctx) where cast             = Unified+++-- === Ptr ===++newtype Ptr  i   a = Ptr i              deriving (Show)+newtype HPtr i m a = HPtr (Ptr i (m a)) deriving (Show)++class PtrFrom p i | p -> i where+    ptrFrom :: p -> Ptr i a++--class (Container cont (Ptr i a) a, Container cont p a) => IsPtr cont p i a where+--    ptr :: cont -> p -> Ptr i a++---- injective TF+--class    PtrTarget (a :: * -> *) (b :: (* -> *) -> *) c | a b -> c, c -> a b --where+--instance PtrTarget (HPtr i h) a {- = -} (h (a (HPtr i h)))+--instance PtrTarget (Ptr  i)   a {- = -} (a (Ptr i))++---- instances++--instance Repr s i => Repr s (HPtr i m a) where repr (HPtr p) = "HPtr" <+> repr p+--instance Repr s i => Repr s (Ptr i a)    where repr (Ptr i)  = "Ptr " <+> repr i++--type instance IxType (Ptr  i   a) = a+--type instance IxType (HPtr i m a) = a++--instance Convertible i (Ptr i a)    where convert = Ptr+--instance Convertible (Ptr i a) i    where convert = ptrIdx+--instance Convertible i (HPtr i m a) where convert = HPtr . convert+--instance Convertible (HPtr i m a) i where convert = ptrIdx+--instance Convertible (Ptr i (m a)) (HPtr i m a) where convert = HPtr++class    PtrIdx p i | p -> i    where ptrIdx :: p -> i+instance PtrIdx (Ptr  i   a) i  where ptrIdx (Ptr i)  = i+instance PtrIdx (HPtr i m a) i  where ptrIdx (HPtr p) = ptrIdx p++instance {-# OVERLAPPABLE #-} (p ~ i) => PtrFrom p         i where ptrFrom = Ptr+instance                                 PtrFrom (Ptr i a) i where ptrFrom (Ptr i) = Ptr i+++----- === Hetero Containers ===++--type Hetero ctx cont = HeteroContainer (cont (Unified ctx))+--type Hetero'    cont = Hetero Void1 cont++--newtype HeteroContainer cont = HeteroContainer { _cont :: cont } deriving (Show, Functor, Foldable, Traversable)++--makeLenses ''HeteroContainer+++---- basic instances++--type instance ElementByIx idx (HeteroContainer cont) = IxType idx+--type instance IndexOf     el  (HeteroContainer cont) = Ptr (IndexOf el cont) el++----instance HasContainer (HeteroContainer c) (HeteroContainer c) where+----    container = id++--instance Default cont => Default (HeteroContainer cont) where+--    def = HeteroContainer def++--instance Monoid cont => Monoid (HeteroContainer cont) where+--    mempty = HeteroContainer mempty+--    (HeteroContainer c) `mappend` (HeteroContainer c') = HeteroContainer $ c <> c'++---- container instances++--type HeteroTransCtx idx ctx a cont idx' el = ( ElementOf cont ~ el+--                                             , el ~ Unified ctx+--                                             , ctx a, UnifiedEl a+--                                             , IsoConvertible idx idx'+--                                             )+++------class (IndexOf el cont ~ idx, ElementByIx idx cont ~ el, Measurable cont) => Container cont idx el where+------    elems   :: cont -> [el]+------    indexes :: cont -> [idx]++----instance (idx ~ Ptr (IndexOf a cont) a) => Container (HeteroContainer cont) idx a++----instance Measurable (HeteroContainer cont)+------ TODO: TO END ^^^++----instance (HeteroTransCtx idx ctx a cont idx' el, Appendable' cont idx' el)+----      => Appendable' (HeteroContainer cont) idx a where+----    append' a (HeteroContainer cont) = (HeteroContainer cont', convert idx') where+----        (cont', idx') = append' (Unified a :: Unified ctx) cont++----instance (HeteroTransCtx idx ctx a cont idx' el, Prependable cont idx' el)+----      => Prependable (HeteroContainer cont) idx a where+----    prepend' a (HeteroContainer cont) = (HeteroContainer cont', convert idx') where+----        (cont', idx') = prepend' (Unified a :: Unified ctx) cont++----instance (HeteroTransCtx idx ctx a cont idx' el, Updatable cont idx' el)+----      => Updatable (HeteroContainer cont) idx a where+----    update idx a = fmap $ update (convert idx) (Unified a :: Unified ctx)++----instance (HeteroTransCtx idx ctx a cont idx' el, Insertable cont idx' el)+----      => Insertable (HeteroContainer cont) idx a where+----    insert       idx a = fmap $ insert       (convert idx) (Unified a :: Unified ctx)+----    unsafeInsert idx a = fmap $ unsafeInsert (convert idx) (Unified a :: Unified ctx)++----instance (HeteroTransCtx idx ctx a cont idx' el, Indexable cont idx' el, Convertible (Unified ctx) a)+----      => Indexable (HeteroContainer cont) idx a where+----    index       idx (HeteroContainer cont) = convert (index       (convert idx) cont :: Unified ctx)++----instance (HeteroTransCtx idx ctx a cont idx' el, Indexable (Unsafe cont) idx' el, Convertible (Unified ctx) a)+----      => Indexable (Unsafe (HeteroContainer cont)) idx a where+----    index idx (unwrap -> (HeteroContainer cont)) = cast $ (unsafely (index $ convert idx) cont :: Unified ctx)+++----instance (Indexable2  opts a idx el) => Indexable2  opts (Resizable s a) idx el where index2 opts idx = index2 opts idx . unwrap

@@ -0,0 +1,51 @@+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE UndecidableInstances #-}++module Data.Container.Immersed where++import Prelude++import Data.Container.Class+import Data.Layer+import Control.Lens+import Control.Monad++instance {-# OVERLAPPABLE #-} ( Monad m+                              , HasContainerM m (Unlayered l)+                              , LayeredM m l+                              , ImmersedM (Container (Unlayered l)) m a+                              )          => ImmersedM l m a where viewImmersedM' = viewLayeredM >=> viewContainerM >=> viewImmersedM'+                                                                  setImmersedM'  v l = flip withDivedM l $ setImmersedM' v++instance {-# OVERLAPPABLE #-} (Monad m)  => ImmersedM l m l where viewImmersedM' = return+                                                                  setImmersedM'  = const . return+class                                       ImmersedM l m a where viewImmersedM' :: l -> m a+                                                                  setImmersedM'  :: a -> l -> m l++viewImmersedM :: (ImmersedM (Container l) m a, HasContainerM m l, Monad m) => l -> m a+viewImmersedM = viewContainerM >=> viewImmersedM'++setImmersedM :: (Monad m, HasContainerM m l, ImmersedM (Container l) m a) => a -> l -> m l+setImmersedM v l = do+    a  <- viewContainerM l+    a' <- setImmersedM' v a+    setContainerM a' l ++withImmersedM :: ( Monad m+                 , HasContainerM m l+                 , ImmersedM (Container l) m t+                 , ImmersedM (Container l) m a+                 ) => (t -> m a) -> l -> m l+withImmersedM f l = viewImmersedM l >>= f >>= flip setImmersedM l++withImmersedM' :: ( Monad m+                  , HasContainerM m l+                  , ImmersedM (Container l) m a+                  ) => (a -> a) -> l -> m l+withImmersedM' = withImmersedM . (return .)++dived :: (Layered a, HasContainer (Unlayered a)) => Lens' a (Container (Unlayered a))+dived = layered . container++withDivedM :: (Monad m, LayeredM m a, HasContainerM m (Unlayered a)) => (Container (Unlayered a) -> m (Container (Unlayered a))) -> a -> m a+withDivedM f a = flip withLayeredM a $ withContainerM f

@@ -0,0 +1,4 @@+module Data.Container.Instances (module X) where++import Data.Container.Instances.Vector.Lazy as X+import Data.Container.Instances.IntSet      as X

@@ -0,0 +1,12 @@+module Data.Container.Instances.IntSet where++import Prelude++import           Data.Container.Class+import           Data.IntSet (IntSet)+import qualified Data.IntSet as IntSet+import           Data.Container.List++type instance Item IntSet = Int++instance ToList IntSet where toList = IntSet.toList

@@ -0,0 +1,213 @@+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes #-}+++{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ < 710+{-# LANGUAGE OverlappingInstances #-}+#endif++module Data.Container.Instances.Vector.Lazy where++import Prelude++import Control.Monad.ST+import Data.Container.Class+import Data.Container.List+import Data.Default+import Data.Monoid+import Data.Typeable++import Data.IntMap (IntMap)+import Data.Map    (Map)+import Data.Maybe  (fromJust)++import qualified Data.IntMap                 as IntMap+import qualified Data.Map                    as Map+import qualified Data.Vector                 as V+import qualified Data.Vector.Mutable         as MV+import qualified Data.Vector.Unboxed         as UV+import qualified Data.Vector.Unboxed.Mutable as UMV++--import           Data.Container.Poly {- x -}+--import GHC.Prim++import qualified Data.Container.Opts as M+import           Data.Container.Opts (Opt(P,N), Knowledge(..), Query(..), OptQuery(..), ModsOf, ParamsOf)+import Data.Layer+import Data.Container.Type (In)++import Data.Container.Proxy++------------------------------+-- === Global instances === --+------------------------------++type instance Index     (V.Vector a) = Int+type instance Item      (V.Vector a) = a+type instance Container (V.Vector a) = V.Vector a+type instance DataStore (V.Vector a) = V.Vector a+instance      Monad m => IsContainerM  m (V.Vector a) where fromContainerM = return+instance      Monad m => HasContainerM m (V.Vector a) where viewContainerM = return+                                                            setContainerM  = const . return+++instance ToList (V.Vector a) where toList = V.toList++----------------------------------+-- === Operations instances === --+----------------------------------++-- === Finite ===++-- [+] Measurable+-- [+] MinBounded+-- [+] MaxBounded++type instance ParamsOf MeasurableOp (V.Vector a) = '[]+type instance ModsOf   MeasurableOp (V.Vector a) = '[]++type instance ParamsOf MinBoundedOp (V.Vector a) = '[]+type instance ModsOf   MinBoundedOp (V.Vector a) = '[]++type instance ParamsOf MaxBoundedOp (V.Vector a) = '[]+type instance ModsOf   MaxBoundedOp (V.Vector a) = '[]++instance Monad m              => MeasurableQM_ '[] ps m     (V.Vector a) where sizeM_     _   = return . Res () . V.length+instance (Monad m, idx ~ Int) => MinBoundedQM_ '[] ps m idx (V.Vector a) where minBoundM_ _ _ = return $ Res () 0+instance (Monad m, idx ~ Int) => MaxBoundedQM_ '[] ps m idx (V.Vector a) where maxBoundM_ _ v = return $ Res () $ V.length v - 1+++-- === Construction ===++-- [+] Singleton+-- [+] Allocable+-- [+] Expandable+-- [+] Growable++type instance ParamsOf SingletonOp  (V.Vector a) = '[]+type instance ModsOf   SingletonOp  (V.Vector a) = '[M.Ixed]++type instance ParamsOf AllocableOp  (V.Vector a) = '[]+type instance ModsOf   AllocableOp  (V.Vector a) = '[M.Ixed]++type instance ParamsOf ExpandableOp (V.Vector a) = '[]+type instance ModsOf   ExpandableOp (V.Vector a) = '[M.Ixed]++type instance ParamsOf GrowableOp   (V.Vector a) = '[]+type instance ModsOf   GrowableOp   (V.Vector a) = '[M.Ixed]++instance (Monad m, a ~ a') => SingletonQM_ '[N       ] ps m a' (V.Vector a) where singletonM_ _ = return . Res ()     . V.singleton+instance (Monad m, a ~ a') => SingletonQM_ '[P M.Ixed] ps m a' (V.Vector a) where singletonM_ _ = return . Res (0,()) . V.singleton++instance Monad m =>           AllocableQM_ '[N       ] ps m    (V.Vector a) where allocM_ _ i = return $ Res ()            $ runST $ V.unsafeFreeze =<< MV.unsafeNew i+instance Monad m =>           AllocableQM_ '[P M.Ixed] ps m    (V.Vector a) where allocM_ _ i = return $ Res ([0..i-1],()) $ runST $ V.unsafeFreeze =<< MV.unsafeNew i++instance Monad m =>           ExpandableQM_ '[N       ] ps m   (V.Vector a) where expandM_ _ v = return $ Res ()                $ runST $ V.unsafeThaw v >>= flip MV.unsafeGrow 1 >>= V.unsafeFreeze+instance Monad m =>           ExpandableQM_ '[P M.Ixed] ps m   (V.Vector a) where expandM_ _ v = return $ Res ([V.length v],()) $ runST $ V.unsafeThaw v >>= flip MV.unsafeGrow 1 >>= V.unsafeFreeze++instance Monad m =>           GrowableQM_   '[N       ] ps m   (V.Vector a) where growM_ _ i v = return $ Res ()                                      $ runST $ V.unsafeThaw v >>= flip MV.unsafeGrow i >>= V.unsafeFreeze+instance Monad m =>           GrowableQM_   '[P M.Ixed] ps m   (V.Vector a) where growM_ _ i v = return $ Res ([V.length v .. V.length v + i - 1],()) $ runST $ V.unsafeThaw v >>= flip MV.unsafeGrow i >>= V.unsafeFreeze+++-- === Modification ===+-- [+] Appendable+-- [+] Prependable+-- [+] Addable+-- [+] Removable+-- [+] Insertable+-- [+] Freeable+++type instance ParamsOf AppendableOp  (V.Vector a) = '[]+type instance ModsOf   AppendableOp  (V.Vector a) = '[M.Ixed]++type instance ParamsOf PrependableOp (V.Vector a) = '[]+type instance ModsOf   PrependableOp (V.Vector a) = '[M.Ixed]++type instance ParamsOf AddableOp     (V.Vector a) = '[]+type instance ModsOf   AddableOp     (V.Vector a) = '[M.Ixed]++type instance ParamsOf RemovableOp   (V.Vector a) = '[M.Try]+type instance ModsOf   RemovableOp   (V.Vector a) = '[M.Ixed]++type instance ParamsOf InsertableOp  (V.Vector a) = '[]+type instance ModsOf   InsertableOp  (V.Vector a) = '[M.Ixed]++type instance ParamsOf FreeableOp    (V.Vector a) = '[]+type instance ModsOf   FreeableOp    (V.Vector a) = '[]++instance (Monad m, a ~ a')       => AppendableQM_  '[N       ] ps m a' (V.Vector a) where appendM_  _ el v = (return . Res ())            $ V.snoc v el+instance (Monad m, a ~ a')       => AppendableQM_  '[P M.Ixed] ps m a' (V.Vector a) where appendM_  _ el v = (return . Res (size v,())) $ V.snoc v el++instance (Monad m, a ~ a')       => PrependableQM_ '[N       ] ps m a' (V.Vector a) where prependM_ _ el v = (return . Res ())     $ V.cons el v+instance (Monad m, a ~ a')       => PrependableQM_ '[P M.Ixed] ps m a' (V.Vector a) where prependM_ _ el v = (return . Res (0,())) $ V.cons el v++instance (Monad m, a ~ a')       => AddableQM_     '[N       ] ps m a' (V.Vector a) where addM_     _ el v = (return . Res ())            $ V.snoc v el+instance (Monad m, a ~ a')       => AddableQM_     '[P M.Ixed] ps m a' (V.Vector a) where addM_     _ el v = (return . Res (size v,())) $ V.snoc v el++instance (Monad m, Eq a, a ~ a') => RemovableQM_   '[N       ] '[P M.Try] m a' (V.Vector a) where removeM_ _ el v = case idx of+                                                                                                                           Just  i -> (return . Res ()) $ V.slice 0 (i-1) v <> V.slice i (size v - i) v+                                                                                                                           Nothing -> fail "Element not found"+                                                                                                                       where idx = V.findIndex (== el) v+instance (Monad m, Eq a, a ~ a') => RemovableQM_ '[P M.Ixed] '[P M.Try] m a' (V.Vector a) where removeM_ _ el v = case idx of+                                                                                                                         Just  i -> (return . Res (i,())) $ V.slice 0 (i-1) v <> V.slice i (size v - i) v+                                                                                                                         Nothing -> fail "Element not found"+                                                                                                                     where idx = V.findIndex (== el) v+++instance (Monad m, a ~ a', idx ~ Int) => InsertableQM_ '[N       ] ps m idx a' (V.Vector a) where insertM_ _ idx el v = (return . Res ())       $ (V.//) v [(idx,el)]+instance (Monad m, a ~ a', idx ~ Int) => InsertableQM_ '[P M.Ixed] ps m idx a' (V.Vector a) where insertM_ _ idx el v = (return . Res (idx,())) $ (V.//) v [(idx,el)]+++instance (Monad m, idx ~ Int) => FreeableQM_ '[] ps m idx (V.Vector a) where freeM_ _ idx v = (return . Res ())       $ (V.//) v [(idx,error $ "uninitialized element at index " <> show idx)]++++-- === Indexing ===++-- [+] Indexable+-- [-] TracksFreeIxes+-- [-] TracksUsedIxes+-- [+] TracksIxes+-- [+] TracksElems++type instance ParamsOf IndexableOp       (V.Vector a) = '[M.Unchecked, M.Try]+type instance ModsOf   IndexableOp       (V.Vector a) = '[M.Ixed]++type instance ParamsOf TracksIxesOp      (V.Vector a) = '[]+type instance ModsOf   TracksIxesOp      (V.Vector a) = '[]++instance (Monad m, a ~ a', idx ~ Int, Cond2 unchecked, Cond2 try) => IndexableQM_  '[N       ] '[unchecked, try] m idx a' (V.Vector a) where indexM_  _ idx v = Res ()       <$> checkedBoundsIfM2 (Proxy :: Proxy unchecked) (Proxy :: Proxy try) idx v (V.unsafeIndex v idx)+instance (Monad m, a ~ a', idx ~ Int, Cond2 unchecked, Cond2 try) => IndexableQM_  '[P M.Ixed] '[unchecked, try] m idx a' (V.Vector a) where indexM_  _ idx v = Res (idx,()) <$> checkedBoundsIfM2 (Proxy :: Proxy unchecked) (Proxy :: Proxy try) idx v (V.unsafeIndex v idx)++instance (Monad m, idx ~ Int)                                     => TracksIxesQM_  '[]        ps                m idx    (V.Vector a) where ixesM_   _     v = (return . Res ()) $ [0 .. size v -1]+instance (Monad m, a ~ a')                                        => TracksElemsQM_ '[]        ps                m     a' (V.Vector a) where elemsM_  _     v = (return . Res ()) $ V.toList v++++---- missing instances ----++instance Default (V.Vector a) where def = mempty+++--- Utils (TODO: refactor)++failT2 p = ifT2 p fail error++checkBounds2 i v l r = if i > max || i < 0 then l ("index " <> show i <> " out of bounds x[0," <> show max <> "]") else r where max = size v - 1+checkBoundsM2 p idx v = checkBounds2 idx v (const . failT2 p) return+checkedBoundsIfM2 unchecked try idx v = checkedIfM2 unchecked (checkBoundsM2 try idx v)++checkedIfM2 p = ifT2 p return+++class    Cond2 (opt :: Opt *) where ifT2 :: Proxy opt -> a -> a -> a+instance Cond2 (P a)          where ifT2 _ = const+instance Cond2 N              where ifT2 _ = flip const++

@@ -0,0 +1,42 @@+module Data.Container.List where++import Data.Container.Class++import Prelude++import           Control.Lens +import qualified GHC.Exts       as GHC+import qualified Data.Vector    as V+import qualified Data.Text      as Text+import           Data.Text      (Text)+import qualified Data.Text.Lazy as LazyText++type LazyText = LazyText.Text+++class FromList       l where fromList         :: [Item l] -> l+                             default fromList :: (GHC.IsList l, GHC.Item l ~ Item l)+                                              => [Item l] -> l+                             fromList = GHC.fromList++class ToList         l where toList         :: l -> [Item l]+                             default toList :: (GHC.IsList l, GHC.Item l ~ Item l)+                                            => l -> [Item l]+                             toList = GHC.toList++type IsList l = (FromList l, ToList l)++asList :: IsList a => Iso' a [Item a]+asList = iso toList fromList +++-- === Instances ===++type instance Item Text = Char+instance ToList    Text where toList   = Text.unpack+instance FromList  Text where fromList = Text.pack  +++type instance Item LazyText = Char+instance ToList    LazyText where toList   = LazyText.unpack+instance FromList  LazyText where fromList = LazyText.pack  

@@ -0,0 +1,168 @@+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE TypeFamilies              #-}+{-# LANGUAGE KindSignatures            #-}+{-# LANGUAGE UndecidableInstances      #-}+{-# LANGUAGE FunctionalDependencies    #-}+{-# LANGUAGE ScopedTypeVariables       #-}++{-# LANGUAGE PolyKinds                 #-}+++module Data.Container.Opts where++import Prelude+import Type.Bool+import Data.Typeable+++------------------+-- === Opts === --+------------------++type family ParamsOf op cont :: [*]+type family ModsOf   op cont :: [*]+++data Opt a = P a -- Provided+           | N   -- Not provided+           deriving (Show)++-- Knowledge++data Knowledge a = Known a +                 | Unknown+                 deriving (Show)++-- Mods++data Ixed      = Ixed++-- Parameters++data Safe      = Safe+data Unchecked = Unchecked+data Unsafe    = Unsafe+data Inplace   = Inplace++-- Formatters++data Try       = Try+data Raw       = Raw+++++-------------------------+type family MatchOpts (provided :: [*]) (selected :: [*]) :: [Opt *] where+    MatchOpts (p ': ps) sel = (p `CheckIfKnown` sel) ': MatchOpts ps sel +    MatchOpts '[]       sel = '[]+++type family CheckIfKnown flag flags :: Opt * where+    CheckIfKnown f (f  ': fs) = P f +    CheckIfKnown f (f' ': fs) = CheckIfKnown f fs+    CheckIfKnown f '[]        = N  +++-------------------------+-- === Opt queries === --+-------------------------++data Query    (mods :: [*])     (params :: [*])     = Query+data OptQuery (mods :: [Opt *]) (params :: [Opt *]) = OptQuery++++++------------------------+-- === OptBuilder === --+------------------------++newtype OptBuilder (mods :: [*]) (params :: [*]) a = OptBuilder a deriving (Show, Functor)+type    OptBuilderBase = OptBuilder '[] '[]++class                                                FuncTrans mods params f a | a mods params -> f        where transFunc :: OptBuilder mods params f -> a+instance (mods ~ mods', params ~ params', f ~ f') => FuncTrans mods params f (OptBuilder mods' params' f') where transFunc = id+instance (f ~ (Query mods params -> a -> b))    => FuncTrans mods params f (a -> b)                        where transFunc (OptBuilder f) = f Query++class                                                                     FuncBuilder f     a | a -> f                      where buildFunc :: f -> a+instance {-# OVERLAPPABLE #-} (f ~ a, g ~ b)                           => FuncBuilder (f -> g) (a -> b)                     where buildFunc = id+instance {-# OVERLAPPABLE #-} (t ~ (f -> g), mods ~ '[], params ~ '[]) => FuncBuilder (f -> g) (OptBuilder mods params t) where buildFunc = OptBuilder++-- utils++optBuilder :: f -> OptBuilderBase f+optBuilder = OptBuilder+++queryBuilder :: FuncTrans '[] '[] f a => f -> a+queryBuilder = transFunc . optBuilder++extendOptBuilder :: Query newMods newParams +                 -> Query collectedMods collectedParams +                 -> OptBuilder mods params a+                 -> OptBuilder (Concat newMods   (Concat collectedMods   mods  )) +                               (Concat newParams (Concat collectedParams params))+                               a+extendOptBuilder _ _ (OptBuilder a) = OptBuilder a++appFunc :: (f -> g) -> OptBuilder ms ps f -> OptBuilder ms ps g+appFunc = fmap++withTransFunc f = transFunc . appFunc f++--------------------------------+++type Concat lst lst' = Concat' (Reverse lst) lst'++type family Concat' lst lst' where+    Concat' (x ': xs) lst = Concat' xs (x ': lst)+    Concat' '[]       lst = lst+++++type Reverse lst = Reverse' lst '[]++type family Reverse' (lst :: [*]) (lst' :: [*]) where+  Reverse' '[]       lst = lst+  Reverse' (l ': ls) lst = Reverse' ls (l ': lst)++++----------------------------------++type family OptData provided datas opt where+    OptData (o ': ps) (d,ds) o = d +    OptData (p ': ps) (d,ds) o = OptData ps ds o++type family QueryData provided query datas where+    QueryData p (q ': qs) d = (OptData p d q, QueryData p qs d)+    QueryData p '[]       d = ()+++class GetOptData (provided :: [*]) datas opt where getOptData :: Proxy provided -> datas -> Proxy opt -> OptData provided datas opt+instance {-# OVERLAPPABLE #-} ( datas ~ (a,as)+                               , GetOptData ps as o+                               , OptData ps as o ~ OptData (p ': ps) (a, as) o+                               )             => GetOptData (p ': ps)         datas o   where getOptData _ (a,as) o = getOptData (Proxy :: Proxy ps) as o+instance {-# OVERLAPPABLE #-} datas ~ (a,as) => GetOptData (p ': ps)         datas p   where getOptData _ (a,as) _ = a+++class    GetQueryData (provided :: [*]) (query :: [*]) datas where getQueryData :: Proxy provided -> Proxy query -> datas -> QueryData provided query datas+instance {-# OVERLAPPABLE #-} (GetQueryData p qs datas, GetOptData p datas q)+                           => GetQueryData p (q ': qs) datas where getQueryData p q datas = (getOptData p datas (Proxy :: Proxy q), getQueryData p (Proxy :: Proxy qs) datas)+instance {-# OVERLAPPABLE #-} GetQueryData p '[]       datas where getQueryData _ _ _     = ()+++(.:) = (.) . (.)+++ixed      = queryBuilder $ transFunc .: extendOptBuilder (Query :: Query '[ Ixed ] '[]                )+raw       = queryBuilder $ transFunc .: extendOptBuilder (Query :: Query '[]            '[ Raw       ])+try       = queryBuilder $ transFunc .: extendOptBuilder (Query :: Query '[]            '[ Try       ])+unchecked = queryBuilder $ transFunc .: extendOptBuilder (Query :: Query '[]            '[ Unchecked ])+unsafe    = queryBuilder $ transFunc .: extendOptBuilder (Query :: Query '[]            '[ Unsafe    ])+inplace   = queryBuilder $ transFunc .: extendOptBuilder (Query :: Query '[]            '[ Inplace   ])

@@ -0,0 +1,44 @@+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE PolyKinds    #-}++module Data.Container.Parametrized where+++--import Prologue+--import Data.Container.Class+--import Data.Container.Poly+--import Data.Container.Weak+--import Data.Layer+++--newtype Parametrized t (m :: * -> *) a = Parametrized { _parametrized :: t (m a) } deriving (Show, Functor, Traversable, Foldable, FromList, Monoid, Default)++--type instance Item              (Parametrized t m a) = Item        (Unwrapped (Parametrized t m a))+--type instance ModsOf (cls :: k) (Parametrized t m a) = ModsOf cls  (Unwrapped (Parametrized t m a))+--type instance DataStoreOf       (Parametrized t m a) = DataStoreOf (Unwrapped (Parametrized t m a))+--type instance ContainerOf       (Parametrized t m a) = ContainerOf (Unwrapped (Parametrized t m a))++---- Wrappers & layers++--type instance Unlayered (Parametrized t m a) = Unwrapped (Parametrized t m a)+--instance      Layered   (Parametrized t m a)+--instance      Wrapped   (Parametrized t m a) where +--	type Unwrapped (Parametrized t m a) = t (m a)+--	_Wrapped' = iso (\(Parametrized c) -> c) Parametrized+++---- Instances++--instance IsContainer  (t (m a)) => IsContainer  (Parametrized t m a) where fromContainer = Parametrized . fromContainer+--instance HasContainer (t (m a)) => HasContainer (Parametrized t m a) where container     = layered . container++--type instance ElementOf   (Parametrized t m a) = ElementOf  (t (m a))+--type instance IndexOf el  (Parametrized t m a) = IndexOf el (t (m a))++--type instance HomoIndexOf (Parametrized t m) = HomoIndexOf m+++---- Lenses++--makeLenses ''Parametrized

@@ -0,0 +1,611 @@+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Data.Container.Poly where++--import Prologue hiding (Ixed, Indexed, Simple)+--import           Data.TypeLevel.List (In)+--import Data.Typeable+--import GHC.Prim+--import Type.Bool+import qualified Data.Container.Opts as Mods+--import           Data.Container.Mods (FilterMutable, filterMutable)++++--type family AppendLst a lst where AppendLst a '[]       = '[a]+--                                  AppendLst a (l ': ls) = l ': AppendLst a ls++++--------------------++--type family CmpLst (lst :: [k]) (lst' :: [k']) :: [Bool] where+--            CmpLst (l ': ls)    (l  ': ls')     = (True  ': CmpLst ls ls')+--            CmpLst (l ': ls)    (l' ': ls')     = (False ': CmpLst ls ls')+--            CmpLst '[]          '[]             = '[]++--type family LstIn (lst :: [*]) (lst' :: [*]) :: [Bool] where+--            LstIn (l ': ls) lst = In l lst ': LstIn ls (Remove l lst)+--            LstIn ls        '[] = '[]+--            LstIn '[]       lst = '[]+++--type family   Remove (a :: k) (cont :: c) :: c+--type instance Remove (a :: k) ((t ': ts) :: [k]) = If (a :== t) ts (t ': Remove a ts)+--type instance Remove (a :: k) '[]                = '[]+++--type family ModsOf (inst :: k) cont :: [*]++--data InstMods (inst :: k) (mods :: [Bool]) = InstMods+--data InstMods2 (inst :: k) (mods :: [Bool]) (cont :: *) = InstMods2+--data InstModsX (inst :: k) (query :: [*]) (mods :: [Bool]) (cont :: *) = InstModsX+++++++++--newtype Tagged t a = Tagged { fromTag :: a } deriving (Show)++--tagged :: Proxy t -> a -> Tagged t a+--tagged _ = Tagged++--type family FillData (layout :: [*]) datas where FillData (t ': ts) datas = (GetData t datas, FillData ts datas)+--                                                 FillData '[]       datas = ()++--type family GetData (tag :: *) datas where GetData tag (Tagged tag  a, ds) = a+--                                           GetData tag (Tagged tag' a, ds) = GetData tag ds++--type family   TaggedCont (tags :: [*]) a+--type instance TaggedCont '[]       ()     = ()+--type instance TaggedCont (t ': ts) (a,as) = (Tagged t a, TaggedCont ts as)++--class Taggable tags cont where+--    taggedCont :: Proxy tags -> cont -> TaggedCont tags cont++--instance {-# OVERLAPPABLE #-}                   Taggable '[]       ()     where taggedCont _ _ = ()+--instance {-# OVERLAPPABLE #-} Taggable ts as => Taggable (t ': ts) (a,as) where taggedCont _ (a,as) = (Tagged a, taggedCont (Proxy :: Proxy ts) as)++--class                                                                          DataFillable (layout :: [*]) datas where fillData :: Proxy layout -> datas -> FillData layout datas+--instance {-# OVERLAPPABLE #-} (DataGettable t datas, DataFillable ts datas) => DataFillable (t ': ts) datas where fillData _ ds = (getData (Proxy :: Proxy t) ds, fillData (Proxy :: Proxy ts) ds)+--instance {-# OVERLAPPABLE #-}                                                  DataFillable '[]       datas where fillData _ _  = ()++--class                                                                                                    DataGettable tag datas               where getData :: Proxy tag -> datas -> GetData tag datas+--instance {-# OVERLAPPABLE #-}                                                                            DataGettable tag (Tagged tag  a, ds) where getData _ = fromTag . fst+--instance {-# OVERLAPPABLE #-} (DataGettable tag ds, GetData tag (Tagged tag' a, ds) ~ GetData tag ds) => DataGettable tag (Tagged tag' a, ds) where getData t = getData t . snd++++--type family   MappedByTag tag a l+--type instance MappedByTag t a ()                 = ()+--type instance MappedByTag t a (Tagged t' a', ls) = If (t :== t') (Tagged t  a , MappedByTag t a ls)+--                                                                 (Tagged t' a', MappedByTag t a ls)++--class                                                                                                                       MapByTag  t a b l       | t l -> a where mapByTag  :: Proxy t -> (a -> b) -> l -> MappedByTag t b l+--class                                                                                                                       MapByTag' t a b l                  where mapByTag' :: Proxy t -> (a -> b) -> l -> MappedByTag t b l+--instance {-# OVERLAPPABLE #-} (MapByTag' t a b l, a ~ a')                                                                => MapByTag  t a b (Tagged t  a', l ) where mapByTag  t f (Tagged a, l) = (Tagged $ f a, mapByTag' t f l)+--instance {-# OVERLAPPABLE #-} (MapByTag  t a b l, MappedByTag t b (Tagged t' a', l) ~ (Tagged t' a', MappedByTag t b l)) => MapByTag  t a b (Tagged t' a', l ) where mapByTag  t f (ta      , l) = (ta          , mapByTag  t f l)+--instance {-# OVERLAPPABLE #-} (MapByTag' t a b l, a ~ a')                                                                => MapByTag' t a b (Tagged t  a', l ) where mapByTag' t f (Tagged a, l) = (Tagged $ f a, mapByTag' t f l)+--instance {-# OVERLAPPABLE #-} (MapByTag' t a b l, MappedByTag t b (Tagged t' a', l) ~ (Tagged t' a', MappedByTag t b l)) => MapByTag' t a b (Tagged t' a', l ) where mapByTag' t f (ta      , l) = (ta          , mapByTag' t f l)+--instance                                                                                                                    MapByTag' t a b ()                 where mapByTag' _ _ _ = ()+++++--type I = InstMods2+--type I2X = InstModsX++--type family UpdateQuery instMods guery where+--    UpdateQuery (InstModsX inst q m cont) q'= InstModsX inst q' (LstIn (ModsOf inst cont) q') cont++++++--rebaseSpecX :: InstModsX inst q mods cont -> InstModsX inst' q (LstIn (ModsOf inst' cont) q) cont+--rebaseSpecX _ = InstModsX++--polySpecX :: InstModsX inst q mods cont -> InstModsX inst q (LstIn (ModsOf inst cont') q) cont'+--polySpecX _ = InstModsX+----type family Rebase mods base where Rebase (InstMods2 inst mods old) new = InstMods2 inst mods new++--type family InstQuery (inst :: * -> Constraint) :: [*]++--query :: InstModsX inst q mods cont -> Proxy q+--query _ = Proxy++++++++--optBuilder :: a -> OptBuilderBase a+--optBuilder = OptBuilder++--type OptBuilderBase = OptBuilder '[]++++--newtype OptBuilder (opts :: [*]) a = OptBuilder a deriving (Functor)++--class FuncBuilder f a | a -> f where+--    buildFunc :: f -> a++--class FuncTrans opts f a | a opts -> f where+--    transFunc :: OptBuilder opts f -> a++--instance {-# OVERLAPPABLE #-} (f ~ a, g ~ b)             => FuncBuilder (f -> g)            (a -> b)            where buildFunc = id+--instance {-# OVERLAPPABLE #-} (t ~ (f -> g), opts ~ '[]) => FuncBuilder (f -> g)            (OptBuilder opts t) where buildFunc = OptBuilder++--instance                            (opts ~ opts', f ~ f')       => FuncTrans opts f  (OptBuilder opts' f') where transFunc = id+--instance                          (f ~ (Proxy opts -> a -> b))   => FuncTrans opts f  (a -> b)              where transFunc (OptBuilder f) = f Proxy++++++--extendOptBuilder :: Proxy opt -> Proxy opts' -> OptBuilder opts a -> OptBuilder (opt ': (Concat opts' opts)) a+--extendOptBuilder _ _ (OptBuilder a) = OptBuilder a+++++----------------++++++--type family Selected (b :: [Bool]) (lst :: [*]) :: [*] where+--    Selected ('True  ': b) (l ': ls) = l ': Selected b ls+--    Selected ('False ': b) (l ': ls) =      Selected b ls+--    Selected '[]           lst       =      '[]+--    Selected s             lst       =      '[]++++--data Query (q :: [*]) (m :: [Bool]) = Query+++--data NA = NA+--data Info (idx :: *) (el :: *) (cls :: k) (cont :: *) = Info++--type family InfoIdx  i where InfoIdx  (Info idx el cls cont) = idx+--type family InfoEl   i where InfoEl   (Info idx el cls cont) = el+--type family InfoCls  i where InfoCls  (Info idx el cls cont) = cls+--type family InfoCont i where InfoCont (Info idx el cls cont) = cont++--type RawInfo           = Info NA  NA+--type IxedInfo   idx    = Info idx NA+--type ElInfo         el = Info NA  el+--type IxedElInfo idx el = Info idx el++++--type family ElementOf        cont+--type family IndexOf      el  cont+--type family HomoIndexOf (m :: * -> *) :: *+--type family ElementByIx idx cont+--type family IxType      idx++--type IndexOf' cont = IndexOf (ElementOf cont) cont++---- === Results ===++++--type family SelTags (info :: *) (s :: [Bool]) where SelTags (Info idx el cls cont) s = QueryData (Info idx el cls (DataStoreOf cont)) (Selected s (FilterMutable (ModsOf cls cont)))++++++++++--type IxedData cls idx = If (IxedMode cls :== Single) idx [idx]++--type family QueryData (info :: *) (query :: [*]) :: * where+--    QueryData info '[]       = ()+--    QueryData info (q ': qs) = (ModData q info, QueryData info qs)++--type family   ModData mod info+--type instance ModData Mods.Ixed (Info idx el cls cont) = IxedData cls (+--    If (idx :== NA) (+--        --If (el :== NA)+--            (IndexOf' cont)+--          --  (IndexOf el cont)+--    ) idx+-- )++++++--type ComputeSelection (cls :: k) (cont :: *) (q :: [*]) = LstIn (ModsOf cls cont) q+--type AssumeQuery i q s = QueryData (DataStoreInfo i) (FilterMutable q) ~ SelTags i s+++++--runModsF :: ComputeSelection cls cont q ~ s => (Proxy (q :: [*])) -> (Query q s -> Info idx el cls cont -> sig) -> sig+--runModsF _ f = f Query Info+++--runModsF' = flip runModsF++++--type family ContainerOf a+--class HasContainer a where+--    container :: Lens' a (ContainerOf a)++--type family DataStoreOf a++--class HasDataStore a where+--    dataStore :: Lens' a (DataStoreOf a)++--class HasDataStore a => IsDataStore a where+--    fromDataStore :: DataStoreOf a -> a++++--type family InfoSelection i q where InfoSelection   (Info idx el cls cont) q = ComputeSelection cls cont q+--type family DataStoreInfo i   where DataStoreInfo   (Info idx el cls cont)   = Info idx el cls (DataStoreOf cont)++++--type family InfoInst info q m :: Constraint where+--    InfoInst (Info NA  NA cls cont) q m = cls        cont m q (ComputeSelection cls cont q)+--    InfoInst (Info NA  el cls cont) q m = cls     el cont m q (ComputeSelection cls cont q)+--    InfoInst (Info idx NA cls cont) q m = cls idx    cont m q (ComputeSelection cls cont q)+--    InfoInst (Info idx el cls cont) q m = cls idx el cont m q (ComputeSelection cls cont q)+++++++------+++++++--type family Ixed (op :: k) :: k where Ixed (cls q (m ::  * -> *) :: * -> Constraint) = cls (AppendLst Mods.Ixed q) m+--                                      Ixed (cls q    :: (* -> *) -> * -> Constraint) = cls (AppendLst Mods.Ixed q)++++--type family Unchecked (op :: k) :: k where Unchecked (cls q (m ::  * -> *) :: * -> Constraint) = cls (AppendLst Mods.Unchecked q) m+--                                           Unchecked (cls q    :: (* -> *) -> * -> Constraint) = cls (AppendLst Mods.Unchecked q)+++++++++type family Ixed (op :: k) :: k where+    Ixed (op (ms :: [*]) (ps :: [*]))               = op (Mods.Ixed ': ms) ps+    Ixed (op (ms :: [*]) (ps :: [*]) (m :: * -> *)) = op (Mods.Ixed ': ms) ps m++---- === Concatenation ===+++++++++--type family IxedMode (a :: k) :: IxedType++--data IxedType = Multi+--              | Single+--              deriving (Show)++++----type family ClassOf (a :: *) :: k++----------------------------------++++++++--newtype NestedFunctor m n a = NestedFunctor { fromNestedFunctor :: m (n a)} deriving (Show)+--instance (Functor m, Functor n) => Functor (NestedFunctor m n) where fmap f = NestedFunctor . (fmap $ fmap f) . fromNestedFunctor+++--nested :: (Functor m, Functor n) => Lens a b c d -> (c -> m (n d)) -> (a -> m (n b))+--nested l f = fromNestedFunctor . l (fmap NestedFunctor f)++++++--data Result d r = Result d r deriving (Show, Functor)++---- Result utils++--simple' = Result ()+--res     = Result . (,())+--resM    = return .: res+--simpleM = return . simple'++--withResData :: (d -> (out, d')) -> Result d r -> (out, Result d' r)+--withResData f (Result d r) = (out, Result d' r) where+--  (out, d') = f d++--withResData_ :: (d -> d') -> Result d r -> Result d' r+--withResData_ = flattenMod withResData++--splitResData :: Result (d,ds) r -> (d, Result ds r)+--splitResData = withResData id++--flattenMod :: Functor f => (f ((), a) -> b -> (x, c)) -> f a -> b -> c+--flattenMod f = snd .: (f . fmap ((),))++++----type Unique lst = Reverse (Unique' lst '[])+--type Unique lst = (Unique2' lst)++--type family Unique' (lst :: [*]) (reg :: [*]) where+--  Unique' '[]       reg = reg+--  Unique' (l ': ls) reg = Unique' ls (If (l `In` reg) reg (l ': reg))++--type family Unique2' (lst :: [*]) where+--  Unique2' '[]       = '[]+--  Unique2' (l ': ls) = l ': Unique2' (Remove l ls)+++++--uniqueProxy :: Proxy a -> Proxy (Unique a)+--uniqueProxy _ = Proxy+++++++--newtype Flipped t a b = Flipped { fromFlipped :: t b a } deriving Show++--instance Functor (Flipped Result r) where fmap f (Flipped (Result d r)) = Flipped (Result (f d) r)+++--withFlipped f = fromFlipped . f . Flipped++++--foo f (info :: Proxy (cls :: k)) (q :: Proxy (q :: [*])) (tc :: cont) = out where+--    tc2 = runModsF' f (uniqueProxy q) tc+--    tc3 = withFlipped (fmap $ taggedCont (Proxy :: Proxy (Selected (ComputeSelection cls cont q) (FilterMutable (ModsOf cls cont))) )) <$> tc2+--    out = tc3++----bar :: OpCtx ExpandableInfo2 q m t => Proxy q -> t -> m (Result (MyResult ExpandableInfo2 q t) t)+--bar f info q t = out where+--    q'    = filterMutable q+--    cont  = view container t+--    tgdr  = foo f info q cont+--    tgdr' = (fmap . fmap) (\c -> t & container .~ c) tgdr+--    out   = withFlipped (fmap (fillData q')) <$> tgdr'+++--barTx f (cls :: Proxy (cls :: k)) (q :: Proxy (q :: [*])) (t :: t) = withFlipped (fmap (fillData (filterMutable q))) <$> nested container tgdr t where+--    tgdr c  = withFlipped (fmap $ taggedCont (Proxy :: Proxy (Selected (ComputeSelection cls (ContainerOf t) q) (FilterMutable (ModsOf cls (ContainerOf t)))) )) <$> f (uniqueProxy q) c+++--barTy f (cls :: Proxy (cls :: k)) (q :: Proxy (q :: [*])) (t :: t) = withFlipped (fmap (fillData (filterMutable q))) <$> tgdr (view container t) where+--    tgdr c  = withFlipped (fmap $ taggedCont (Proxy :: Proxy (Selected (ComputeSelection cls (ContainerOf t) q) (FilterMutable (ModsOf cls (ContainerOf t)))) )) <$> f (uniqueProxy q) c++----bar2z f (cls :: Proxy (cls :: k)) (q :: Proxy (q :: [*])) (t :: t) = withFlipped (fmap (fillData (filterMutable q))) <$> tgdr (view container t) where+----    tgdr c  = withFlipped (fmap $ taggedCont (Proxy :: Proxy (Selected (ComputeSelection cls (ContainerOf t) q) (FilterMutable (ModsOf cls (ContainerOf t)))) )) <$> f (uniqueProxy q) c++++--type family AssumeRtupConv q t :: Constraint where AssumeRtupConv q t = If' (Mods.FilterMutable q :== '[]) (AsRTup t ~ (t,())) ()++--type family OpCtx info q m t where OpCtx (Info idx el cls) q m t = ((Functor m,+--                                               HasContainer t,+--                                               DataFillable+--                                                 (FilterMutable q)+--                                                 (TaggedCont+--                                                    (Selected+--                                                       (LstIn+--                                                          (ModsOf cls (ContainerOf t)) q)+--                                                       (FilterMutable+--                                                          (ModsOf cls (ContainerOf t))))+--                                                    (QueryData+--                                                       (Info idx el cls (DataStoreOf t))+--                                                       (Selected+--                                                          (LstIn+--                                                             (ModsOf cls (ContainerOf t))+--                                                             (Unique q))+--                                                          (FilterMutable+--                                                             (ModsOf+--                                                                cls (ContainerOf t)))))),+--                                               Taggable+--                                                 (Selected+--                                                    (LstIn+--                                                       (ModsOf cls (ContainerOf t)) q)+--                                                    (FilterMutable+--                                                       (ModsOf cls (ContainerOf t))))+--                                                 (QueryData+--                                                    (Info idx el cls (DataStoreOf t))+--                                                    (Selected+--                                                       (LstIn+--                                                          (ModsOf cls (ContainerOf t))+--                                                          (Unique q))+--                                                       (FilterMutable+--                                                          (ModsOf+--                                                             cls (ContainerOf t))))),+--                                               QueryData+--                                                 (Info idx el cls (DataStoreOf t))+--                                                 (FilterMutable (Unique q))+--                                               ~ QueryData+--                                                   (Info idx el cls (DataStoreOf t))+--                                                   (Selected+--                                                      (LstIn+--                                                         (ModsOf cls (ContainerOf t))+--                                                         (Unique q))+--                                                      (FilterMutable+--                                                         (ModsOf cls (ContainerOf t)))),+--                                               QueryData+--                                                 (Info idx el cls (DataStoreOf t))+--                                                 (FilterMutable q)+--                                               ~ FillData+--                                                   (FilterMutable q)+--                                                   (TaggedCont+--                                                      (Selected+--                                                         (LstIn+--                                                            (ModsOf cls (ContainerOf t))+--                                                            q)+--                                                         (FilterMutable+--                                                            (ModsOf+--                                                               cls (ContainerOf t))))+--                                                      (QueryData+--                                                         (Info idx el cls (DataStoreOf t))+--                                                         (Selected+--                                                            (LstIn+--                                                               (ModsOf+--                                                                  cls (ContainerOf t))+--                                                               (Unique q))+--                                                            (FilterMutable+--                                                               (ModsOf+--                                                                  cls+--                                                                  (ContainerOf t))))))),++--                                                                  -- manual+--                                                                  Functor m,+--                                                                  AssumeRtupConv q t,+--                                                                  IsContainer t,+--                                                                  InfoInst (Info idx el cls (ContainerOf t)) (Unique q) m,+--                                                                  DataStoreOf (ContainerOf t) ~ DataStoreOf t,+--                                                                  (QueryData (Info idx el cls (DataStoreOf t)) (FilterMutable q) ~ QueryData (Info idx el cls (DataStoreOf t)) (FilterMutable q)))+++--type family TransCheck q info info' t where+--    TransCheck q (Info idx el cls) info' t = (FillData+--                        (FilterMutable q)+--                        (TaggedCont+--                           (Selected+--                              (LstIn (ModsOf cls (ContainerOf t)) q)+--                              (FilterMutable (ModsOf cls (ContainerOf t))))+--                           (QueryData+--                              (Info idx el cls (DataStoreOf t))+--                              (Selected+--                                 (LstIn+--                                    (ModsOf cls (ContainerOf t))+--                                    (Unique q))+--                                 (FilterMutable (ModsOf cls (ContainerOf t))))))+--                      ~ QueryData+--                          (info' (DataStoreOf t)) (FilterMutable q))+++++++----type family Test (a :: k) where Test a = (If a :== (t1,t2)) True True+++----type family Match++--class IsTuple a (is :: Bool) | a -> is++--instance {-# OVERLAPPABLE #-} is ~ False => IsTuple a is+--instance                                    IsTuple () True+--instance                                    IsTuple (t1,t2) True+--instance                                    IsTuple (t1,t2,t3) True+--instance                                    IsTuple (t1,t2,t3,t4) True+--instance                                    IsTuple (t1,t2,t3,t4,t5) True+--instance                                    IsTuple (t1,t2,t3,t4,t5,t6) True+--instance                                    IsTuple (t1,t2,t3,t4,t5,t6,t7) True+--instance                                    IsTuple (t1,t2,t3,t4,t5,t6,t7,t8) True+--instance                                    IsTuple (t1,t2,t3,t4,t5,t6,t7,t8,t9) True++---- FIXME [WD]: below ToTupCtx* refer to need of AssumeRtupConv function, which adds special case context when we are returning only single value from Rtuple (t,())+---- It is not seen properly byGHC though+----type family ToTupCtx a :: Constraint where+----  ToTupCtx (t,()) = (AsRTup t ~ (t,()))+----  ToTupCtx t      = ()++----type family ToTupCtx2 a :: Constraint where+----  ToTupCtx2 (t1,t2) = ()+----  ToTupCtx2 (t1,t2,t3) = ()+----  ToTupCtx2 (t1,t2,t3,t4) = ()+----  ToTupCtx2 (t1,t2,t3,t4,t5) = ()+----  ToTupCtx2 (t1,t2,t3,t4,t5,t6) = ()+----  ToTupCtx2 (t1,t2,t3,t4,t5,t6,t7) = ()+----  ToTupCtx2 (t1,t2,t3,t4,t5,t6,t7,t8) = ()+----  ToTupCtx2 (t1,t2,t3,t4,t5,t6,t7,t8,t9) = ()+----  ToTupCtx2 t = (AsRTup t ~ (t,()))++--  ---- Utils++--type family   AsTup a+--type instance AsTup () = ()+--type instance AsTup (t1,()) = t1+--type instance AsTup (t1,(t2,())) = (t1,t2)+--type instance AsTup (t1,(t2,(t3,()))) = (t1,t2,t3)+--type instance AsTup (t1,(t2,(t3,(t4,())))) = (t1,t2,t3,t4)+--type instance AsTup (t1,(t2,(t3,(t4,(t5,()))))) = (t1,t2,t3,t4,t5)+--type instance AsTup (t1,(t2,(t3,(t4,(t5,(t6,())))))) = (t1,t2,t3,t4,t5,t6)+--type instance AsTup (t1,(t2,(t3,(t4,(t5,(t6,(t7,()))))))) = (t1,t2,t3,t4,t5,t6,t7)+--type instance AsTup (t1,(t2,(t3,(t4,(t5,(t6,(t7,(t8,())))))))) = (t1,t2,t3,t4,t5,t6,t7,t8)+--type instance AsTup (t1,(t2,(t3,(t4,(t5,(t6,(t7,(t8,(t9,()))))))))) = (t1,t2,t3,t4,t5,t6,t7,t8,t9)++--type family   AsRTup a where+--    AsRTup () = ()+--    AsRTup (t1,t2) = (t1,(t2,()))+--    AsRTup (t1,t2,t3) = (t1,(t2,(t3,())))+--    AsRTup (t1,t2,t3,t4) = (t1,(t2,(t3,(t4,()))))+--    AsRTup (t1,t2,t3,t4,t5) = (t1,(t2,(t3,(t4,(t5,())))))+--    AsRTup (t1,t2,t3,t4,t5,t6) = (t1,(t2,(t3,(t4,(t5,(t6,()))))))+--    AsRTup (t1,t2,t3,t4,t5,t6,t7) = (t1,(t2,(t3,(t4,(t5,(t6,(t7,())))))))+--    AsRTup (t1,t2,t3,t4,t5,t6,t7,t8) = (t1,(t2,(t3,(t4,(t5,(t6,(t7,(t8,()))))))))+--    AsRTup (t1,t2,t3,t4,t5,t6,t7,t8,t9) = (t1,(t2,(t3,(t4,(t5,(t6,(t7,(t8,(t9,())))))))))+--    AsRTup a = (a,())+++--class    a ~ AsRTup (AsTup a) => ToTup a  where toTup :: a -> AsTup a+--instance ToTup () where toTup _ = ()+--instance AsRTup t1 ~ (t1,()) => ToTup (t1,()) where toTup (t1,()) = t1+--instance ToTup (t1,(t2,())) where toTup (t1,(t2,())) = (t1,t2)+--instance ToTup (t1,(t2,(t3,()))) where toTup (t1,(t2,(t3,()))) = (t1,t2,t3)+--instance ToTup (t1,(t2,(t3,(t4,())))) where toTup (t1,(t2,(t3,(t4,())))) = (t1,t2,t3,t4)+--instance ToTup (t1,(t2,(t3,(t4,(t5,()))))) where toTup (t1,(t2,(t3,(t4,(t5,()))))) = (t1,t2,t3,t4,t5)+--instance ToTup (t1,(t2,(t3,(t4,(t5,(t6,())))))) where toTup (t1,(t2,(t3,(t4,(t5,(t6,())))))) = (t1,t2,t3,t4,t5,t6)+--instance ToTup (t1,(t2,(t3,(t4,(t5,(t6,(t7,()))))))) where toTup (t1,(t2,(t3,(t4,(t5,(t6,(t7,()))))))) = (t1,t2,t3,t4,t5,t6,t7)+--instance ToTup (t1,(t2,(t3,(t4,(t5,(t6,(t7,(t8,())))))))) where toTup (t1,(t2,(t3,(t4,(t5,(t6,(t7,(t8,())))))))) = (t1,t2,t3,t4,t5,t6,t7,t8)+--instance ToTup (t1,(t2,(t3,(t4,(t5,(t6,(t7,(t8,(t9,()))))))))) where toTup (t1,(t2,(t3,(t4,(t5,(t6,(t7,(t8,(t9,()))))))))) = (t1,t2,t3,t4,t5,t6,t7,t8,t9)++--type SimpleRes a = AsRTup a ~ (a, ())+++++++++type Simple (t :: [*] -> [*] -> k) = t '[] '[]

@@ -0,0 +1,227 @@+{-# LANGUAGE CPP                       #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE ScopedTypeVariables       #-}+{-# LANGUAGE UndecidableInstances      #-}+++-- | This module provides proxy utilities for Data.Container.Class.+-- | The proxy classes allow for nice options-dependent instance implementations,+-- | hiding at the same time the complexity needed for type-level constrains resolution.++module Data.Container.Proxy where++import Prelude++import Data.Container.Class+import Data.Container.Opts  (GetQueryData, QueryData, ParamsOf, ModsOf, MatchOpts, Knowledge(..), OptQuery(..), Query(..), getQueryData, Opt)+import Data.Typeable        (Proxy(..))+import GHC.Exts             (Constraint)++-----------------------------+-- === Proxy utilities === --+-----------------------------++-- header utils+++type family ConstrainCls op (ms :: [Opt *]) (ps :: [Opt *]) (info :: * -> Info (Knowledge *) (Knowledge *) *) (m :: * -> *) :: * -> Constraint++type OpAxioms     op info ms t = (ResultAxioms op info ms t, Functor (PrimResult op (GetOpts ms) t))+type ResultAxioms op info ms t = Result_ op (info t) (GetOpts ms) ~ Result_ op (info (DataStore t)) (GetOpts ms)++#define OpCtx(cls_, info_) {- Inputs (we need to repeat them, cause OSX cpp preprocessor expands the first occurrence only) -} \+                                 cls      ~ (cls_)                                                                             \+                               , info     ~ (info_)                                                                            \+                           {- derives: -}                                                                                      \+                               , fullInfo ~ info cont                                                                          \+                               , matchMs  ~ MatchOpts (ModsOf   cls cont) ms                                                   \+                               , matchPs  ~ MatchOpts (ParamsOf cls cont) ps                                                   \+                               , provided ~ GetOpts matchMs                                                                    \+                               , opts     ~ Result_ cls fullInfo provided                                                      \+                               , cont     ~ Container a                                                                      \+                               , Monad m                                                                                       \+                           {- Super-class constraints: -}                                                                      \+                               , ConstrainCls cls_ matchMs matchPs info m cont                                                 \+                           {- Data queries: -}                                                                                 \+                               , QueryData    provided ms opts ~ Result_ cls fullInfo ms                                       \+                               , GetQueryData provided ms opts                                                                 \+                           {- Query-selected result equality: -}                                                               \+                               , ResultAxioms cls info matchMs cont                                                            \+                           {- Type prettify-}                                                                                  \+                               , PrettyCtx ms a++++-------------------------------------+-- === Proxy operation classes === --+-------------------------------------+++    +runOp (Proxy :: Proxy cls) (Proxy :: Proxy cont) f getter setter (Query :: Query ms ps) x = do +    Res datas c <- f (OptQuery :: OptQuery (MatchOpts (ModsOf cls cont) ms) (MatchOpts (ParamsOf cls cont) ps)) =<< getter x+    Res (getQueryData (Proxy :: Proxy (GetOpts (MatchOpts (ModsOf cls cont) ms))) (Proxy :: Proxy ms) datas) <$> setter c x++#define RUNOP() runOp (Proxy :: Proxy cls) (Proxy :: Proxy cont)++-- === Finite ===++-- Measurable+-- MinBounded+-- MaxBounded++class Monad m => MeasurableQM_ ms ps m     cont where sizeM_     :: OpAxioms MeasurableOp PrimInfo      ms cont => OptQuery ms ps -> cont -> m (PrimResult MeasurableOp (GetOpts ms)     cont Int)+class Monad m => MinBoundedQM_ ms ps m idx cont where minBoundM_ :: OpAxioms MinBoundedOp (IdxInfo idx) ms cont => OptQuery ms ps -> cont -> m (IdxResult  MinBoundedOp (GetOpts ms) idx cont idx)+class Monad m => MaxBoundedQM_ ms ps m idx cont where maxBoundM_ :: OpAxioms MaxBoundedOp (IdxInfo idx) ms cont => OptQuery ms ps -> cont -> m (IdxResult  MaxBoundedOp (GetOpts ms) idx cont idx)++type instance ConstrainCls MeasurableOp ms ps info                     m = MeasurableQM_ ms ps m+type instance ConstrainCls MinBoundedOp ms ps ('Info (Known idx) el) m = MinBoundedQM_ ms ps m idx+type instance ConstrainCls MaxBoundedOp ms ps ('Info (Known idx) el) m = MaxBoundedQM_ ms ps m idx++instance {-# OVERLAPPABLE #-} Monad m                                              => MeasurableQM ImpTL ps m     a          where sizeQM     = impossible+instance {-# OVERLAPPABLE #-} (Monad m, PrettyCtx ms Impossible)                   => MeasurableQM ms    ps m     Impossible where sizeQM     = impossible+instance {-# OVERLAPPABLE #-} (HasContainerM m a, OpCtx(MeasurableOp,PrimInfo))    => MeasurableQM ms    ps m     a          where sizeQM     = RUNOP() sizeM_ viewContainerM (const . return)++instance {-# OVERLAPPABLE #-} Monad m                                              => MinBoundedQM ImpTL ps m idx a          where minBoundQM = impossible+instance {-# OVERLAPPABLE #-} (Monad m, PrettyCtx ms Impossible)                   => MinBoundedQM ms    ps m idx Impossible where minBoundQM = impossible+instance {-# OVERLAPPABLE #-} (HasContainerM m a, OpCtx(MinBoundedOp,IdxInfo idx)) => MinBoundedQM ms    ps m idx a          where minBoundQM = RUNOP() minBoundM_ viewContainerM (const . return)++instance {-# OVERLAPPABLE #-} Monad m                                              => MaxBoundedQM ImpTL ps m idx a          where maxBoundQM = impossible+instance {-# OVERLAPPABLE #-} (Monad m, PrettyCtx ms Impossible)                   => MaxBoundedQM ms    ps m idx Impossible where maxBoundQM = impossible+instance {-# OVERLAPPABLE #-} (HasContainerM m a, OpCtx(MaxBoundedOp,IdxInfo idx)) => MaxBoundedQM ms    ps m idx a          where maxBoundQM = RUNOP() maxBoundM_ viewContainerM (const . return)+    ++-- === Construction ===++-- Singleton+-- Allocable+-- Expandable+-- Growable+++class Monad m => SingletonQM_  ms ps m el cont where singletonM_ :: OpAxioms SingletonOp (ElInfo el) ms cont => OptQuery ms ps         -> el   -> m (ElResult   SingletonOp  (GetOpts ms) el cont cont)+class Monad m => AllocableQM_  ms ps m    cont where allocM_     :: OpAxioms AllocableOp  PrimInfo   ms cont => OptQuery ms ps -> Int          -> m (PrimResult AllocableOp  (GetOpts ms)    cont cont)+class Monad m => ExpandableQM_ ms ps m    cont where expandM_    :: OpAxioms ExpandableOp PrimInfo   ms cont => OptQuery ms ps         -> cont -> m (PrimResult ExpandableOp (GetOpts ms)    cont cont)+class Monad m => GrowableQM_   ms ps m    cont where growM_      :: OpAxioms GrowableOp   PrimInfo   ms cont => OptQuery ms ps -> Int  -> cont -> m (PrimResult GrowableOp   (GetOpts ms)    cont cont)++type instance ConstrainCls SingletonOp  ms ps ('Info idx (Known el)) m = SingletonQM_  ms ps m el+type instance ConstrainCls AllocableOp  ms ps info                     m = AllocableQM_  ms ps m+type instance ConstrainCls ExpandableOp ms ps info                     m = ExpandableQM_ ms ps m+type instance ConstrainCls GrowableOp   ms ps info                     m = GrowableQM_   ms ps m++instance {-# OVERLAPPABLE #-} Monad m                                            => SingletonQM ImpTL  ps m el a          where singletonQM = impossible+instance {-# OVERLAPPABLE #-} (Monad m, PrettyCtx ms Impossible)                 => SingletonQM ms     ps m el Impossible where singletonQM = impossible+instance {-# OVERLAPPABLE #-} (IsContainerM m a, OpCtx(SingletonOp,ElInfo el))   => SingletonQM ms     ps m el a          where singletonQM = RUNOP() singletonM_ return (const . fromContainerM)++instance {-# OVERLAPPABLE #-} Monad m                                            => AllocableQM ImpTL  ps m    a          where allocQM     = impossible+instance {-# OVERLAPPABLE #-} (Monad m, PrettyCtx ms Impossible)                 => AllocableQM ms     ps m    Impossible where allocQM     = impossible+instance {-# OVERLAPPABLE #-} (IsContainerM m a, OpCtx(AllocableOp,PrimInfo) )   => AllocableQM ms     ps m    a          where allocQM     = RUNOP() allocM_     return (const . fromContainerM)++instance {-# OVERLAPPABLE #-} Monad m                                            => ExpandableQM ImpTL ps m    a          where expandQM    = impossible+instance {-# OVERLAPPABLE #-} (Monad m, PrettyCtx ms Impossible)                 => ExpandableQM ms    ps m    Impossible where expandQM    = impossible+instance {-# OVERLAPPABLE #-} (HasContainerM m a, OpCtx(ExpandableOp,PrimInfo))  => ExpandableQM ms    ps m    a          where expandQM    = RUNOP() expandM_ viewContainerM setContainerM++instance {-# OVERLAPPABLE #-} Monad m                                            => GrowableQM ImpTL ps m      a          where growQM      = impossible+instance {-# OVERLAPPABLE #-} (Monad m, PrettyCtx ms Impossible)                 => GrowableQM ms    ps m      Impossible where growQM      = impossible+instance {-# OVERLAPPABLE #-} (HasContainerM m a, OpCtx(GrowableOp,PrimInfo)  )  => GrowableQM ms    ps m      a          where growQM  q i = RUNOP() (flip growM_ i) viewContainerM setContainerM q+++-- === Modification ===+-- Appendable+-- Prependable+-- Addable+-- Removable+-- Insertable+-- Freeable+-- Reservable+++class Monad m => AppendableQM_  ms ps m     el cont where appendM_  :: OpAxioms AppendableOp  (ElInfo        el) ms cont => OptQuery ms ps        -> el -> cont -> m (ElResult    AppendableOp  (GetOpts ms)     el cont cont)+class Monad m => PrependableQM_ ms ps m     el cont where prependM_ :: OpAxioms PrependableOp (ElInfo        el) ms cont => OptQuery ms ps        -> el -> cont -> m (ElResult    PrependableOp (GetOpts ms)     el cont cont)+class Monad m => AddableQM_     ms ps m     el cont where addM_     :: OpAxioms AddableOp     (ElInfo        el) ms cont => OptQuery ms ps        -> el -> cont -> m (ElResult    AddableOp     (GetOpts ms)     el cont cont)+class Monad m => RemovableQM_   ms ps m     el cont where removeM_  :: OpAxioms RemovableOp   (ElInfo        el) ms cont => OptQuery ms ps        -> el -> cont -> m (ElResult    RemovableOp   (GetOpts ms)     el cont cont)+class Monad m => InsertableQM_  ms ps m idx el cont where insertM_  :: OpAxioms InsertableOp  (IdxElInfo idx el) ms cont => OptQuery ms ps -> idx -> el -> cont -> m (IdxElResult InsertableOp  (GetOpts ms) idx el cont cont)+class Monad m => FreeableQM_    ms ps m idx    cont where freeM_    :: OpAxioms FreeableOp    (IdxInfo   idx   ) ms cont => OptQuery ms ps -> idx       -> cont -> m (IdxResult   FreeableOp    (GetOpts ms) idx    cont cont)+class Monad m => ReservableQM_  ms ps m        cont where reserveM_ :: OpAxioms ReservableOp  PrimInfo           ms cont => OptQuery ms ps              -> cont -> m (PrimResult  ReservableOp  (GetOpts ms)        cont cont)++type instance ConstrainCls AppendableOp  ms ps ('Info idx          ('Known el)) m = AppendableQM_  ms ps m     el+type instance ConstrainCls PrependableOp ms ps ('Info idx          ('Known el)) m = PrependableQM_ ms ps m     el+type instance ConstrainCls AddableOp     ms ps ('Info idx          ('Known el)) m = AddableQM_     ms ps m     el+type instance ConstrainCls RemovableOp   ms ps ('Info idx          ('Known el)) m = RemovableQM_   ms ps m     el+type instance ConstrainCls InsertableOp  ms ps ('Info ('Known idx) ('Known el)) m = InsertableQM_  ms ps m idx el+type instance ConstrainCls FreeableOp    ms ps ('Info ('Known idx) el         ) m = FreeableQM_    ms ps m idx+type instance ConstrainCls ReservableOp  ms ps info                             m = ReservableQM_  ms ps m++instance {-# OVERLAPPABLE #-} Monad m                                                   => AppendableQM   ImpTL ps m     el a          where appendQM           = impossible+instance {-# OVERLAPPABLE #-} (Monad m, PrettyCtx ms Impossible)                        => AppendableQM   ms    ps m     el Impossible where appendQM           = impossible+instance {-# OVERLAPPABLE #-} (HasContainerM m a, OpCtx(AppendableOp,ElInfo el))        => AppendableQM   ms    ps m     el a          where appendQM  q     el = RUNOP() (flip appendM_ el) viewContainerM setContainerM q++instance {-# OVERLAPPABLE #-} Monad m                                                   => PrependableQM  ImpTL ps m     el a          where prependQM          = impossible+instance {-# OVERLAPPABLE #-} (Monad m, PrettyCtx ms Impossible)                        => PrependableQM  ms    ps m     el Impossible where prependQM          = impossible+instance {-# OVERLAPPABLE #-} (HasContainerM m a, OpCtx(PrependableOp,ElInfo el))       => PrependableQM  ms    ps m     el a          where prependQM q     el = RUNOP() (flip prependM_ el) viewContainerM setContainerM q++instance {-# OVERLAPPABLE #-} Monad m                                                   => AddableQM      ImpTL ps m     el a          where addQM              = impossible+instance {-# OVERLAPPABLE #-} (Monad m, PrettyCtx ms Impossible)                        => AddableQM      ms    ps m     el Impossible where addQM              = impossible+instance {-# OVERLAPPABLE #-} (HasContainerM m a, OpCtx(AddableOp,ElInfo el))           => AddableQM      ms    ps m     el a          where addQM     q     el = RUNOP() (flip addM_ el) viewContainerM setContainerM q++instance {-# OVERLAPPABLE #-} Monad m                                                   => RemovableQM    ImpTL ps m     el a          where removeQM           = impossible+instance {-# OVERLAPPABLE #-} (Monad m, PrettyCtx ms Impossible)                        => RemovableQM    ms    ps m     el Impossible where removeQM           = impossible+instance {-# OVERLAPPABLE #-} (HasContainerM m a, OpCtx(RemovableOp,ElInfo el))         => RemovableQM    ms    ps m     el a          where removeQM  q     el = RUNOP() (flip removeM_ el) viewContainerM setContainerM q++instance {-# OVERLAPPABLE #-} Monad m                                                   => InsertableQM   ImpTL ps m idx el a          where insertQM           = impossible+instance {-# OVERLAPPABLE #-} (Monad m, PrettyCtx ms Impossible)                        => InsertableQM   ms    ps m idx el Impossible where insertQM           = impossible+instance {-# OVERLAPPABLE #-} (HasContainerM m a, OpCtx(InsertableOp,IdxElInfo idx el)) => InsertableQM   ms    ps m idx el a          where insertQM  q idx el = RUNOP() (flip (flip insertM_ idx) el) viewContainerM setContainerM q++instance {-# OVERLAPPABLE #-} Monad m                                                   => FreeableQM     ImpTL ps m idx    a          where freeQM             = impossible+instance {-# OVERLAPPABLE #-} (Monad m, PrettyCtx ms Impossible)                        => FreeableQM     ms    ps m idx    Impossible where freeQM             = impossible+instance {-# OVERLAPPABLE #-} (HasContainerM m a, OpCtx(FreeableOp,IdxInfo idx))        => FreeableQM     ms    ps m idx    a          where freeQM    q idx    = RUNOP() (flip freeM_ idx) viewContainerM setContainerM q++instance {-# OVERLAPPABLE #-} Monad m                                                   => ReservableQM   ImpTL ps m        a          where reserveQM          = impossible+instance {-# OVERLAPPABLE #-} (Monad m, PrettyCtx ms Impossible)                        => ReservableQM   ms    ps m        Impossible where reserveQM          = impossible+instance {-# OVERLAPPABLE #-} (HasContainerM m a, OpCtx(ReservableOp,PrimInfo))         => ReservableQM   ms    ps m        a          where reserveQM q        = RUNOP() reserveM_ viewContainerM setContainerM q+++++-- === Indexing ===++-- Indexable+-- TracksFreeIxes+-- TracksUsedIxes+-- TracksIxes+-- TracksElems++class Monad m => IndexableQM_       ms ps m idx el cont where indexM_    :: OpAxioms IndexableOp      (IdxElInfo idx el) ms cont => OptQuery ms ps -> idx -> cont -> m (IdxElResult IndexableOp      (GetOpts ms) idx el cont el   )+class Monad m => TracksFreeIxesQM_  ms ps m idx    cont where freeIxesM_ :: OpAxioms TracksFreeIxesOp (IdxInfo   idx   ) ms cont => OptQuery ms ps        -> cont -> m (IdxResult   TracksFreeIxesOp (GetOpts ms) idx    cont [idx])+class Monad m => TracksUsedIxesQM_  ms ps m idx    cont where usedIxesM_ :: OpAxioms TracksUsedIxesOp (IdxInfo   idx   ) ms cont => OptQuery ms ps        -> cont -> m (IdxResult   TracksUsedIxesOp (GetOpts ms) idx    cont [idx])+class Monad m => TracksIxesQM_      ms ps m idx    cont where ixesM_     :: OpAxioms TracksIxesOp     (IdxInfo   idx   ) ms cont => OptQuery ms ps        -> cont -> m (IdxResult   TracksIxesOp     (GetOpts ms) idx    cont [idx])+class Monad m => TracksElemsQM_     ms ps m     el cont where elemsM_    :: OpAxioms TracksElemsOp    (ElInfo        el) ms cont => OptQuery ms ps        -> cont -> m (ElResult    TracksElemsOp    (GetOpts ms)     el cont [el] )++type instance ConstrainCls IndexableOp      ms ps ('Info ('Known idx) ('Known el)) m = IndexableQM_      ms ps m idx el+type instance ConstrainCls TracksFreeIxesOp ms ps ('Info ('Known idx) el         ) m = TracksFreeIxesQM_ ms ps m idx+type instance ConstrainCls TracksUsedIxesOp ms ps ('Info ('Known idx) el         ) m = TracksUsedIxesQM_ ms ps m idx+type instance ConstrainCls TracksIxesOp     ms ps ('Info ('Known idx) el         ) m = TracksIxesQM_     ms ps m idx+type instance ConstrainCls TracksElemsOp    ms ps ('Info idx          ('Known el)) m = TracksElemsQM_    ms ps m     el++instance {-# OVERLAPPABLE #-} Monad m                                                  => IndexableQM      ImpTL ps m idx el a          where indexQM          = impossible+instance {-# OVERLAPPABLE #-} (Monad m, PrettyCtx ms Impossible)                       => IndexableQM      ms    ps m idx el Impossible where indexQM          = impossible+instance {-# OVERLAPPABLE #-} (HasContainerM m a, OpCtx(IndexableOp,IdxElInfo idx el)) => IndexableQM      ms    ps m idx el a          where indexQM    q idx = RUNOP() (flip indexM_ idx) viewContainerM (const . return) q++instance {-# OVERLAPPABLE #-} Monad m                                                  => TracksFreeIxesQM ImpTL ps m idx    a          where freeIxesQM       = impossible+instance {-# OVERLAPPABLE #-} (Monad m, PrettyCtx ms Impossible)                       => TracksFreeIxesQM ms    ps m idx    Impossible where freeIxesQM       = impossible+instance {-# OVERLAPPABLE #-} (HasContainerM m a, OpCtx(TracksFreeIxesOp,IdxInfo idx)) => TracksFreeIxesQM ms    ps m idx    a          where freeIxesQM       = RUNOP() freeIxesM_ viewContainerM (const . return)++instance {-# OVERLAPPABLE #-} Monad m                                                  => TracksUsedIxesQM ImpTL ps m idx    a          where usedIxesQM       = impossible+instance {-# OVERLAPPABLE #-} (Monad m, PrettyCtx ms Impossible)                       => TracksUsedIxesQM ms    ps m idx    Impossible where usedIxesQM       = impossible+instance {-# OVERLAPPABLE #-} (HasContainerM m a, OpCtx(TracksUsedIxesOp,IdxInfo idx)) => TracksUsedIxesQM ms    ps m idx    a          where usedIxesQM       = RUNOP() usedIxesM_ viewContainerM (const . return)++instance {-# OVERLAPPABLE #-} Monad m                                                  => TracksIxesQM     ImpTL ps m idx    a          where ixesQM           = impossible+instance {-# OVERLAPPABLE #-} (Monad m, PrettyCtx ms Impossible)                       => TracksIxesQM     ms    ps m idx    Impossible where ixesQM           = impossible+instance {-# OVERLAPPABLE #-} (HasContainerM m a, OpCtx(TracksIxesOp,IdxInfo idx))     => TracksIxesQM     ms    ps m idx    a          where ixesQM           = RUNOP() ixesM_ viewContainerM (const . return)++instance {-# OVERLAPPABLE #-} Monad m                                                  => TracksElemsQM    ImpTL ps m     el a          where elemsQM          = impossible+instance {-# OVERLAPPABLE #-} (Monad m, PrettyCtx ms Impossible)                       => TracksElemsQM    ms    ps m     el Impossible where elemsQM          = impossible+instance {-# OVERLAPPABLE #-} (HasContainerM m a, OpCtx(TracksElemsOp,ElInfo el))      => TracksElemsQM    ms    ps m     el a          where elemsQM          = RUNOP() elemsM_ viewContainerM (const . return)+++

@@ -0,0 +1,358 @@+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE DeriveAnyClass       #-}+++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++----------------------+-- === Resizable === --+----------------------++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)++++-- === Styles ===++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++-- === Resizing utilities ====++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+++------------------------+-- === Instances === ---+------------------------++-- === Finite ===++-- [+] Measurable+-- [+] MinBounded+-- [+] MaxBounded++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++++-- === Construction ===++-- [+] Singleton+-- [+] Allocable+-- [+] Expandable+-- [+] Growable++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++++-- === Modification ===+-- [+] Appendable+-- [+] Prependable+-- [+] Addable+-- [+] Removable+-- [+] Insertable+-- [+] Freeable++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))+++++---- === Indexing ===++-- [+] Indexable+-- [+] TracksFreeIxes+-- [+] TracksUsedIxes+-- [+] TracksIxes+-- [+] TracksElems++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++++++++++++---- === TF Instances ===++--type instance Container (HResizable l a) = HResizable l a++--instance IsContainer  (HResizable l a) where fromContainer = id+--instance HasContainer (HResizable l a) where container     = id+++--type instance Item        (HResizable l a) = Item       a+--type instance ElementByIx  idx (HResizable l a) = ElementByIx idx a+--type instance Index      el  (HResizable l a) = Index     el  a++--type instance DataStore (HResizable l a) = DataStore a+++---- === Finite ===++---- [+] Measurable+---- [+] MinBounded+---- [+] MaxBounded+++--type instance ModsOf MeasurableQSM (HResizable l a) = ModsOf MeasurableQSM a+--type instance ModsOf MinIndexedQSM (HResizable l a) = ModsOf MinIndexedQSM a+--type instance ModsOf MaxIndexedQSM (HResizable l a) = ModsOf MaxIndexedQSM a++--instance MeasurableQM q m a => MeasurableQSM (HResizable l a) m q s where sizeQSM     _ _ = queried (Proxy :: Proxy q) sizeM'     . unlayer+--instance MinIndexedQM idx q m a => MinIndexedQSM idx (HResizable l a) m q s where minIndexQSM _ _ = queried (Proxy :: Proxy q) minIndexM' . unlayer+--instance MaxIndexedQM idx q m a => MaxIndexedQSM idx (HResizable l a) m q s where maxIndexQSM _ _ = queried (Proxy :: Proxy q) maxIndexM' . unlayer+++---- === Construction ===++---- [+] Singleton+---- [+] Allocable+---- [+] Expandable+---- [+] Growable++--        --type instance ModsOf SingletonQSM (HResizable l a) = ModsOf SingletonQSM a+--        --instance (SingletonQM el q m a, Default l) => SingletonQSM el (HResizable l a) m q s where singletonQSM _ _    = (fmap . fmap) wrap . queried (Proxy :: Proxy q) singletonM'++--        --type instance ModsOf AllocableQSM (HResizable l a) = ModsOf AllocableQSM a+--        --instance (AllocableQM q m a, Default l) => AllocableQSM (HResizable l a) m q s where allocQSM _ _    = (fmap . fmap) wrap . queried (Proxy :: Proxy q) allocM'++--type instance ModsOf ExpandableQSM (HResizable l a) = ModsOf GrowableQSM a+--instance (GrowableQM q m a, TransCheck q GrowableInfo ExpandableInfo a, ResizeStep l a) => ExpandableQSM (HResizable l a) m q s where expandQSM _ _ c = nested layered (queried (Proxy :: Proxy q) growM' (resizeStep c)) c++--type instance ModsOf GrowableQSM (HResizable l a) = ModsOf GrowableQSM a+--instance GrowableQM q m a => GrowableQSM (HResizable l a) m q s where growQSM _ _    = nested layered . queried (Proxy :: Proxy q) growM'+++---- === Modification ===++---- [+] Appendable+---- [ ] Prependable+---- [ ] Addable+---- [ ] Removable++--type instance ModsOf AppendableQSM (HResizable l a) = ModsOf AppendableQSM a+--type instance ModsOf InsertableQSM (HResizable l a) = ModsOf InsertableQSM a++--instance   AppendableQM     el q m a => AppendableQSM     el (HResizable l a) m q s where appendQSM _ _ = nested layered .  queried (Proxy :: Proxy q) appendM'+--instance   InsertableQM idx el q m a => InsertableQSM idx el (HResizable l a) m q s where insertQSM _ _ = nested layered .: queried (Proxy :: Proxy q) insertM'++++------ === Indexing ===++---- [+] Indexable+---- [ ] TracksElems+---- [ ] TracksIxes+---- [ ] TracksFreeIxes+---- [ ] TracksUsedIxes+++--type instance ModsOf IndexableQSM   (HResizable l a) = ModsOf IndexableQSM   a+--type instance ModsOf TracksIxesQSM  (HResizable l a) = ModsOf TracksIxesQSM  a+--type instance ModsOf TracksElemsQSM (HResizable l a) = ModsOf TracksElemsQSM a++--instance   IndexableQM   idx el q m a => IndexableQSM   idx el (HResizable l a) m q s where indexQSM _ _ idx = queried (Proxy :: Proxy q) indexM' idx . unlayer+--instance   TracksIxesQM  idx    q m a => TracksIxesQSM  idx    (HResizable l a) m q s where ixesQSM  _ _     = queried (Proxy :: Proxy q) ixesM'      . unlayer+--instance   TracksElemsQM     el q m a => TracksElemsQSM     el (HResizable l a) m q s where elemsQSM _ _     = queried (Proxy :: Proxy q) elemsM'     . unlayer+++++--------------------------------------+++--data Minimal     = Minimal   deriving (Show)+--data Exponential = Exponential deriving (Show)++--instance Default Minimal     where def = Minimal+--instance Default Exponential where def = Exponential++------class Resize2 style cont where+------    resizeAmount :: Proxy style -> cont -> Int++----class                                                                                               Resize style       cont idx where resize     :: idx -> HResizable style cont -> HResizable style cont+----instance (                       I.MaxIndexed cont idx, I.Growable cont cont, Enum idx, Ord idx) => Resize Minimal     cont idx where resize idx c = if isOverBounds idx c then flip I.growQSM c $ ((-) `on` fromEnum) idx $ I.maxIndex c else c+----instance (I.Measurable cont Int, I.MaxIndexed cont idx, I.Growable cont cont, Enum idx, Ord idx) => Resize Exponential cont idx where resize idx c = if isOverBounds idx c then flip I.growQSM c $ dupCheckSize (fromEnum idx) (I.sizeQSM c) - I.sizeQSM c else c++----class                             ResizeStep style       cont where resizeStep :: HResizable style cont -> Int+----instance                          ResizeStep Minimal     cont where resizeStep c = 1+----instance I.Measurable cont Int => ResizeStep Exponential cont where resizeStep c = checkZeroSize $ I.sizeQSM c++++++----dupCheckSize i = dupSize i . checkZeroSize++----dupSize i sizeQSM = if i >= sizeQSM then dupSize i (2 * sizeQSM)+----                              else sizeQSM+++----isOverBounds :: (Ord idx, I.MaxIndexed cont idx, HasContainer t cont) => idx -> t -> Bool+----isOverBounds idx cont = idx > I.maxIndex cont++++++++---- ---- TODO ----+---- after doing it we could be able to optimize the premise of ResizeStep Exponential and make inference nicer+----+---- -- Optimize following use cases:+----+---- xxx :: (MeasurableQM2 '[] Identity t, (ResultX+----                         (Info NA NA MeasurableQSM2 (DataStore t))+----                         (Selected+----                            (LstIn (ModsOf MeasurableQSM2 t) '[])+----                            (FilterMutable (ModsOf MeasurableQSM2 t)))+----                       ~ ()),+----+---- DataFillable+----                                 '[]+----                                 (TaggedCont+----                                    (Selected+----                                       (LstIn (ModsOf MeasurableQSM2 t) '[])+----                                       (FilterMutable (ModsOf MeasurableQSM2 t)))+----                                    ()), (Taggable+----                         (Selected+----                            (LstIn (ModsOf MeasurableQSM2 t) '[])+----                            (FilterMutable (ModsOf MeasurableQSM2 t)))+----                         ())) => HResizable style t -> Int+----+---- --- in particular:+----+---- (Selected+----                            (LstIn (ModsOf MeasurableQSM2 t) '[])+----                            (FilterMutable (ModsOf MeasurableQSM2 t)))+----+---- -- should always return []

@@ -0,0 +1,197 @@+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE DeriveAnyClass       #-}++module Data.Container.Reusable where++import Prelude hiding ((.))++import Control.Lens         hiding (Indexable, Ixed)+import Data.Container.Class+import Data.Container.List+import Data.Container.Opts  (Opt(P,N), Query(..), ModsOf, ParamsOf, Unchecked, Inplace, Ixed)+import Data.Container.Proxy+import Data.Default+import Data.Functor.Utils+import Data.Layer+import Data.List            ((\\))+import Data.Monoid++++----------------------+-- === Reusable === --+----------------------++data Reusable idx a = Reusable [idx] !a deriving (Functor, Foldable, Traversable, Monoid)+type Reusable'    a = Reusable (Index a) a++type instance Index     (Reusable idx a) = Index (Container a)+type instance Item      (Reusable idx a) = Item  (Container a)+type instance Container (Reusable idx a) = Reusable idx a+type instance DataStore (Reusable idx a) = Container a++instance Monad m => IsContainerM  m (Reusable idx a) where fromContainerM = return+instance Monad m => HasContainerM m (Reusable idx a) where viewContainerM = return+                                                           setContainerM  = const . return++type instance       Unlayered  (Reusable idx a) = a+instance            Layered    (Reusable idx a) where layered = lens (\(Reusable _ a) -> a) (\(Reusable ixs _) a -> Reusable ixs a)+instance Monad m => LayeredM m (Reusable idx a)++instance (IsContainer a, FromList (Container a)) +      => FromList  (Reusable idx a) where fromList = Reusable mempty . fromContainer . fromList++instance Default a => Default (Reusable idx a) where def = Reusable def def++_indexes :: Lens' (Reusable idx a) [idx]+_indexes = lens (\(Reusable ixs _) -> ixs) (\(Reusable _ a) ixs -> Reusable ixs a)++instance (ToList (Container a), HasContainer a) => ToList (Reusable idx a) where toList = toList . view container . unlayer++instance ( Show (Item a), TracksElems (Item a) (Reusable idx a)+         ) => Show (Reusable idx a) where+    show a = "Reusable [" <> intercalate ", " (fmap show (elems_ a :: [Item a])) <> "]"++------------------------+-- === Instances === ---+------------------------++-- === Finite ===++-- [+] Measurable+-- [+] MinBounded+-- [+] MaxBounded++type instance ParamsOf MeasurableOp (Reusable idx a) = ParamsOf MeasurableOp (Container a)+type instance ModsOf   MeasurableOp (Reusable idx a) = ModsOf   MeasurableOp (Container a)++type instance ParamsOf MinBoundedOp (Reusable idx a) = ParamsOf MinBoundedOp (Container a)+type instance ModsOf   MinBoundedOp (Reusable idx a) = ModsOf   MinBoundedOp (Container a)++type instance ParamsOf MaxBoundedOp (Reusable idx a) = ParamsOf MaxBoundedOp (Container a)+type instance ModsOf   MaxBoundedOp (Reusable idx a) = ModsOf   MaxBoundedOp (Container a)++instance (MeasurableQM (GetOpts ms) (GetOpts ps) m     a)             => MeasurableQM_ ms ps m     (Reusable idx  a) where sizeM_     _ = sizeQM     (Query :: Query (GetOpts ms) (GetOpts ps)) . unlayer+instance (MinBoundedQM (GetOpts ms) (GetOpts ps) m idx a, idx ~ idx') => MinBoundedQM_ ms ps m idx (Reusable idx' a) where minBoundM_ _ = minBoundQM (Query :: Query (GetOpts ms) (GetOpts ps)) . unlayer+instance (MaxBoundedQM (GetOpts ms) (GetOpts ps) m idx a, idx ~ idx') => MaxBoundedQM_ ms ps m idx (Reusable idx' a) where maxBoundM_ _ = maxBoundQM (Query :: Query (GetOpts ms) (GetOpts ps)) . unlayer++++-- === Construction ===++-- [+] Singleton+-- [+] Allocable+-- [+] Expandable+-- [+] Growable++type instance ParamsOf SingletonOp  (Reusable idx a) = ParamsOf SingletonOp  (Container a)+type instance ModsOf   SingletonOp  (Reusable idx a) = ModsOf   SingletonOp  (Container a)++type instance ParamsOf AllocableOp  (Reusable idx a) = ParamsOf AllocableOp  (Container a)+type instance ModsOf   AllocableOp  (Reusable idx a) = ModsOf   AllocableOp  (Container a)++type instance ParamsOf ExpandableOp (Reusable idx a) = ParamsOf ExpandableOp (Container a)+type instance ModsOf   ExpandableOp (Reusable idx a) = ModsOf   ExpandableOp (Container a)++type instance ParamsOf GrowableOp   (Reusable idx a) = ParamsOf GrowableOp   (Container a)+type instance ModsOf   GrowableOp   (Reusable idx a) = ModsOf   GrowableOp   (Container a)++instance ( SingletonQM (Ixed ': GetOpts ms) (GetOpts ps) m el a, idx ~ Index (Container a)) => SingletonQM_ ms ps m el (Reusable idx a) where +    singletonM_ _ el = do Res (ix,ds) r <- singletonQM (Query :: Query (Ixed ': GetOpts ms) (GetOpts ps)) el+                          return $ Res ds $ Reusable [ix] r++instance ( AllocableQM (Ixed ': GetOpts ms) (GetOpts ps) m a, idx ~ Index (Container a)) => AllocableQM_ ms ps m (Reusable idx a) where +    allocM_ _ i = do Res (ixs,ds) r <- allocQM (Query :: Query (Ixed ': GetOpts ms) (GetOpts ps)) i+                     return $ Res ds $ Reusable ixs r++instance ( ExpandableQM (Ixed ': GetOpts ms) (GetOpts ps) m a, idx ~ Index (Container a)) => ExpandableQM_ ms ps m (Reusable idx a) where +    expandM_ _ (Reusable ixs a) = do Res (ixs',ds) r <- expandQM (Query :: Query (Ixed ': GetOpts ms) (GetOpts ps)) a+                                     return $ Res ds $ Reusable (ixs <> ixs') r++instance ( GrowableQM (Ixed ': GetOpts ms) (GetOpts ps) m a, idx ~ Index (Container a)) => GrowableQM_ ms ps m (Reusable idx a) where +    growM_ _ i (Reusable ixs a) = do Res (ixs',ds) r <- growQM (Query :: Query (Ixed ': GetOpts ms) (GetOpts ps)) i a+                                     return $ Res ds $ Reusable (ixs <> ixs') r++++-- === Modification ===+-- [+] Appendable+-- [+] Prependable+-- [+] Addable+-- [ ] Removable+-- [+] Insertable+-- [+] Freeable+-- [+] Reservable++type instance ParamsOf AppendableOp   (Reusable idx a) = ParamsOf AppendableOp   (Container a)+type instance ModsOf   AppendableOp   (Reusable idx a) = ModsOf   AppendableOp   (Container a)++type instance ParamsOf PrependableOp  (Reusable idx a) = ParamsOf PrependableOp  (Container a)+type instance ModsOf   PrependableOp  (Reusable idx a) = ModsOf   PrependableOp  (Container a)++type instance ParamsOf AddableOp      (Reusable idx a) = ParamsOf AddableOp      (Container a)+type instance ModsOf   AddableOp      (Reusable idx a) = ModsOf   AddableOp      (Container a)++type instance ParamsOf InsertableOp   (Reusable idx a) = (Unchecked ': Inplace ': ParamsOf InsertableOp (Container a))+type instance ModsOf   InsertableOp   (Reusable idx a) = ModsOf   InsertableOp   (Container a)++type instance ParamsOf FreeableOp     (Reusable idx a) = ParamsOf FreeableOp     (Container a)+type instance ModsOf   FreeableOp     (Reusable idx a) = ModsOf   FreeableOp     (Container a)++type instance ParamsOf ReservableOp   (Reusable idx a) = '[]+type instance ModsOf   ReservableOp   (Reusable idx a) = '[Ixed]+++instance (AppendableQM  (GetOpts ms) (GetOpts ps) m el a)           => AppendableQM_  ms ps m el   (Reusable idx  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   (Reusable idx  a) where prependM_ _      = nested layered . prependQM (Query :: Query (GetOpts ms) (GetOpts ps))+instance (InsertableQM  (GetOpts ms) (GetOpts ps) m idx el a+         , ExpandableM m (Reusable idx a)+         , Result_ InsertableOp (IdxElInfo idx el (Container a)) (GetOpts ms) ~ Result_ AddableOp (ElInfo el (Reusable idx a)) (GetOpts ms)+         ) => AddableQM_     ms ps m el   (Reusable idx  a) where addM_     q el t = case view _indexes t of+                                                                                         (x:xs) -> fmap2 (Reusable xs) $ insertQM (Query :: Query (GetOpts ms) (GetOpts ps)) x el $ unlayer t+                                                                                         []     -> addM_ q el =<< expandM t++instance (InsertableQM (GetOpts ms) (GetOpts ps) m idx el a, idx ~ idx') => InsertableQM_ ms (P Unchecked ': P Inplace ': ps) m idx el (Reusable idx' a) where insertM_ _     = nested layered .: insertQM (Query :: Query (GetOpts ms) (GetOpts ps))+instance (FreeableQM   (GetOpts ms) (GetOpts ps) m idx    a, idx ~ idx') => FreeableQM_   ms ps                               m idx    (Reusable idx' a) where freeM_   _ idx = fmap2 (_indexes %~ (idx:)) . nested layered (freeQM (Query :: Query (GetOpts ms) (GetOpts ps)) idx)++instance (Monad m, idx ~ Index (Container a)) => ReservableQM_ '[P Ixed] ps                        m        (Reusable idx  a) where reserveM_ _ (Reusable (i:is) a) = return $ Res (i,()) (Reusable is a)++++---- === Indexing ===++-- [+] Indexable+-- [+] TracksFreeIxes+-- [+] TracksUsedIxes+-- [+] TracksIxes+-- [+] TracksElems++type instance ParamsOf IndexableOp      (Reusable idx a) = ParamsOf IndexableOp      (Container a)+type instance ModsOf   IndexableOp      (Reusable idx a) = ModsOf   IndexableOp      (Container a)++type instance ParamsOf TracksIxesOp     (Reusable idx a) = ParamsOf TracksIxesOp (Container a)+type instance ModsOf   TracksIxesOp     (Reusable idx a) = ModsOf   TracksIxesOp (Container a)++type instance ParamsOf TracksFreeIxesOp (Reusable idx a) = '[]+type instance ModsOf   TracksFreeIxesOp (Reusable idx a) = '[]++type instance ParamsOf TracksUsedIxesOp (Reusable idx a) = '[]+type instance ModsOf   TracksUsedIxesOp (Reusable idx a) = '[]++type instance ParamsOf TracksElemsOp    (Reusable idx a) = '[]+type instance ModsOf   TracksElemsOp    (Reusable idx a) = '[]+++instance (IndexableQM      (GetOpts ms) (GetOpts ps) m idx el a, idx ~ idx') => IndexableQM_       ms ps m idx el (Reusable idx' a) where indexM_     _ idx   = indexQM    (Query :: Query (GetOpts ms) (GetOpts ps)) idx . unlayer+instance (TracksIxesQM     (GetOpts ms) (GetOpts ps) m idx    a, idx ~ idx') => TracksIxesQM_      ms ps m idx    (Reusable idx' a) where ixesM_      _       = ixesQM     (Query :: Query (GetOpts ms) (GetOpts ps))     . unlayer+instance (Monad m, idx ~ idx')                                               => TracksFreeIxesQM_ '[] ps m idx    (Reusable idx' a) where freeIxesM_  _       = return . Res () . view _indexes++instance (TracksIxes idx (Reusable idx a)+         , TracksFreeIxes idx (Reusable idx a), idx ~ idx', Monad m, Eq idx) => TracksUsedIxesQM_ '[] ps m idx    (Reusable idx' a) where usedIxesM_  _     t = return $ Res () $ ixes t \\ freeIxes t++instance ( TracksUsedIxes  idx    (Reusable idx a)+         , Indexable       idx el (Reusable idx a)+         , Monad           m+         ) => TracksElemsQM_     '[] ps m     el (Reusable idx a) where elemsM_     _   t = return $ Res () $ fmap (flip index_ t) (usedIxes_ t :: [idx]) where

@@ -0,0 +1,15 @@+{-# LANGUAGE PolyKinds #-}++module Data.Container.Type where++import Prelude++--type family In (a :: a) (cont :: c) :: Bool++--type instance In a '[] = False+--type instance In a '[] = False++type family In a lst where+    In a (a ': ls) = True+    In a (l ': ls) = In a ls+    In a '[]       = False

@@ -0,0 +1,388 @@+{-# LANGUAGE CPP                       #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE TypeFamilies              #-}+{-# LANGUAGE UndecidableInstances      #-}+{-# LANGUAGE ScopedTypeVariables       #-}+{-# LANGUAGE RecursiveDo               #-}+{-# LANGUAGE DeriveAnyClass            #-}+{-# LANGUAGE FunctionalDependencies    #-}++module Data.Container.Weak where++import Prelude hiding ((.))++import Control.Lens+import Control.Lens.Utils+import Control.Monad+import Control.Monad.Fix+import Control.Monad.IO.Class+import Data.Container.Class+import Data.Container.List+import Data.Container.Proxy+import Data.Default+import Data.Functor.Utils+import Data.Layer++import Data.Container.Immersed (withDivedM)+import Data.Container.Opts     (Query(..), ModsOf, ParamsOf)+import System.IO.Unsafe        (unsafePerformIO)++import qualified Data.Container.Opts as M+import qualified System.Mem.Weak     as Mem++------------------+-- === Weak === --+------------------++data Weak f a = Weak !(Maybe f) !a deriving (Functor, Foldable, Traversable, Default, Monoid)+type Weak'  a = Weak (IdxFinalizer (Index a)) a++-- Instances++type instance Index     (Weak f a) = Index (Container a)+type instance Item      (Weak f a) = WeakData (Item (Container a))+type instance Container (Weak f a) = Weak f a+type instance DataStore (Weak f a) = Container a+type instance Finalizer (Weak f a) = Maybe f++instance      Monad m => IsContainerM  m (Weak f a) where fromContainerM = return+instance      Monad m => HasContainerM m (Weak f a) where viewContainerM = return+                                                          setContainerM  = const . return ++type instance Unlayered (Weak f a) = a+instance      Layered   (Weak f a) where layered = lens (\(Weak _ a) -> a) (\(Weak f _) a -> Weak f a)++++-- === Finalizers ===++newtype IdxFinalizer idx = IdxFinalizer (idx -> IO ())++type family Finalizer  a+class       HasFinalizer a where finalizer :: Lens' a (Finalizer a)++class       HasFinalizerM a m f | a -> f where viewFinalizerM :: a -> m (Maybe f)+                                               setFinalizerM  :: Maybe f -> a -> m a++-- Basic finalizer instances ++instance {-# OVERLAPPABLE #-} ( Finalizer (Unlayered a) ~ Finalizer a+                              , HasFinalizer (Unlayered a)+                              , Layered a)+                           => HasFinalizer a          where finalizer = layered . finalizer  +instance {-# OVERLAPPABLE #-} HasFinalizer (Weak f a) where finalizer = lens (\(Weak f _) -> f) (\(Weak _ a) f -> Weak f a)+++++instance {-# OVERLAPPABLE #-} Monad m => HasFinalizerM (Weak f a) m f where viewFinalizerM   (Weak f _) = return f+                                                                            setFinalizerM  f (Weak _ a) = return $ Weak f a++instance {-# OVERLAPPABLE #-} ( Monad m+                              , HasFinalizerM (Container (Unlayered a)) m f+                              , HasContainerM m (Unlayered a)+                              , LayeredM m a+                              )+      => HasFinalizerM a m f where viewFinalizerM    = viewLayeredM >=> viewContainerM >=> viewFinalizerM+                                   setFinalizerM v a = flip withDivedM a $ setFinalizerM v+++-- Instances++instance Rewrapped (IdxFinalizer idx) (IdxFinalizer idx')+instance Wrapped   (IdxFinalizer idx) where+    type Unwrapped (IdxFinalizer idx) = idx -> IO ()+    _Wrapped' = iso (\(IdxFinalizer f) -> f) IdxFinalizer++++instance Monoid (IdxFinalizer idx) where+    mempty = wrap' . const $ return ()+    mappend (unwrap' -> f) (unwrap' -> f') = wrap' $ \idx -> f idx >> f' idx++-- items++type family WeakData a where WeakData (Mem.Weak a) = a+type WeakItemAxiom t = Item (Container t) ~ Mem.Weak (WeakData (Item (Container t))) +instance (WeakItemAxiom a, IsContainer a, FromList (Container a)) => FromList (Weak f a) where+    fromList = Weak def . fromContainer . fromList . fmap (unsafePerformIO . flip Mem.mkWeakPtr Nothing)+    {-# NOINLINE fromList #-}+++---- utils++mkWeakPtr = liftIO .: Mem.mkWeakPtr++----instance Show (Weak f a) where+----    showsPrec d (Weak f a) = showParen (d > app_prec) $+----            showString "Weak " . showsPrec (succ app_prec) (fmap (unsafePerformIO . Mem.deRefWeak) c)+----         where app_prec = 10+----    {-# NOINLINE showsPrec #-}+++------------------------+-- === Instances === ---+------------------------++-- === Finite ===++-- [+] Measurable+-- [+] MinBounded+-- [+] MaxBounded++type instance ParamsOf MeasurableOp (Weak f a) = ParamsOf MeasurableOp (Container a)+type instance ModsOf   MeasurableOp (Weak f a) = ModsOf   MeasurableOp (Container a)++type instance ParamsOf MinBoundedOp (Weak f a) = ParamsOf MinBoundedOp (Container a)+type instance ModsOf   MinBoundedOp (Weak f a) = ModsOf   MinBoundedOp (Container a)++type instance ParamsOf MaxBoundedOp (Weak f a) = ParamsOf MaxBoundedOp (Container a)+type instance ModsOf   MaxBoundedOp (Weak f a) = ModsOf   MaxBoundedOp (Container a)++instance (MeasurableQM (GetOpts ms) (GetOpts ps) m     a) => MeasurableQM_ ms ps m     (Weak f 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 (Weak f 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 (Weak f a) where maxBoundM_ _ = maxBoundQM (Query :: Query (GetOpts ms) (GetOpts ps)) . unlayer+++-- === Construction ===++-- [+] Singleton+-- [+] Allocable+-- [+] Expandable+-- [+] Growable++type instance ParamsOf SingletonOp  (Weak f a) = ParamsOf SingletonOp  (Container a)+type instance ModsOf   SingletonOp  (Weak f a) = ModsOf   SingletonOp  (Container a)++type instance ParamsOf AllocableOp  (Weak f a) = ParamsOf AllocableOp  (Container a)+type instance ModsOf   AllocableOp  (Weak f a) = ModsOf   AllocableOp  (Container a)++type instance ParamsOf ExpandableOp (Weak f a) = ParamsOf GrowableOp   (Container a)+type instance ModsOf   ExpandableOp (Weak f a) = ModsOf   GrowableOp   (Container a)++type instance ParamsOf GrowableOp   (Weak f a) = ParamsOf GrowableOp   (Container a)+type instance ModsOf   GrowableOp   (Weak f a) = ModsOf   GrowableOp   (Container a)++instance ( MonadIO m+         , SingletonQM  (GetOpts ms) (GetOpts ps) m (Mem.Weak el) a+         , (Result_ SingletonOp (ElInfo (Mem.Weak el) (Container a)) (GetOpts ms) ~ Result_ SingletonOp (ElInfo el (Weak f a)) (GetOpts ms))+         ) => SingletonQM_  ms ps m el (Weak f a) where +    singletonM_ _ el = (fmap2 (Weak def) . singletonQM (Query :: Query (GetOpts ms) (GetOpts ps))) =<< (liftIO . flip mkWeakPtr Nothing) el++instance (AllocableQM  (GetOpts ms) (GetOpts ps) m    a) => AllocableQM_  ms ps m    (Weak f a) where  allocM_     _ = fmap2 (Weak def) . allocQM     (Query :: Query (GetOpts ms) (GetOpts ps))+instance (ExpandableQM (GetOpts ms) (GetOpts ps) m    a) => ExpandableQM_ ms ps m    (Weak f a) where  expandM_    _ = nested layered   $ expandQM    (Query :: Query (GetOpts ms) (GetOpts ps))+instance (GrowableQM   (GetOpts ms) (GetOpts ps) m    a) => GrowableQM_   ms ps m    (Weak f a) where  growM_      _ = nested layered   . growQM      (Query :: Query (GetOpts ms) (GetOpts ps))++++-- === Modification ===+-- [+] Appendable+-- [+] Prependable+-- [+] Addable+-- [ ] Removable+-- [ ] Insertable+-- [+] Freeable++type instance ParamsOf AppendableOp   (Weak f a) = ParamsOf AppendableOp  (Container a)+type instance ModsOf   AppendableOp   (Weak f a) = ModsOf   AppendableOp  (Container a)++type instance ParamsOf PrependableOp  (Weak f a) = ParamsOf PrependableOp (Container a)+type instance ModsOf   PrependableOp  (Weak f a) = ModsOf   PrependableOp (Container a)++type instance ParamsOf AddableOp      (Weak f a) = ParamsOf AddableOp     (Container a)+type instance ModsOf   AddableOp      (Weak f a) = ModsOf   AddableOp     (Container a)++type instance ParamsOf FreeableOp     (Weak f a) = ParamsOf FreeableOp    (Container a)+type instance ModsOf   FreeableOp     (Weak f a) = ModsOf   FreeableOp    (Container a)+++instance (AppendableQM  (M.Ixed ': GetOpts ms) (GetOpts ps) m (Mem.Weak el) a+         , Result_ AppendableOp (ElInfo (Mem.Weak el) (Container a)) (GetOpts ms) ~ Result_ AppendableOp (ElInfo el (Weak (IdxFinalizer idx) a)) (GetOpts ms)+         , idx ~ Index (Container a)+         , MonadIO  m+         , MonadFix m+         ) => AppendableQM_  ms ps m el (Weak (IdxFinalizer idx) a) where +    appendM_  _ el t@(Weak mf a) = mdo+        Res (ix,ds) r <- appendQM (Query :: Query (M.Ixed ': GetOpts ms) (GetOpts ps)) ref a+        ref           <- mkWeakPtr el $ fmap (($ ix) . unwrap) mf+        return $ Res ds (Weak mf r)++instance (PrependableQM  (M.Ixed ': GetOpts ms) (GetOpts ps) m (Mem.Weak el) a+         , Result_ PrependableOp (ElInfo (Mem.Weak el) (Container a)) (GetOpts ms) ~ Result_ PrependableOp (ElInfo el (Weak (IdxFinalizer idx) a)) (GetOpts ms)+         , idx ~ Index (Container a)+         , MonadIO  m+         , MonadFix m+         ) => PrependableQM_  ms ps m el (Weak (IdxFinalizer idx) a) where +    prependM_  _ el t@(Weak mf a) = mdo+        Res (ix,ds) r <- prependQM (Query :: Query (M.Ixed ': GetOpts ms) (GetOpts ps)) ref a+        ref           <- mkWeakPtr el $ fmap (($ ix) . unwrap) mf+        return $ Res ds (Weak mf r)++instance (AddableQM  (M.Ixed ': GetOpts ms) (GetOpts ps) m (Mem.Weak el) a+         , Result_ AddableOp (ElInfo (Mem.Weak el) (Container a)) (GetOpts ms) ~ Result_ AddableOp (ElInfo el (Weak (IdxFinalizer idx) a)) (GetOpts ms)+         , idx ~ Index (Container a)+         , MonadIO  m+         , MonadFix m+         ) => AddableQM_  ms ps m el (Weak (IdxFinalizer idx) a) where +    addM_  _ el t@(Weak mf a) = mdo+        Res (ix,ds) r <- addQM (Query :: Query (M.Ixed ': GetOpts ms) (GetOpts ps)) ref a+        ref           <- mkWeakPtr el $ fmap (($ ix) . unwrap) mf+        return $ Res ds (Weak mf r)++instance (FreeableQM (GetOpts ms) (GetOpts ps) m idx a, idx ~ idx') => FreeableQM_  ms ps m idx (Weak (IdxFinalizer idx) a) where freeM_ _ = nested layered . freeQM (Query :: Query (GetOpts ms) (GetOpts ps))++        --flip (nested layered) t $ appendQM (Query :: Query (GetOpts ms) (GetOpts ps)) =<< liftIO (flip Mem.mkWeakPtr f el)+--instance (PrependableQM (GetOpts ms) (GetOpts ps) m el a)           => PrependableQM_ ms ps m el   (Weak idx  a) where prependM_ _      = nested layered . prependQM (Query :: Query (GetOpts ms) (GetOpts ps))+--instance (InsertableM m idx el a, ExpandableM m (Weak f a))   => AddableQM_    '[] ps m el   (Weak idx  a) where addM_     q el t = case view indexes t of+--                                                                                                                               (x:xs) -> fmap2 (Weak xs) $ insertM' x el $ unlayer t+--                                                                                                                               []     -> addM_ q el =<< expandM t+--instance (FreeableQM (GetOpts ms) (GetOpts ps) m idx a, idx ~ idx') => FreeableQM_    ms ps m idx  (Weak idx' a) where freeM_ _ idx     = fmap2 (indexes %~ (idx:)) . nested layered (freeQM (Query :: Query (GetOpts ms) (GetOpts ps)) idx)++--instance ( GrowableQM (M.Ixed ': GetOpts ms) (GetOpts ps) m a, idx ~ Index (Container a)) => GrowableQM_ ms ps m (Reusable idx a) where +--    growM_ _ i (Reusable ixs a) = do Res (ixs',ds) r <- growQM (Query :: Query (M.Ixed ': GetOpts ms) (GetOpts ps)) i a+--                                     return $ Res ds $ Reusable (ixs <> ixs') r+++------------------------+-- === Instances === ---+------------------------++-- === Finite ===++-- [+] Measurable+-- [+] MinBounded+-- [+] MaxBounded++--type instance ParamsOf MeasurableOp (Weak f a) = ParamsOf MeasurableOp (Container a)+--type instance ModsOf   MeasurableOp (Weak f a) = ModsOf   MeasurableOp (Container a)++--type instance ParamsOf MinBoundedOp (Weak f a) = ParamsOf MinBoundedOp (Container a)+--type instance ModsOf   MinBoundedOp (Weak f a) = ModsOf   MinBoundedOp (Container a)++--type instance ParamsOf MaxBoundedOp (Weak f a) = ParamsOf MaxBoundedOp (Container a)+--type instance ModsOf   MaxBoundedOp (Weak f a) = ModsOf   MaxBoundedOp (Container a)++--instance (MeasurableQM (GetOpts ms) (GetOpts ps) m     a)             => MeasurableQM_ ms ps m     (Weak idx  a) where sizeM_     _ = sizeQM     (Query :: Query (GetOpts ms) (GetOpts ps)) . unlayer+--instance (MinBoundedQM (GetOpts ms) (GetOpts ps) m idx a, idx ~ idx') => MinBoundedQM_ ms ps m idx (Weak idx' a) where minBoundM_ _ = minBoundQM (Query :: Query (GetOpts ms) (GetOpts ps)) . unlayer+--instance (MaxBoundedQM (GetOpts ms) (GetOpts ps) m idx a, idx ~ idx') => MaxBoundedQM_ ms ps m idx (Weak idx' a) where maxBoundM_ _ = maxBoundQM (Query :: Query (GetOpts ms) (GetOpts ps)) . unlayer+++++------ === Finite ===++------ [+] Measurable+------ [+] MinBounded+------ [+] MaxBounded+++--type instance ModsOf MeasurableQSM (Weak c a) = ModsOf MeasurableQSM (WeakData c a)+----type instance ModsOf MinIndexedQSM (Weak c a) = ModsOf MinIndexedQSM a+----type instance ModsOf MaxIndexedQSM (Weak c a) = ModsOf MaxIndexedQSM a++--instance MeasurableQM q m (WeakData c a) => MeasurableQSM (Weak c a) m q s where sizeQSM     _ _ = queried (Proxy :: Proxy q) sizeM' . unlayer+----instance MinIndexedQM q m a => MinIndexedQSM (Weak c a) m q s where minIndexQSM _ _ = queried (Proxy :: Proxy q) minIndexM' . unwrap+----instance MaxIndexedQM q m a => MaxIndexedQSM (Weak c a) m q s where maxIndexQSM _ _ = queried (Proxy :: Proxy q) maxIndexM' . unwrap++--weaked = lens (\(Weak mf a) -> a) (\(Weak mf _) a -> Weak mf a)++--nestedWeaked = nested weaked++------ === Construction ===++------ [+] Singleton+------ [ ] Allocable+------ [+] Expandable+------ [+] Growable++--type instance ModsOf SingletonQSM  (Weak c a) = ModsOf SingletonQSM  (WeakData c a)+--type instance ModsOf AllocableQSM  (Weak c a) = ModsOf AllocableQSM  (WeakData c a)+--type instance ModsOf ExpandableQSM (Weak c a) = ModsOf ExpandableQSM (WeakData c a)+--type instance ModsOf GrowableQSM   (Weak c a) = ModsOf GrowableQSM   (WeakData c a)++--instance (MonadIO m, SingletonQM (Mem.Weak el) q m t, t ~ WeakData c a, cls ~ SingletonQSM,+--    EqInfoQueries (SingletonInfo el (DataStore t)) (SingletonInfo (Mem.Weak el) (DataStore t)) (Mods.FilterMutable q) ) => SingletonQSM el (Weak c a) m q s where+--    singletonQSM _ _ el = do+--        ptr <- liftIO $ Mem.mkWeakPtr el Nothing+--        (fmap . fmap) (Weak Nothing) $ queried (Proxy :: Proxy q) singletonM' ptr++--instance (AllocableQM  q m (WeakData c a)) => AllocableQSM  (Weak c a) m q s where allocQSM  _ _  = (fmap . fmap) (Weak Nothing) . queried (Proxy :: Proxy q) allocM'+--instance (ExpandableQM q m (WeakData c a)) => ExpandableQSM (Weak c a) m q s where expandQSM _ _  = nestedWeaked  $ queried (Proxy :: Proxy q) expandM'+--instance (GrowableQM   q m (WeakData c a)) => GrowableQSM   (Weak c a) m q s where growQSM   _ _  = nestedWeaked  . queried (Proxy :: Proxy q) growM'++++------ === Modification ===++------ [+] Appendable+------ [ ] Prependable+------ [ ] Addable+------ [ ] Removable+------ [+] Insertable++--type instance ModsOf AppendableQSM (Weak c a) = ModsOf AppendableQSM (WeakData c a)+--type instance ModsOf FreeableQSM   (Weak c a) = ModsOf FreeableQSM   (WeakData c a)+--type instance ModsOf InsertableQSM (Weak c a) = ModsOf InsertableQSM (WeakData c a)+++--instance (MonadIO m, MonadFix m, AppendableQM wel (Mods.Ixed ': q) m t+--         , t    ~ WeakData c a+--         , wel  ~ Mem.Weak el+--         , ds   ~ DataStore t+--         , info ~ AppendableInfo wel ds+--         , idx  ~ ModData Mods.Ixed info+--         , idx  ~ HomoIndex c+--         , EqInfoQueries (AppendableInfo el ds) info (Mods.FilterMutable q)+--         ) => AppendableQSM el (Weak c a) m q s where+--    appendQSM _ _ el (Weak f c) = mdo+--        ptr <- liftIO $ Mem.mkWeakPtr el (($ ixs) <$> f)+--        (ixs, r) <- splitResData <$> nestedWeaked ( (ixed . queried (Proxy :: Proxy q)) appendM' ptr) (Weak f c)+--        return r++--instance (MonadIO m, MonadFix m, InsertableQM idx wel (Mods.Ixed ': q) m t+--         , t    ~ WeakData c a+--         , wel  ~ Mem.Weak el+--         , ds   ~ DataStore t+--         , info ~ InsertableInfo idx wel ds+--         , idx  ~ ModData Mods.Ixed info+--         , idx  ~ HomoIndex c+--         , EqInfoQueries (InsertableInfo idx el ds) info (Mods.FilterMutable q)+--         ) => InsertableQSM idx el (Weak c a) m q s where+--    insertQSM _ _ idx el (Weak f c) = mdo+--        ptr <- liftIO $ Mem.mkWeakPtr el (($ ixs) <$> f)+--        (ixs, r) <- splitResData <$> nestedWeaked ( (ixed . queried (Proxy :: Proxy q)) insertM' idx ptr) (Weak f c)+--        return r++--instance FreeableQM idx q m (WeakData c a) => FreeableQSM idx (Weak c a) m q s where freeQSM   _ _  = nestedWeaked . queried (Proxy :: Proxy q) freeM'+++-------- === Indexing ===++------ [+] Indexable+------ [ ] TracksElems+------ [ ] TracksIxes+------ [+] TracksFreeIxes+------ [ ] TracksUsedIxes+++----type instance ModsOf IndexableQSM      (Weak c a) = ModsOf IndexableQSM a+----type instance ModsOf TracksFreeIxesQSM (Weak c a) = '[]+--type instance ModsOf TracksIxesQSM  (Weak c a) = ModsOf TracksIxesQSM  (WeakData c a)+--type instance ModsOf TracksElemsQSM (Weak c a) = ModsOf TracksElemsQSM (WeakData c a)++--instance ( t    ~ WeakData c a+--         , ds   ~ DataStore t+--         , wel  ~ Mem.Weak el+--         , info ~ TracksElemsInfo wel ds+--         , TracksElemsQM (Mem.Weak el) q m (WeakData c a)+--         , EqInfoQueries (TracksElemsInfo el ds) info (Mods.FilterMutable q)+--         ) => TracksElemsQSM   el (Weak c a) m q s where elemsQSM _ _   = (fmap . fmap) (catMaybes . fmap (unsafePerformIO . Mem.deRefWeak)) . queried (Proxy :: Proxy q) elemsM' . unlayer+++--instance   TracksIxesQM  idx q m (WeakData c a) => TracksIxesQSM  idx (Weak c a) m q s where ixesQSM  _ _     = queried (Proxy :: Proxy q) ixesM'      . unlayer+++----type instance ModsOf TracksElemsQSM (HWeak l a) = ModsOf TracksElemsQSM a++----instance   IndexableQM   idx el q m a => IndexableQSM   idx el (HResizable l a) m q s where indexQSM _ _ idx = queried (Proxy :: Proxy q) indexM' idx . unlayer+----instance   TracksIxesQM  idx    q m a => TracksIxesQSM  idx    (HResizable l a) m q s where ixesQSM  _ _     = queried (Proxy :: Proxy q) ixesM'      . unlayer

@@ -1,20 +0,0 @@-module Data.Item where--import Prelude--import qualified Data.Map        as MapLazy-import qualified Data.Map.Strict as MapStrict-import qualified Data.Text       as Strict-import qualified Data.Text.Lazy  as Lazy--import Data.Set (Set)---type family Item a--type instance Item [a] = a-type instance Item (MapLazy.Map   k v) = (k,v)-type instance Item (MapStrict.Map k v) = (k,v)-type instance Item Strict.Text         = Char-type instance Item Lazy.Text           = Char-type instance Item (Set a)             = a

@@ -1,28 +0,0 @@-{-# LANGUAGE UndecidableInstances #-}--module Data.List.Class where--import Data.Item-import Prelude-import Data.Convert-import Control.Lens--type ToList    a = Convertible  a [Item a]-type ToList'   a = Convertible' a [Item a]-type FromList  a = Convertible  [Item a] a-type FromList' a = Convertible' [Item a] a-type IsList    a = (ToList  a, FromList  a)-type IsList'   a = (ToList' a, FromList' a)--toList    :: ToList    a => a -> [Item a]-toList'   :: ToList'   a => a -> [Item a]-fromList  :: FromList  a => [Item a] -> a-fromList' :: FromList' a => [Item a] -> a-asList    :: IsList    a => Iso' a [Item a]-asList'   :: IsList'   a => Iso' a [Item a]-toList    = convert               ; {-# INLINE toList    #-}-toList'   = convert'              ; {-# INLINE toList'   #-}-fromList  = convert               ; {-# INLINE fromList  #-}-fromList' = convert'              ; {-# INLINE fromList' #-}-asList    = iso toList  fromList  ; {-# INLINE asList    #-}-asList'   = iso toList' fromList' ; {-# INLINE asList'   #-}

@@ -1,53 +0,0 @@-module Data.Sequence.Class where---import Prelude hiding (dropWhile)--import Data.Item--import           Data.Char      (isSpace)-import qualified Data.List      as List-import           Data.Text      (Text)-import qualified Data.Text      as Text-import qualified Data.Text.Lazy as LazyText---type LazyText = LazyText.Text---------------------------- === Sequence === ----------------------------- === Definition === ----class Sequence a where-    dropWhile :: (Item a -> Bool) -> a -> a--class Sequence a => FiniteSequence a where-    dropWhileEnd :: (Item a -> Bool) -> a -> a-    dropAround   :: (Item a -> Bool) -> a -> a--    dropAround f = dropWhileEnd f . dropWhile f----- === Utils === ----strip, stripStart, stripEnd :: (FiniteSequence a, Item a ~ Char) => a -> a-strip      = dropAround   isSpace-stripStart = dropWhile    isSpace-stripEnd   = dropWhileEnd isSpace----- === Default instances === ----instance Sequence       [a] where dropWhile    = List.dropWhile-instance FiniteSequence [a] where dropWhileEnd = List.dropWhileEnd--instance Sequence       Text where dropWhile    = Text.dropWhile-instance FiniteSequence Text where dropWhileEnd = Text.dropWhileEnd-                                   dropAround   = Text.dropAround--instance Sequence       LazyText where dropWhile    = LazyText.dropWhile-instance FiniteSequence LazyText where dropWhileEnd = LazyText.dropWhileEnd-                                       dropAround   = LazyText.dropAround

@@ -1,34 +0,0 @@-module Data.Set.Mutable.Class -  (module Data.Set.Mutable.Class, module X) where--import Prelude-import Data.Item as X---class Monad m => Set m s where-    new        :: m s-    singleton  :: Item s -> m s-    insert     :: s ->  Item s  -> m () -    insertMany :: s -> [Item s] -> m ()-    delete     :: s ->  Item s  -> m ()-    member     :: s ->  Item s  -> m Bool-    size       :: s -> m Int-    null       :: s -> m Bool-    toList     :: s -> m [Item s]-    fromList   :: [Item s] -> m s--    singleton el = do-        s <- new-        insert s el-        pure s-    {-# INLINE singleton #-}--    insertMany s es = mapM_ (insert s) es ; {-# INLINE insertMany #-}--    null = fmap (== 0) . size ; {-# INLINE null #-} --    fromList es = do-        s <- new-        insertMany s es-        pure s-    {-# INLINE fromList #-}