{-# LANGUAGE RecordWildCards #-}

module Lab11b where

import Prelude hiding (lookup)

import Data.Maybe (fromMaybe)
import Data.Char (isDigit)

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)
-- toUpper c = case lookup toUpperRegistry c of
--               Just upper -> upper
--               Nothing -> c
  where toUpperRegistry = zip ['a'..'z'] ['A'..'Z']

toPascalCaseF :: Functor f => f String -> f String
toPascalCaseF = fmap toPascalCase
  where
    toPascalCase = concat . fmap upperHead . words
    upperHead "" = ""
    upperHead (c:cs) = toUpper c : cs

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

data DFA' a = DFA' (a -> Char -> a) a (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 FloatState = Before | Digit | Dot | First | Second | Fail
  deriving Show

floatDfa :: DFA FloatState
floatDfa = DFA {..}
  where dfaDelta Before c
          | isDigit c = Digit
          | otherwise = Fail
        dfaDelta Digit '.' = Dot
        dfaDelta Digit c
          | isDigit c = Digit
          | otherwise = Fail
        dfaDelta Dot c
          | isDigit c = First
          | otherwise = Fail
        dfaDelta First c
          | isDigit c = Second
          | otherwise = Fail
        dfaDelta Second _ = Fail
        dfaDelta Fail _ = Fail

        dfaInit = Before

        dfaFinal Second = True
        dfaFinal _ = False

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

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

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