module Main where

import Prelude
import Data.List
import Control.Apply
import Data.Boolean
import Data.Maybe
import Control.Monad.Writer
import Control.Monad.Writer.Class
import Control.Monad.State
import Data.Tuple
import Control.Extend (class Functor)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Data.Array (reverse)
import Data.Bifunctor (class Bifunctor)

main :: forall e. Eff (console :: CONSOLE | e) Unit
main = do
  log "Hello sailor!"

--

id :: forall a. a -> a
id x = x

--


add :: Int -> Int -> Int
add x y = x + y

add5 = add 5

--


which2 :: Int -> String
which2 0 = "nula"
which2 1 = "jedna"
which2 _ = "jiný"

which :: Int -> String
which n | n == 0 = "nula"
        | n > 1 && n < 5 = "jedna až pět"
        | otherwise = "jiný"

--

data Pair a b = Pair a b

instance showPair :: (Show a, Show b) => Show (Pair a b) where
  show (Pair a b) = "(Pair " <> show a <> " " <> show b <> ")"

instance functorPair :: Bifunctor Pair where
  bimap f g (Pair a b) = Pair (f a) (g b)


data Same a = Same a a

instance showSame :: (Show a) => Show (Same a) where
  show (Same a b) = "(Pair " <> show a <> " " <> show b <> ")"

instance functorSame :: Functor Same where
  map f (Same a b) = Same (f a) (f b)


shift :: forall a. List a -> List a
shift (x : xs) = snoc xs x
shift (x) = x

zip' :: forall a b. List (Pair a b) -> List a -> List b -> List (Pair a b)
zip' l (a : as) (b : bs) = zip' (snoc l $ Pair a b) as bs
zip' l _ _ = l


div' :: Int -> Int -> Maybe Int
div' _ 0 = Nothing
div' a b = Just (a / b)

--


m :: Maybe Int -> Int
m (Just a) = a + 1
m Nothing = 9

m' :: Maybe Int -> Int
m' = case _ of
  Just n | n == 0 -> 10
         | n > 0 -> n + 1
  _ -> 9


--

sqs :: Int -> Int -> Int
sqs a b = a' + b'
  where
    a' = a * a
    b' = b * b


--

zip'' :: forall a b. List a -> List b -> List (Pair a b)
zip'' ax bx = z Nil ax bx
  where
    z :: List (Pair a b) -> List a -> List b -> List (Pair a b)
    z l (a : as) (b : bs) = z (snoc l $ Pair a b) as bs
    z l _ _ = l



--shift :: forall a. List a -> List a
--shift a = return $ tail a

--

type User =
  { username :: String
  , password :: String
  , scopes :: List Int
  }

showUser :: User -> String
showUser user = "User " <> user.username <> " " <> user.password <> " " <> show user.scopes

type Users = List User

honza :: User
honza = { username: "honza", password: "prdel", scopes: 1 .. 3 }

karel :: User
karel = { username: "karel", password: "prdel", scopes: Nil }

users :: Users
users = (honza : karel : Nil)

type Credentials r =
  { username :: String
  , password :: String
  | r
  }

allowed :: forall r.  Users -> Credentials r -> Boolean
allowed l { username: u1, password: p1 } = isJust $ head $ filter match l
  where
    match :: forall r'. Credentials r' -> Boolean
    match { username: u2, password: p2 } = u1 == u2 && p1 == p2

allowed' :: forall r.  Users -> Credentials r -> Maybe User
allowed' l { username: u1, password: p1 } = head $ filter match l
  where
    match :: forall r'. Credentials r' -> Boolean
    match { username: u2, password: p2 } = u1 == u2 && p1 == p2

-- showUser <$> allowed users { username: "honza", password: "prdel" }

--

newUser :: String -> String -> User
newUser username password = { username: username
                            , password: password
                            , scopes: 1 .. 3
                            }

f :: String -> String -> Maybe User
f username password =
  lift2 newUser (Just username) (Just password) >>= \n -> pure n

f' :: Maybe String -> Maybe String -> Boolean
f' username password = isJust found
  where
    found = do
      user <- lift2 newUser username password
      user' <- allowed' users user
      pure user'

--

--  (Just 2) >>= \n -> pure (n + 1)
--  (Just 2) >>= \n -> Just (n + 1)
-- bind (Just 2) (\n -> Just (n + 1))


gcd' :: Int -> Int -> Int
gcd' n 0 = n
gcd' 0 m = m
gcd' n m | n > m = gcd (n - m) m
         | otherwise = gcd n (m - n)

gcdLog :: Int -> Int -> Writer (Array String) Int
gcdLog n 0 = pure n
gcdLog 0 m = pure m
gcdLog n m = do
  tell ["gcdLog " <> show n <> " " <> show m]
  if n > m
    then gcdLog (n - m) m
    else gcdLog n (m - n)


--

toOrdinal :: Int -> String
toOrdinal 0 = "0"
toOrdinal n = case n `mod` 10 of
                1 -> show n <> "st"
                2 -> show n <> "nd"
                3 -> show n <> "rd"
                _ -> show n <> "th"

reverse' :: forall a. List a -> List a
reverse' l = reverse'' Nil l
  where
    reverse'' :: forall a. List a -> List a -> List a
    reverse'' r (x : xs) = reverse'' (Cons x r) xs
    reverse'' r Nil = r


pow' :: Int -> Int -> Int
pow' 0 n = 1
pow' 1 n = n
pow' x n = foldl (\r _ -> r * n) n (2 .. x)

root :: Int -> Int -> Int -> Int
root x r n | x > n = digitalRoot r
           | otherwise = root x' (r + m'') (n - m'')
  where
   x' = x * 10
   m' = n `mod` x'
   m'' = m' / x

digitalRoot :: Int -> Int
digitalRoot n | n < 10 = n
              | otherwise = root 1 0 n




fib :: Int -> Writer (Array String) Int
fib 0 = pure 0
fib 1 = pure 1
fib n = do
  tell [show n]
  a <- fib (n - 1)
  b <- fib (n - 2)
  pure (a + b)


factorial :: State (Tuple Int Int) Int
factorial = get >>= \(Tuple n r) ->
  if n <= 1
  then pure r
  else do
    put (Tuple (n - 1) (r * n))
    factorial


fib' :: State (Tuple (Tuple Int Int) Int) Int
fib' = get >>= \(Tuple (Tuple x1 x2) n) ->
  if n == 0
  then pure x1
  else do
    put (Tuple (Tuple x2 (x1 + x2)) (n - 1))
    fib'