#!/usr/bin/env runhaskell

{-# OPTIONS_GHC -Wall #-}

module Main where

import Control.Applicative
import Data.Char
import Data.Maybe
import Data.Time.Clock.POSIX

factors60 ::
  [Int]
factors60 =
  [2, 3, 4, 5, 6, 10, 12, 15, 20, 30]

random ::
  Integral t =>
  t
  -> (t -> a)
  -> IO a
random n f =
  (\t ->  f (round (t * 1000000000) `mod` n)) <$> getPOSIXTime

select ::
  Int
  -> a
  -> [a]
  -> IO a
select n d x =
  random n (\q -> fromMaybe d (lookup q (zip [0..] x)))

factor60 ::
  IO Int
factor60 =
  select 10 60 factors60

distancemultipliers ::
  [Int]
distancemultipliers =
  [2..5]

distancemultiplier ::
  IO Int
distancemultiplier =
  select 4 1 distancemultipliers

distances ::
  [Int]
distances =
  liftA2 (*) factors60 distancemultipliers

distance ::
  IO Int
distance =
  liftA2 (*) factor60 distancemultiplier

sides ::
  [Bool]
sides =
  [False, True]

side ::
  IO Bool
side =
  select 2 False sides
  
miles ::
  [Int]
miles =
  [1..4]

mile ::
  IO Int
mile =
  select 4 0 miles
  
headings ::
  [Int]
headings =
  [10,20..360]

heading ::
  IO Int
heading =
  select 36 360 headings
  
data OneInSixty =
  OneInSixty
    String
    Int
  deriving (Eq, Ord, Show)

oneinsixty ::
  Int
  -> Int
  -> Int
  -> Bool
  -> Int
  -> OneInSixty
oneinsixty hd t1 t2 lr dt =
  OneInSixty (concat
                [
                  "You are heading "
                , show hd
                , " degrees on a leg of "
                , show (t1 + t2)
                , "nm, after "
                , show t1
                , "nm you are "
                , show dt
                , "nm "
                , if lr then "left" else "right"
                , " of your intended track. What is the new heading (nearest integer) to the destination? "
                ]
              ) (
                  let te ::
                        Double
                      te =
                        ((60 / fromIntegral t1) * fromIntegral dt)
                      ca ::
                        Double
                      ca =
                        ((60 / fromIntegral t2) * fromIntegral dt)
                      m ::
                        Double
                      m =
                        if lr then 1 else -1
                  in round (fromIntegral hd + (m * (te + ca))) `mod` 360
                )

(.==.) ::
  Show a =>
  a
  -> String
  -> Bool
x .==. y =
  show x == filter isDigit y

putStrLns ::
  [String]
  -> IO ()
putStrLns =
  mapM_ putStrLn

putNewLn ::
  String
  -> IO ()
putNewLn s =
  putStrLns [s, ""]

data Result =
  Correct
  | Quit
  | GiveUp
  deriving (Eq, Ord, Show)

quiz' ::
  OneInSixty
  -> IO Result
quiz' x@(OneInSixty q a) =
  do  putStrLns ["[type q to quit]", "[type g to give up]"]
      putStr q
      z <- getLine
      let sw =
            [
              (z `elem` ["Q", "q"], Quit)
            , (z `elem` ["G", "g"], GiveUp)
            , (a .==. z, Correct)
            ]
      case lookup True sw of
        Nothing ->
          do  putNewLn (red "Incorrect.")
              quiz' x
        Just r ->
          return r

green ::
  String
  -> String
green s =
  concat
    [
      "\ESC[92m\ESC[42m"
    , s
    , "\ESC[m"
    ]

red ::
  String
  -> String
red s =
  concat
    [
      "\ESC[38m\ESC[41m"
    , s
    , "\ESC[m"
    ]

quiz :: 
  IO ()
quiz =
  do  s@(OneInSixty _ a) <- oneinsixty <$> heading <*> distance <*> distance <*> side <*> mile
      p <- quiz' s
      case p of
        Correct ->
          do  putNewLn (green "Correct!")
              quiz
        GiveUp ->
          do  putNewLn ("The correct answer is " ++ green (show a))
              quiz
        Quit ->
          return ()

main ::
  IO ()
main =
  quiz