# LANGUAGE NoImplicitPrelude #
# LANGUAGE ScopedTypeVariables #
# LANGUAGE InstanceSigs #
# LANGUAGE RebindableSyntax #

module Course.State where

import Course.Core
import qualified Prelude as P
import Course.Optional
import Course.List
import Course.Functor
import Course.Applicative
import Course.Monad
import qualified Data.Set as S

-- $setup
-- >>> import Test.QuickCheck.Function
  > > > import Data . List(nub )
-- >>> import Test.QuickCheck
  > > > import qualified Prelude as P(fmap )
-- >>> import Course.Core
-- >>> import Course.List
-- >>> instance Arbitrary a => Arbitrary (List a) where arbitrary = P.fmap listh arbitrary

-- A `State` is a function from a state value `s` to (a produced value `a`, and a resulting state `s`).
newtype State s a =
  State {
    runState ::
      s
      -> (a, s)
  }

-- | Run the `State` seeded with `s` and retrieve the resulting state.
--
  prop > \(Fun _ f ) s - > exec ( State f ) s = = snd ( runState ( State f ) s )
exec ::
  State s a
  -> s
  -> s
exec (State k) =
  snd . k

-- | Run the `State` seeded with `s` and retrieve the resulting value.
--
-- prop> \(Fun _ f) s -> eval (State f) s == fst (runState (State f) s)
eval ::
  State s a
  -> s
  -> a
eval (State k) =
  fst . k

-- | A `State` where the state also distributes into the produced value.
--
  > > > runState get 0
  ( 0,0 )
get ::
  State s s
get =
  State (\s -> (s, s))

-- | A `State` where the resulting state is seeded with the given value.
--
  > > > runState ( put 1 ) 0
  ( ( ) , 1 )
put ::
  s
  -> State s ()
put =
  State . const . (,) ()

-- | Implement the `Functor` instance for `State s`.
--
  > > > runState ( ( +1 ) < $ > State ( \s - > ( 9 , s * 2 ) ) ) 3
-- (10,6)
instance Functor (State s) where
  (<$>) ::
    (a -> b)
    -> State s a
    -> State s b
  f <$> State k =
    State (\s -> let (a, t) = k s in (f a, t))

-- | Implement the `Applicative` instance for `State s`.
--
  > > > runState ( pure 2 ) 0
  ( 2,0 )
--
  > > > runState ( pure ( +1 ) < * > pure 0 ) 0
  ( 1,0 )
--
  > > > import qualified Prelude as P
  > > > runState ( State ( \s - > ( ( +3 ) , s P.++ [ " apple " ] ) ) < * > State ( \s - > ( 7 , s P.++ [ " banana " ] ) ) ) [ ]
  ( 10,["apple","banana " ] )
instance Applicative (State s) where
  pure ::
    a
    -> State s a
  pure a =
    State (\s -> (a, s))
  (<*>) ::
    State s (a -> b)
    -> State s a
    -> State s b
  State f <*> State a =
    State (\s -> let (g, t) = f s
                     (z, u) = a t
                 in (g z, u))

  | Implement the ` Monad ` instance for ` State s ` .
--
  > > > runState ( ( const $ put 2 ) = < < put 1 ) 0
  ( ( ) , 2 )
--
  > > > let modify f = State ( \s - > ( ( ) , f s ) ) in runState ( modify ( +1 ) > > = \ ( ) - > modify ( * 2 ) ) 7
  ( ( ) , 16 )
instance Monad (State s) where
  (=<<) ::
    (a -> State s b)
    -> State s a
    -> State s b
  f =<< State k =
    State (\s -> let (a, t) = k s in runState (f a) t)

  | Find the first element in a ` List ` that satisfies a given predicate .
-- It is possible that no element is found, hence an `Optional` result.
  However , while performing the search , we sequence some ` Monad ` effect through .
--
-- Note the similarity of the type signature to List#find
-- where the effect appears in every return position:
    find : :   ( a - >     ) - > List a - >     Optional a
--   findM :: (a -> f Bool) -> List a -> f (Optional a)
--
  > > > let p x = ( \s - > ( const $ pure ( x = = ' c ' ) ) = < < put ( 1+s ) ) = < < get in runState ( findM p $ listh [ ' a' .. 'h ' ] ) 0
-- (Full 'c',3)
--
  > > > let p x = ( \s - > ( const $ pure ( x = = ' i ' ) ) = < < put ( 1+s ) ) = < < get in runState ( findM p $ listh [ ' a' .. 'h ' ] ) 0
  (  )
findM ::
  Monad f =>
  (a -> f Bool)
  -> List a
  -> f (Optional a)
findM _ Nil =
  pure Empty
findM p (h :. t) =
  (\q -> if q then pure (Full h) else findM p t) =<< p h

  | Find the first element in a ` List ` that repeats .
-- It is possible that no element repeats, hence an `Optional` result.
--
-- /Tip:/ Use `findM` and `State` with a @Data.Set#Set@.
--
  prop > \xs - > case firstRepeat xs of Empty - > let xs ' = hlist xs in nub xs ' = = xs ' ; Full x - > length ( filter (= = x ) xs ) > 1
  prop > \xs - > case firstRepeat xs of Empty - > True ; Full x - > let ( l , ( rx : . rs ) ) = span ( /= x ) xs in let ( l2 , r2 ) = span ( /= x ) rs in let l3 = hlist ( l + + ( rx : . Nil ) + + l2 ) in nub l3 = = l3
firstRepeat ::
  Ord a =>
  List a
  -> Optional a
firstRepeat =
  listWithState findM S.member

-- | Remove all duplicate elements in a `List`.
-- /Tip:/ Use `filtering` and `State` with a @Data.Set#Set@.
--
  prop > \xs - > firstRepeat ( distinct xs ) = = Empty
--
  prop > \xs - > distinct xs = = distinct ( flatMap ( \x - > x : . x : . Nil ) xs )
distinct ::
  Ord a =>
  List a
  -> List a
distinct =
  listWithState filtering S.notMember 

listWithState :: 
  Ord a1 =>
  ((a1 -> State (S.Set a1) a2) 
  -> t 
  -> State (S.Set a3) a)
  -> (a1 -> S.Set a1 -> a2) 
  -> t 
  -> a 
listWithState f m x =
  eval (f (State . lift2 (lift2 (,)) m S.insert) x) S.empty

  | A happy number is a positive integer , where the sum of the square of its digits eventually reaches 1 after repetition .
  In contrast , a sad number ( not a happy number ) is where the sum of the square of its digits never reaches 1
-- because it results in a recurring sequence.
--
-- /Tip:/ Use `firstRepeat` with `produce`.
--
-- /Tip:/ Use `join` to write a @square@ function.
--
  /Tip:/ Use library functions : @Optional#contains@ , @Data . 
--
  > > > isHappy 4
-- False
--
  > > > isHappy 7
-- True
--
  > > > isHappy 42
-- False
--
  > > > isHappy 44
-- True
isHappy ::
  Integer
  -> Bool
isHappy =
  contains 1 .
    firstRepeat .
    produce (toInteger .
             sum .
             map (join (*) . 
                  digitToInt) .
             show')

 $setup
 >>> import Test.QuickCheck.Function
 >>> import Test.QuickCheck
 >>> import Course.Core
 >>> import Course.List
 >>> instance Arbitrary a => Arbitrary (List a) where arbitrary = P.fmap listh arbitrary
 A `State` is a function from a state value `s` to (a produced value `a`, and a resulting state `s`).
 | Run the `State` seeded with `s` and retrieve the resulting state.

 | Run the `State` seeded with `s` and retrieve the resulting value.

 prop> \(Fun _ f) s -> eval (State f) s == fst (runState (State f) s)
 | A `State` where the state also distributes into the produced value.

 | A `State` where the resulting state is seeded with the given value.

 | Implement the `Functor` instance for `State s`.

 (10,6)
 | Implement the `Applicative` instance for `State s`.





 It is possible that no element is found, hence an `Optional` result.

 Note the similarity of the type signature to List#find
 where the effect appears in every return position:
   findM :: (a -> f Bool) -> List a -> f (Optional a)

 (Full 'c',3)

 It is possible that no element repeats, hence an `Optional` result.

 /Tip:/ Use `findM` and `State` with a @Data.Set#Set@.

 | Remove all duplicate elements in a `List`.
 /Tip:/ Use `filtering` and `State` with a @Data.Set#Set@.


 because it results in a recurring sequence.

 /Tip:/ Use `firstRepeat` with `produce`.

 /Tip:/ Use `join` to write a @square@ function.


 False

 True

 False

 True
# LANGUAGE NoImplicitPrelude #
# LANGUAGE ScopedTypeVariables #
# LANGUAGE InstanceSigs #
# LANGUAGE RebindableSyntax #

module Course.State where

import Course.Core
import qualified Prelude as P
import Course.Optional
import Course.List
import Course.Functor
import Course.Applicative
import Course.Monad
import qualified Data.Set as S

  > > > import Data . List(nub )
  > > > import qualified Prelude as P(fmap )

newtype State s a =
  State {
    runState ::
      s
      -> (a, s)
  }

  prop > \(Fun _ f ) s - > exec ( State f ) s = = snd ( runState ( State f ) s )
exec ::
  State s a
  -> s
  -> s
exec (State k) =
  snd . k

eval ::
  State s a
  -> s
  -> a
eval (State k) =
  fst . k

  > > > runState get 0
  ( 0,0 )
get ::
  State s s
get =
  State (\s -> (s, s))

  > > > runState ( put 1 ) 0
  ( ( ) , 1 )
put ::
  s
  -> State s ()
put =
  State . const . (,) ()

  > > > runState ( ( +1 ) < $ > State ( \s - > ( 9 , s * 2 ) ) ) 3
instance Functor (State s) where
  (<$>) ::
    (a -> b)
    -> State s a
    -> State s b
  f <$> State k =
    State (\s -> let (a, t) = k s in (f a, t))

  > > > runState ( pure 2 ) 0
  ( 2,0 )
  > > > runState ( pure ( +1 ) < * > pure 0 ) 0
  ( 1,0 )
  > > > import qualified Prelude as P
  > > > runState ( State ( \s - > ( ( +3 ) , s P.++ [ " apple " ] ) ) < * > State ( \s - > ( 7 , s P.++ [ " banana " ] ) ) ) [ ]
  ( 10,["apple","banana " ] )
instance Applicative (State s) where
  pure ::
    a
    -> State s a
  pure a =
    State (\s -> (a, s))
  (<*>) ::
    State s (a -> b)
    -> State s a
    -> State s b
  State f <*> State a =
    State (\s -> let (g, t) = f s
                     (z, u) = a t
                 in (g z, u))

  | Implement the ` Monad ` instance for ` State s ` .
  > > > runState ( ( const $ put 2 ) = < < put 1 ) 0
  ( ( ) , 2 )
  > > > let modify f = State ( \s - > ( ( ) , f s ) ) in runState ( modify ( +1 ) > > = \ ( ) - > modify ( * 2 ) ) 7
  ( ( ) , 16 )
instance Monad (State s) where
  (=<<) ::
    (a -> State s b)
    -> State s a
    -> State s b
  f =<< State k =
    State (\s -> let (a, t) = k s in runState (f a) t)

  | Find the first element in a ` List ` that satisfies a given predicate .
  However , while performing the search , we sequence some ` Monad ` effect through .
    find : :   ( a - >     ) - > List a - >     Optional a
  > > > let p x = ( \s - > ( const $ pure ( x = = ' c ' ) ) = < < put ( 1+s ) ) = < < get in runState ( findM p $ listh [ ' a' .. 'h ' ] ) 0
  > > > let p x = ( \s - > ( const $ pure ( x = = ' i ' ) ) = < < put ( 1+s ) ) = < < get in runState ( findM p $ listh [ ' a' .. 'h ' ] ) 0
  (  )
findM ::
  Monad f =>
  (a -> f Bool)
  -> List a
  -> f (Optional a)
findM _ Nil =
  pure Empty
findM p (h :. t) =
  (\q -> if q then pure (Full h) else findM p t) =<< p h

  | Find the first element in a ` List ` that repeats .
  prop > \xs - > case firstRepeat xs of Empty - > let xs ' = hlist xs in nub xs ' = = xs ' ; Full x - > length ( filter (= = x ) xs ) > 1
  prop > \xs - > case firstRepeat xs of Empty - > True ; Full x - > let ( l , ( rx : . rs ) ) = span ( /= x ) xs in let ( l2 , r2 ) = span ( /= x ) rs in let l3 = hlist ( l + + ( rx : . Nil ) + + l2 ) in nub l3 = = l3
firstRepeat ::
  Ord a =>
  List a
  -> Optional a
firstRepeat =
  listWithState findM S.member

  prop > \xs - > firstRepeat ( distinct xs ) = = Empty
  prop > \xs - > distinct xs = = distinct ( flatMap ( \x - > x : . x : . Nil ) xs )
distinct ::
  Ord a =>
  List a
  -> List a
distinct =
  listWithState filtering S.notMember 

listWithState :: 
  Ord a1 =>
  ((a1 -> State (S.Set a1) a2) 
  -> t 
  -> State (S.Set a3) a)
  -> (a1 -> S.Set a1 -> a2) 
  -> t 
  -> a 
listWithState f m x =
  eval (f (State . lift2 (lift2 (,)) m S.insert) x) S.empty

  | A happy number is a positive integer , where the sum of the square of its digits eventually reaches 1 after repetition .
  In contrast , a sad number ( not a happy number ) is where the sum of the square of its digits never reaches 1
  /Tip:/ Use library functions : @Optional#contains@ , @Data . 
  > > > isHappy 4
  > > > isHappy 7
  > > > isHappy 42
  > > > isHappy 44
isHappy ::
  Integer
  -> Bool
isHappy =
  contains 1 .
    firstRepeat .
    produce (toInteger .
             sum .
             map (join (*) . 
                  digitToInt) .
             show')
