Trev.purs

module Data.Trev where

import Data.Monoid
import Data.Function
import Data.Foldable
import Data.String (length)
import Data.String.Unsafe (charCodeAt)

map = (<$>)

instance concatNumber :: Semigroup Number where
  (<>) x y = x * y

instance memptyNumber :: Monoid Number where
  mempty = 1

class (Monoid m) <= Action m a where
  act :: m -> a -> a

instance repeatAction :: Action Number String where
  act 0 _ = ""
  act n s = s <> act (n - 1) s

{-
instance arrayAction :: (Monoid m) => Action m [a] where
  act mempty _ = []
  act m aa = (\x ->  m) <$> aa
-}

newtype Self m = Self m

instance concatSelf :: (Semigroup s) => Semigroup (Self s) where
  (<>) (Self x) (Self y) = Self (x <> y)

instance selfAction :: (Monoid m) => Action m (Self m) where
  act m (Self s) = Self (m <> s)

type HashCode = Number

class (Eq a) <= Hashable a where
  hash :: a -> HashCode

(<##>) :: HashCode -> HashCode -> HashCode
(<##>) h1 h2 = (73 * h1 + 51 * h2) % 65536

hashEqual :: forall a. (Hashable a) => a -> a -> Boolean
hashEqual = (==) `on` hash

instance hashString :: Hashable String where
  hash s = go 0 0
    where
      go :: Number -> HashCode -> HashCode
      go i acc | i >= length s = acc -- Return accumulator when full string is processed
      go i acc = go (i + 1) acc <##> charCodeAt i s

instance hashNumber :: Hashable Number where
  hash = hash <<< show -- Calls Hashable String instance

instance hashBoolean :: Hashable Boolean where
  hash false = 0
  hash true  = 1

instance hashArray :: (Hashable a) => Hashable [a] where
  hash [] = 0
  hash (x:xs) = hash x <##> hash xs

hashHasDupes :: forall a. (Hashable a) => [a] -> Boolean
hashHasDupes [] = false
hashHasDupes (x:xs) = any (hashEqual x) xs || hashHasDupes xs

newtype Uniform = Uniform Number

instance eqUniform :: Eq Uniform where
  (==) (Uniform u1) (Uniform u2) = u1 % 1.0 == u2 % 1.0
  (/=) (Uniform u1) (Uniform u2) = not (u1 == u2)

instance hashUniform :: Hashable Uniform where
  hash (Uniform u1) = hash u1