{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}


module Lab11a where

import Prelude hiding (lookup)
import Data.Maybe (fromMaybe)

lookup :: Eq a => [(a, b)] -> a -> Maybe b
lookup [] _ = Nothing
lookup ((key, value):xs) needle
  | key == needle = Just value
  | otherwise = lookup xs needle

toUpper :: Char -> Char
toUpper c = fromMaybe c (lookup toUpperRegistry c)
  where
    toUpperRegistry = zip ['a' .. 'z'] ['A' .. 'Z']

toCamelCaseF :: Functor f => f String -> f String
toCamelCaseF = fmap toCamelCase
  where toCamelCase = concat . fmap upperHead . words
        upperHead (h:t) = toUpper h : t
        upperHead "" = ""

data DFA a = DFA
  { dfaDelta :: a -> Char -> a
  , dfaInit :: a
  , dfaFinal :: a -> Bool
  }

evalDFA :: DFA a -> String -> Bool
evalDFA (DFA {..}) input = go input dfaInit
  where go [] state = dfaFinal state
        go (c:cs) state = go cs (dfaDelta state c)

data FloatStates = Before | Digit | Dot | First | Second | Fail deriving Show

floatDfa :: DFA FloatStates
floatDfa = DFA
  { dfaDelta = delta
  , dfaInit = Before
  , dfaFinal = final
  }
  where
    isDigit c = c `elem` ['0'..'9']
    delta Before c
      | isDigit c = Digit
      | otherwise = Fail
    delta Digit '.' = Dot
    delta Digit c
      | isDigit c = Digit
      | otherwise = Fail
    delta Dot c
      | isDigit c = First
      | otherwise = Fail
    delta First c
      | isDigit c = Second
      | otherwise = Fail
    delta Second _ = Fail
    delta Fail _ = Fail

    final Second = True
    final _ = False

parseNum :: String -> Maybe Float
parseNum input
  | evalDFA floatDfa input = Just (read input)
  | otherwise = Nothing

parseNumF :: Functor f => f String -> f (Maybe Float)
parseNumF = fmap parseNum

parseIO :: IO Float
parseIO = do
  putStrLn "Enter a number:"
  line <- getLine
  case parseNum line of
    Just f -> pure f
    Nothing -> parseIO