{- HLINT ignore "Avoid restricted extensions" -}
{-# LANGUAGE DeriveGeneric #-}

module Buffet.Parse.ParseMenuFromFile
  ( get
  ) where

import qualified Buffet.Ir.Ir as Ir
import qualified Buffet.Parse.Menu as Menu
import qualified Buffet.Toolbox.ExceptionTools as ExceptionTools
import qualified Buffet.Toolbox.TextTools as TextTools
import qualified Control.Exception as Exception
import qualified Data.Aeson as Aeson
import qualified Data.Map.Strict as Map
import qualified Data.Maybe as Maybe
import qualified Data.Text as T
import qualified Data.Yaml as Yaml
import qualified GHC.Generics as Generics
import Prelude
  ( Eq
  , FilePath
  , IO
  , Maybe
  , Ord
  , Show
  , ($)
  , fmap
  , maybe
  , mconcat
  , pure
  , show
  )
import qualified System.FilePath as FilePath

data Exception =
  Exception FilePath Yaml.ParseException

instance Show Exception where
  show :: Exception -> String
show (Exception String
path ParseException
exception) =
    [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
path, String
":\n", ParseException -> String
Yaml.prettyPrintParseException ParseException
exception]

instance Exception.Exception Exception

data RawMenu =
  RawMenu
    { RawMenu -> Maybe Text
copyDummySourcePath :: Maybe T.Text
    , RawMenu -> Maybe (Map Option String)
optionToDish :: Maybe (Map.Map Ir.Option FilePath)
    }
  deriving (RawMenu -> RawMenu -> Bool
(RawMenu -> RawMenu -> Bool)
-> (RawMenu -> RawMenu -> Bool) -> Eq RawMenu
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawMenu -> RawMenu -> Bool
$c/= :: RawMenu -> RawMenu -> Bool
== :: RawMenu -> RawMenu -> Bool
$c== :: RawMenu -> RawMenu -> Bool
Eq, (forall x. RawMenu -> Rep RawMenu x)
-> (forall x. Rep RawMenu x -> RawMenu) -> Generic RawMenu
forall x. Rep RawMenu x -> RawMenu
forall x. RawMenu -> Rep RawMenu x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RawMenu x -> RawMenu
$cfrom :: forall x. RawMenu -> Rep RawMenu x
Generics.Generic, Eq RawMenu
Eq RawMenu
-> (RawMenu -> RawMenu -> Ordering)
-> (RawMenu -> RawMenu -> Bool)
-> (RawMenu -> RawMenu -> Bool)
-> (RawMenu -> RawMenu -> Bool)
-> (RawMenu -> RawMenu -> Bool)
-> (RawMenu -> RawMenu -> RawMenu)
-> (RawMenu -> RawMenu -> RawMenu)
-> Ord RawMenu
RawMenu -> RawMenu -> Bool
RawMenu -> RawMenu -> Ordering
RawMenu -> RawMenu -> RawMenu
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RawMenu -> RawMenu -> RawMenu
$cmin :: RawMenu -> RawMenu -> RawMenu
max :: RawMenu -> RawMenu -> RawMenu
$cmax :: RawMenu -> RawMenu -> RawMenu
>= :: RawMenu -> RawMenu -> Bool
$c>= :: RawMenu -> RawMenu -> Bool
> :: RawMenu -> RawMenu -> Bool
$c> :: RawMenu -> RawMenu -> Bool
<= :: RawMenu -> RawMenu -> Bool
$c<= :: RawMenu -> RawMenu -> Bool
< :: RawMenu -> RawMenu -> Bool
$c< :: RawMenu -> RawMenu -> Bool
compare :: RawMenu -> RawMenu -> Ordering
$ccompare :: RawMenu -> RawMenu -> Ordering
$cp1Ord :: Eq RawMenu
Ord, Int -> RawMenu -> ShowS
[RawMenu] -> ShowS
RawMenu -> String
(Int -> RawMenu -> ShowS)
-> (RawMenu -> String) -> ([RawMenu] -> ShowS) -> Show RawMenu
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawMenu] -> ShowS
$cshowList :: [RawMenu] -> ShowS
show :: RawMenu -> String
$cshow :: RawMenu -> String
showsPrec :: Int -> RawMenu -> ShowS
$cshowsPrec :: Int -> RawMenu -> ShowS
Show)

instance Yaml.FromJSON RawMenu where
  parseJSON :: Value -> Parser RawMenu
parseJSON = Options -> Value -> Parser RawMenu
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON Options
TextTools.defaultJsonOptions

get :: FilePath -> IO Menu.Menu
get :: String -> IO Menu
get String
menu = do
  RawMenu
raw <- String -> IO RawMenu
getRaw String
menu
  Menu -> IO Menu
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Menu :: Text -> Map Option String -> Menu
Menu.Menu
      { copyDummySourcePath :: Text
Menu.copyDummySourcePath =
          Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
Maybe.fromMaybe (Menu -> Text
Menu.copyDummySourcePath Menu
Menu.defaultMenu) (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$
          RawMenu -> Maybe Text
copyDummySourcePath RawMenu
raw
      , optionToDish :: Map Option String
Menu.optionToDish =
          Map Option String
-> (Map Option String -> Map Option String)
-> Maybe (Map Option String)
-> Map Option String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            (Menu -> Map Option String
Menu.optionToDish Menu
Menu.defaultMenu)
            (ShowS -> Map Option String -> Map Option String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ShowS -> Map Option String -> Map Option String)
-> ShowS -> Map Option String -> Map Option String
forall a b. (a -> b) -> a -> b
$ String -> ShowS
FilePath.combine String
folder) (Maybe (Map Option String) -> Map Option String)
-> Maybe (Map Option String) -> Map Option String
forall a b. (a -> b) -> a -> b
$
          RawMenu -> Maybe (Map Option String)
optionToDish RawMenu
raw
      }
  where
    folder :: String
folder = ShowS
FilePath.takeDirectory String
menu

getRaw :: FilePath -> IO RawMenu
getRaw :: String -> IO RawMenu
getRaw String
menu =
  (ParseException -> Exception)
-> IO (Either ParseException RawMenu) -> IO RawMenu
forall e a b. Exception e => (a -> e) -> IO (Either a b) -> IO b
ExceptionTools.eitherThrow (String -> ParseException -> Exception
Exception String
menu) (IO (Either ParseException RawMenu) -> IO RawMenu)
-> IO (Either ParseException RawMenu) -> IO RawMenu
forall a b. (a -> b) -> a -> b
$ String -> IO (Either ParseException RawMenu)
forall a. FromJSON a => String -> IO (Either ParseException a)
Yaml.decodeFileEither String
menu