{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TemplateHaskell #-}


-- | This module contains strict versions of some standard data
-- structures.



module AsyncRattus.Strict
  ( List(..),
    singleton,
    IsList(..),
    init',
    reverse',
    union',
    unionBy',
    nub',
    nubBy',
    filter',
    delete',
    deleteBy',
    (+++),
    listToMaybe',
    map',
    zip',
    zipWith',
    mapMaybe',
    (:*)(..),
    Maybe'(..),
    maybe',
    fromMaybe',
    fst',
    snd',
    curry',
    uncurry'
  )where

import Prelude hiding (map)
import Data.VectorSpace
import AsyncRattus.Derive
import GHC.Exts (IsList(..))

infixr 2 :*
-- | Strict pair type.
data a :* b = !a :* !b

continuous ''(:*)

-- | First projection function.
fst' :: (a :* b) -> a
fst' :: forall a b. (a :* b) -> a
fst' (a
a:*b
_) = a
a

-- | Second projection function.
snd' :: (a :* b) -> b
snd' :: forall a b. (a :* b) -> b
snd' (a
_:*b
b) = b
b

curry' :: ((a :* b) -> c) -> a -> b -> c
curry' :: forall a b c. ((a :* b) -> c) -> a -> b -> c
curry' (a :* b) -> c
f a
x b
y = (a :* b) -> c
f (a
x a -> b -> a :* b
forall a b. a -> b -> a :* b
:* b
y)

uncurry' :: (a -> b -> c) -> (a :* b) -> c
uncurry' :: forall a b c. (a -> b -> c) -> (a :* b) -> c
uncurry' a -> b -> c
f (a
x :* b
y) = a -> b -> c
f a
x b
y


instance Functor ((:*) a) where
  fmap :: forall a b. (a -> b) -> (a :* a) -> a :* b
fmap a -> b
f (a
x:*a
y) = (a
x a -> b -> a :* b
forall a b. a -> b -> a :* b
:* a -> b
f a
y)
  
instance (Show a, Show b) => Show (a:*b) where
  show :: (a :* b) -> String
show (a
a :* b
b) = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" :* " String -> ShowS
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Show a => a -> String
show b
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

instance (Eq a, Eq b) => Eq (a :* b) where
  (a
x1 :* b
y1) == :: (a :* b) -> (a :* b) -> Bool
== (a
x2 :* b
y2) = a
x1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x2 Bool -> Bool -> Bool
&& b
y1 b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
y2


instance (VectorSpace v a, VectorSpace w a, Floating a, Eq a) => VectorSpace (v :* w) a where
  zeroVector :: v :* w
zeroVector = v
forall v a. VectorSpace v a => v
zeroVector v -> w -> v :* w
forall a b. a -> b -> a :* b
:* w
forall v a. VectorSpace v a => v
zeroVector

  a
a *^ :: a -> (v :* w) -> v :* w
*^ (v
x :* w
y) = (a
a a -> v -> v
forall v a. VectorSpace v a => a -> v -> v
*^ v
x) v -> w -> v :* w
forall a b. a -> b -> a :* b
:* (a
a a -> w -> w
forall v a. VectorSpace v a => a -> v -> v
*^ w
y)

  (v
x :* w
y) ^/ :: (v :* w) -> a -> v :* w
^/ a
a = (v
x v -> a -> v
forall v a. VectorSpace v a => v -> a -> v
^/ a
a) v -> w -> v :* w
forall a b. a -> b -> a :* b
:* (w
y w -> a -> w
forall v a. VectorSpace v a => v -> a -> v
^/ a
a)

  negateVector :: (v :* w) -> v :* w
negateVector (v
x :* w
y) = (v -> v
forall v a. VectorSpace v a => v -> v
negateVector v
x) v -> w -> v :* w
forall a b. a -> b -> a :* b
:* (w -> w
forall v a. VectorSpace v a => v -> v
negateVector w
y)

  (v
x1 :* w
y1) ^+^ :: (v :* w) -> (v :* w) -> v :* w
^+^ (v
x2 :* w
y2) = (v
x1 v -> v -> v
forall v a. VectorSpace v a => v -> v -> v
^+^ v
x2) v -> w -> v :* w
forall a b. a -> b -> a :* b
:* (w
y1 w -> w -> w
forall v a. VectorSpace v a => v -> v -> v
^+^ w
y2)

  (v
x1 :* w
y1) ^-^ :: (v :* w) -> (v :* w) -> v :* w
^-^ (v
x2 :* w
y2) = (v
x1 v -> v -> v
forall v a. VectorSpace v a => v -> v -> v
^-^ v
x2) v -> w -> v :* w
forall a b. a -> b -> a :* b
:* (w
y1 w -> w -> w
forall v a. VectorSpace v a => v -> v -> v
^-^ w
y2)

  (v
x1 :* w
y1) dot :: (v :* w) -> (v :* w) -> a
`dot` (v
x2 :* w
y2) = (v
x1 v -> v -> a
forall v a. VectorSpace v a => v -> v -> a
`dot` v
x2) a -> a -> a
forall a. Num a => a -> a -> a
+ (w
y1 w -> w -> a
forall v a. VectorSpace v a => v -> v -> a
`dot` w
y2)

infixr 8 :!

-- | Strict list type.
data List a = Nil | !a :! !(List a)

continuous ''List


singleton :: a -> List a
singleton :: forall a. a -> List a
singleton a
x = a
x a -> List a -> List a
forall a. a -> List a -> List a
:! List a
forall a. List a
Nil

instance Traversable List where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> List a -> f (List b)
traverse a -> f b
_ List a
Nil = List b -> f (List b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure List b
forall a. List a
Nil
  traverse a -> f b
f (a
x :! List a
xs) = b -> List b -> List b
forall a. a -> List a -> List a
(:!) (b -> List b -> List b) -> f b -> f (List b -> List b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b
f a
x) f (List b -> List b) -> f (List b) -> f (List b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a -> f b) -> List a -> f (List b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> List a -> f (List b)
traverse a -> f b
f List a
xs)

instance IsList (List a) where
  type Item (List a) = a

  fromList :: [Item (List a)] -> List a
fromList [] = List a
forall a. List a
Nil
  fromList (Item (List a)
x : [Item (List a)]
xs) = a
Item (List a)
x a -> List a -> List a
forall a. a -> List a -> List a
:! [Item (List a)] -> List a
forall l. IsList l => [Item l] -> l
fromList [Item (List a)]
xs

  toList :: List a -> [Item (List a)]
toList List a
Nil = []
  toList (a
x :! List a
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: List a -> [Item (List a)]
forall l. IsList l => l -> [Item l]
toList List a
xs


-- | Remove the last element from a list if there is one, otherwise
-- return 'Nil'.
init' :: List a -> List a
init' :: forall a. List a -> List a
init' List a
Nil = List a
forall a. List a
Nil
init' (a
_ :! List a
Nil) = List a
forall a. List a
Nil
init' (a
x :! List a
xs) = a
x a -> List a -> List a
forall a. a -> List a -> List a
:! List a -> List a
forall a. List a -> List a
init' List a
xs

-- | Reverse a list.
reverse' :: List a -> List a
reverse' :: forall a. List a -> List a
reverse' List a
l =  List a -> List a -> List a
forall {a}. List a -> List a -> List a
rev List a
l List a
forall a. List a
Nil
  where
    rev :: List a -> List a -> List a
rev List a
Nil     List a
a = List a
a
    rev (a
x:!List a
xs) List a
a = List a -> List a -> List a
rev List a
xs (a
xa -> List a -> List a
forall a. a -> List a -> List a
:!List a
a)
    
-- | Returns @'Nothing''@ on an empty list or @'Just'' a@ where @a@ is the
-- first element of the list.
listToMaybe' :: List a -> Maybe' a
listToMaybe' :: forall a. List a -> Maybe' a
listToMaybe' List a
Nil = Maybe' a
forall a. Maybe' a
Nothing'
listToMaybe' (a
x :! List a
_) = a -> Maybe' a
forall a. a -> Maybe' a
Just' a
x

-- | Append two lists.
(+++) :: List a -> List a -> List a
+++ :: forall {a}. List a -> List a -> List a
(+++) List a
Nil     List a
ys = List a
ys
(+++) (a
x:!List a
xs) List a
ys = a
x a -> List a -> List a
forall a. a -> List a -> List a
:! List a
xs List a -> List a -> List a
forall {a}. List a -> List a -> List a
+++ List a
ys


map' :: (a -> b) -> List a -> List b
map' :: forall a b. (a -> b) -> List a -> List b
map' a -> b
_ List a
Nil = List b
forall a. List a
Nil
map' a -> b
f (a
x :! List a
xs) = a -> b
f a
x b -> List b -> List b
forall a. a -> List a -> List a
:! (a -> b) -> List a -> List b
forall a b. (a -> b) -> List a -> List b
map' a -> b
f List a
xs

zip' :: List a -> List b -> List (a :* b)
zip' :: forall a b. List a -> List b -> List (a :* b)
zip' List a
Nil List b
_ = List (a :* b)
forall a. List a
Nil
zip' List a
_ List b
Nil = List (a :* b)
forall a. List a
Nil
zip' (a
x :! List a
xs) (b
y :! List b
ys) = (a
x a -> b -> a :* b
forall a b. a -> b -> a :* b
:* b
y) (a :* b) -> List (a :* b) -> List (a :* b)
forall a. a -> List a -> List a
:! List a -> List b -> List (a :* b)
forall a b. List a -> List b -> List (a :* b)
zip' List a
xs List b
ys

zipWith' :: (a -> b -> c) -> List a -> List b -> List c
zipWith' :: forall a b c. (a -> b -> c) -> List a -> List b -> List c
zipWith' a -> b -> c
_ List a
Nil List b
_ = List c
forall a. List a
Nil
zipWith' a -> b -> c
_ List a
_ List b
Nil = List c
forall a. List a
Nil
zipWith' a -> b -> c
f (a
x :! List a
xs) (b
y :! List b
ys) = a -> b -> c
f a
x b
y c -> List c -> List c
forall a. a -> List a -> List a
:! (a -> b -> c) -> List a -> List b -> List c
forall a b c. (a -> b -> c) -> List a -> List b -> List c
zipWith' a -> b -> c
f List a
xs List b
ys


-- | A version of 'map' which can throw out elements.  In particular,
-- the function argument returns something of type @'Maybe'' b@.  If
-- this is 'Nothing'', no element is added on to the result list.  If
-- it is @'Just'' b@, then @b@ is included in the result list.
mapMaybe'          :: (a -> Maybe' b) -> List a -> List b
mapMaybe' :: forall a b. (a -> Maybe' b) -> List a -> List b
mapMaybe' a -> Maybe' b
_ List a
Nil     = List b
forall a. List a
Nil
mapMaybe' a -> Maybe' b
f (a
x:!List a
xs) =
 let rs :: List b
rs = (a -> Maybe' b) -> List a -> List b
forall a b. (a -> Maybe' b) -> List a -> List b
mapMaybe' a -> Maybe' b
f List a
xs in
 case a -> Maybe' b
f a
x of
  Maybe' b
Nothing' -> List b
rs
  Just' b
r  -> b
rb -> List b -> List b
forall a. a -> List a -> List a
:!List b
rs

union' :: (Eq a) => List a -> List a -> List a
union' :: forall a. Eq a => List a -> List a -> List a
union' = (a -> a -> Bool) -> List a -> List a -> List a
forall a. (a -> a -> Bool) -> List a -> List a -> List a
unionBy' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

unionBy' :: (a -> a -> Bool) -> List a -> List a -> List a
unionBy' :: forall a. (a -> a -> Bool) -> List a -> List a -> List a
unionBy' a -> a -> Bool
eq List a
xs List a
ys =  List a
xs List a -> List a -> List a
forall {a}. List a -> List a -> List a
+++ (List a -> a -> List a) -> List a -> List a -> List a
forall b a. (b -> a -> b) -> b -> List a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((a -> List a -> List a) -> List a -> a -> List a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a -> a -> Bool) -> a -> List a -> List a
forall a. (a -> a -> Bool) -> a -> List a -> List a
deleteBy' a -> a -> Bool
eq)) ((a -> a -> Bool) -> List a -> List a
forall a. (a -> a -> Bool) -> List a -> List a
nubBy' a -> a -> Bool
eq List a
ys) List a
xs

delete' :: (Eq a) => a -> List a -> List a
delete' :: forall a. Eq a => a -> List a -> List a
delete' =  (a -> a -> Bool) -> a -> List a -> List a
forall a. (a -> a -> Bool) -> a -> List a -> List a
deleteBy' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

deleteBy' :: (a -> a -> Bool) -> a -> List a -> List a
deleteBy' :: forall a. (a -> a -> Bool) -> a -> List a -> List a
deleteBy' a -> a -> Bool
_  a
_ List a
Nil        = List a
forall a. List a
Nil
deleteBy' a -> a -> Bool
eq a
x (a
y :! List a
ys)    = if a
x a -> a -> Bool
`eq` a
y then List a
ys else a
y a -> List a -> List a
forall a. a -> List a -> List a
:! (a -> a -> Bool) -> a -> List a -> List a
forall a. (a -> a -> Bool) -> a -> List a -> List a
deleteBy' a -> a -> Bool
eq a
x List a
ys


nub' :: (Eq a) => List a -> List a
nub' :: forall a. Eq a => List a -> List a
nub' =  (a -> a -> Bool) -> List a -> List a
forall a. (a -> a -> Bool) -> List a -> List a
nubBy' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

nubBy' :: (a -> a -> Bool) -> List a -> List a
nubBy' :: forall a. (a -> a -> Bool) -> List a -> List a
nubBy' a -> a -> Bool
_ List a
Nil             =  List a
forall a. List a
Nil
nubBy' a -> a -> Bool
eq (a
x:!List a
xs)         =  a
x a -> List a -> List a
forall a. a -> List a -> List a
:! (a -> a -> Bool) -> List a -> List a
forall a. (a -> a -> Bool) -> List a -> List a
nubBy' a -> a -> Bool
eq ((a -> Bool) -> List a -> List a
forall a. (a -> Bool) -> List a -> List a
filter' (\ a
y -> Bool -> Bool
not (a -> a -> Bool
eq a
x a
y)) List a
xs)

filter' :: (a -> Bool) -> List a -> List a
filter' :: forall a. (a -> Bool) -> List a -> List a
filter' a -> Bool
_ List a
Nil    = List a
forall a. List a
Nil
filter' a -> Bool
pred (a
x :! List a
xs)
  | a -> Bool
pred a
x         = a
x a -> List a -> List a
forall a. a -> List a -> List a
:! (a -> Bool) -> List a -> List a
forall a. (a -> Bool) -> List a -> List a
filter' a -> Bool
pred List a
xs
  | Bool
otherwise      = (a -> Bool) -> List a -> List a
forall a. (a -> Bool) -> List a -> List a
filter' a -> Bool
pred List a
xs

instance Foldable List where
  
  foldMap :: forall m a. Monoid m => (a -> m) -> List a -> m
foldMap a -> m
f = List a -> m
run where
    run :: List a -> m
run List a
Nil = m
forall a. Monoid a => a
mempty
    run (a
x :! List a
xs) = a -> m
f a
x m -> m -> m
forall a. Semigroup a => a -> a -> a
<> List a -> m
run List a
xs
  foldr :: forall a b. (a -> b -> b) -> b -> List a -> b
foldr a -> b -> b
f = b -> List a -> b
run where
    run :: b -> List a -> b
run b
b List a
Nil = b
b
    run b
b (a
a :! List a
as) = (b -> List a -> b
run (b -> List a -> b) -> b -> List a -> b
forall a b. (a -> b) -> a -> b
$! (a -> b -> b
f a
a b
b)) List a
as
  foldl :: forall b a. (b -> a -> b) -> b -> List a -> b
foldl b -> a -> b
f = b -> List a -> b
run where
    run :: b -> List a -> b
run b
a List a
Nil = b
a
    run b
a (a
b :! List a
bs) = (b -> List a -> b
run (b -> List a -> b) -> b -> List a -> b
forall a b. (a -> b) -> a -> b
$! (b -> a -> b
f b
a a
b)) List a
bs
  elem :: forall a. Eq a => a -> List a -> Bool
elem a
a = List a -> Bool
run where
    run :: List a -> Bool
run List a
Nil = Bool
False
    run (a
x :! List a
xs)
      | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x = Bool
True
      | Bool
otherwise = List a -> Bool
run List a
xs
    
  
instance Functor List where
  fmap :: forall a b. (a -> b) -> List a -> List b
fmap = (a -> b) -> List a -> List b
forall a b. (a -> b) -> List a -> List b
map'

instance Eq a => Eq (List a) where
  List a
Nil == :: List a -> List a -> Bool
== List a
Nil = Bool
True
  List a
Nil == List a
_ = Bool
False
  List a
_ == List a
Nil = Bool
False
  (a
x :! List a
xs) == (a
y :! List a
ys) = if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y then List a
xs List a -> List a -> Bool
forall a. Eq a => a -> a -> Bool
== List a
ys else Bool
False

instance Show a => Show (List a) where
  show :: List a -> String
show List a
Nil = String
"Nil"
  show (a
x :! List a
xs) = a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" :! " String -> ShowS
forall a. [a] -> [a] -> [a]
++ List a -> String
forall a. Show a => a -> String
show List a
xs

-- | Strict variant of 'Maybe'.
data Maybe' a = Just' !a | Nothing'

continuous ''Maybe'

instance Eq a => Eq (Maybe' a) where
  Maybe' a
Nothing' == :: Maybe' a -> Maybe' a -> Bool
== Maybe' a
Nothing' = Bool
True
  Just' a
x == Just' a
y = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y
  Maybe' a
_ == Maybe' a
_ = Bool
False

instance Show a => Show (Maybe' a) where
  show :: Maybe' a -> String
show Maybe' a
Nothing' = String
"Nothing'"
  show (Just' a
x) = String
"Just' " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x

-- | takes a default value, a function, and a 'Maybe'' value.  If the
-- 'Maybe'' value is 'Nothing'', the function returns the default
-- value.  Otherwise, it applies the function to the value inside the
-- 'Just'' and returns the result.
maybe' :: b -> (a -> b) -> Maybe' a -> b
maybe' :: forall b a. b -> (a -> b) -> Maybe' a -> b
maybe' b
n a -> b
_ Maybe' a
Nothing'  = b
n
maybe' b
_ a -> b
f (Just' a
x) = a -> b
f a
x

fromMaybe' :: a -> Maybe' a -> a
fromMaybe' :: forall a. a -> Maybe' a -> a
fromMaybe' a
_ (Just' a
x) = a
x
fromMaybe' a
d Maybe' a
Nothing' = a
d