{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# LANGUAGE Safe, DefaultSignatures, ConstraintKinds #-}

{- |
    Module      :  SDP.Indexed
    Copyright   :  (c) Andrey Mulik 2019
    License     :  BSD-style
    Maintainer  :  work.a.mulik@gmail.com
    Portability :  non-portable (GHC extensions)
  
  "SDP.Indexed" provides 'Indexed' and 'Freeze' classes.
-}
module SDP.Indexed
(
  -- * Exports
  module SDP.Linear,
  module SDP.Map,
  
  -- * Indexed
  Indexed (..), Indexed1, Indexed2, binaryContain,
  
  -- * Freeze
  Freeze (..), Freeze1
)
where

import Prelude ()
import SDP.SafePrelude
import SDP.Linear
import SDP.Map

import Control.Exception.SDP

default ()

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

-- | 'Indexed' is class of ordered associative arrays with static bounds.
class (Linear v e, Bordered v i, Map v i e) => Indexed v i e | v -> i, v -> e
  where
    {-# MINIMAL fromIndexed #-}
    
    {- |
      @assoc bnds ascs@ create new structure from list of associations, without
      default element. Note that @bnds@ is @ascs@ bounds and may not match with
      the result bounds (not always possible).
    -}
    assoc :: (i, i) -> [(i, e)] -> v
    assoc =  ((i, i) -> e -> [(i, e)] -> v) -> e -> (i, i) -> [(i, e)] -> v
forall a b c. (a -> b -> c) -> b -> a -> c
flip (i, i) -> e -> [(i, e)] -> v
forall v i e. Indexed v i e => (i, i) -> e -> [(i, e)] -> v
assoc' (String -> e
forall a. String -> a
undEx String
"assoc {default}")
    
    {- |
      @assoc' bnds def ascs@ creates new structure from list of associations
      with default element. Note that @bnds@ is @ascs@ bounds and may not match
      with the result bounds (not always possible).
    -}
    assoc' :: (i, i) -> e -> [(i, e)] -> v
    assoc' (i, i)
bnds e
defvalue = e -> [(i, e)] -> v
forall map key e. Map map key e => e -> [(key, e)] -> map
toMap' e
defvalue ([(i, e)] -> v) -> ([(i, e)] -> [(i, e)]) -> [(i, e)] -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((i, e) -> Bool) -> [(i, e)] -> [(i, e)]
forall l e. Linear l e => (e -> Bool) -> l -> l
filter ((i, i) -> i -> Bool
forall i. Index i => (i, i) -> i -> Bool
inRange (i, i)
bnds (i -> Bool) -> ((i, e) -> i) -> (i, e) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i, e) -> i
forall a b. (a, b) -> a
fst)
    
    -- | 'fromIndexed' converts this indexed structure to another one.
    fromIndexed :: (Indexed m j e) => m -> v
    
    -- | Safe index-based immutable writer.
    {-# INLINE write' #-}
    write' :: v -> i -> e -> v
    write' v
es = v -> Int -> e -> v
forall l e. Linear l e => l -> Int -> e -> l
write v
es (Int -> e -> v) -> (i -> Int) -> i -> e -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> i -> Int
forall b i. Bordered b i => b -> i -> Int
offsetOf v
es
    
    {- |
      @'accum' f es ies@ create a new structure from @es@ elements selectively
      updated by function @f@ and @ies@ associations list.
    -}
    accum :: (e -> e' -> e) -> v -> [(i, e')] -> v
    accum e -> e' -> e
f v
es [(i, e')]
ies = v -> (i, i)
forall b i. Bordered b i => b -> (i, i)
bounds v
es (i, i) -> [(i, e)] -> v
forall v i e. Indexed v i e => (i, i) -> [(i, e)] -> v
`assoc` [ (i
i, v
esv -> i -> e
forall map key e. Map map key e => map -> key -> e
!i
i e -> e' -> e
`f` e'
e') | (i
i, e'
e') <- [(i, e')]
ies ]
    
    -- | 'imap' creates new indexed structure from old with reshaping.
    imap :: (Map m j e) => (i, i) -> m -> (i -> j) -> v
    imap (i, i)
bnds m
es i -> j
f = (i, i) -> [(i, e)] -> v
forall v i e. Indexed v i e => (i, i) -> [(i, e)] -> v
assoc (i, i)
bnds [ (i
i, m
esm -> j -> e
forall map key e. Map map key e => map -> key -> e
!i -> j
f i
i) | i
i <- (i, i) -> [i]
forall i. Index i => (i, i) -> [i]
range (i, i)
bnds ]
    
    -- | Update element by given function.
    update' :: v -> (e -> e) -> i -> v
    update' v
es e -> e
f i
i = v -> i -> e -> v
forall v i e. Indexed v i e => v -> i -> e -> v
write' v
es i
i (e -> v) -> (e -> e) -> e -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> e
f (e -> v) -> e -> v
forall a b. (a -> b) -> a -> b
$ v
esv -> i -> e
forall map key e. Map map key e => map -> key -> e
!i
i
    
    -- | Create new structure from old by mapping with index.
    updates' :: v -> (i -> e -> e) -> v
    updates' v
es i -> e -> e
f = v -> (i, i)
forall b i. Bordered b i => b -> (i, i)
bounds v
es (i, i) -> [(i, e)] -> v
forall v i e. Indexed v i e => (i, i) -> [(i, e)] -> v
`assoc` [ (i
i, i -> e -> e
f i
i e
e) | (i
i, e
e) <- v -> [(i, e)]
forall map key e. Map map key e => map -> [(key, e)]
assocs v
es ]

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

-- | Service class of mutable to immutable conversions.
class (Monad m) => Freeze m v' v | v' -> m
  where
    {- |
      @freeze@ is a safe way to convert a mutable structure to a immutable.
      @freeze@ should copy the old structure or ensure that it will not be used
      after calling the procedure.
    -}
    freeze :: v' -> m v
    
    {- |
      @unsafeFreeze@ is unsafe version of 'freeze'. @unsafeFreeze@ doesn't
      guarantee that the structure will be copied or locked. It only guarantees
      that if the old structure isn't used, no error will occur.
    -}
    unsafeFreeze :: v' -> m v
    unsafeFreeze =  v' -> m v
forall (m :: * -> *) v' v. Freeze m v' v => v' -> m v
freeze

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

-- | Kind @(* -> *)@ 'Indexed' structure.
type Indexed1 v i e = Indexed (v e) i e

-- | Kind @(* -> * -> *)@ 'Indexed' structure.
type Indexed2 v i e = Indexed (v i e) i e

-- | Kind @(* -> *)@ 'Freeze'.
type Freeze1 m v' v e = Freeze m (v' e) (v e)

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

instance Indexed [e] Int e
  where
    assoc' :: (Int, Int) -> e -> [(Int, e)] -> [e]
assoc' (Int, Int)
bnds e
e = e -> [(Int, e)] -> [e]
forall map key e. Map map key e => e -> [(key, e)] -> map
toMap' e
e ([(Int, e)] -> [e])
-> ([(Int, e)] -> [(Int, e)]) -> [(Int, e)] -> [e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, e) -> Bool) -> [(Int, e)] -> [(Int, e)]
forall l e. Linear l e => (e -> Bool) -> l -> l
filter ((Int, Int) -> Int -> Bool
forall i. Index i => (i, i) -> i -> Bool
inRange (Int, Int)
bnds (Int -> Bool) -> ((Int, e) -> Int) -> (Int, e) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, e) -> Int
forall a b. (a, b) -> a
fst)
    
    fromIndexed :: m -> [e]
fromIndexed m
es = (m
es m -> j -> e
forall map key e. Map map key e => map -> key -> e
!) (j -> e) -> [j] -> [e]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m -> [j]
forall b i. Bordered b i => b -> [i]
indices m
es

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

-- | binaryContain checks that sorted structure has equal element.
binaryContain :: (Linear v e, Bordered v i) => Compare e -> e -> v -> Bool
binaryContain :: Compare e -> e -> v -> Bool
binaryContain Compare e
_ e
_ v
Z  = Bool
False
binaryContain Compare e
f e
e v
es =
  let
    contain :: Int -> Int -> Bool
contain Int
l Int
u = Bool -> Bool
not (Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
u) Bool -> Bool -> Bool
&& case Compare e
f e
e (v
es v -> Int -> e
forall l e. Linear l e => l -> Int -> e
!^ Int
j) of
        Ordering
LT -> Int -> Int -> Bool
contain Int
l (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        Ordering
EQ -> Bool
True
        Ordering
GT -> Int -> Int -> Bool
contain (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
u
      where
        j :: Int
j = Int
u Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l
  in  Compare e
f e
e (v -> e
forall l e. Linear l e => l -> e
head v
es) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT Bool -> Bool -> Bool
&& Compare e
f e
e (v -> e
forall l e. Linear l e => l -> e
last v
es) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT Bool -> Bool -> Bool
&& Int -> Int -> Bool
contain Int
0 (v -> Int
forall b i. Bordered b i => b -> Int
sizeOf v
es Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

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

undEx :: String -> a
undEx :: String -> a
undEx =  IndexException -> a
forall a e. Exception e => e -> a
throw (IndexException -> a) -> (String -> IndexException) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IndexException
UndefinedValue (String -> IndexException)
-> (String -> String) -> String -> IndexException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
"in SDP.Indexed."