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

module Buffet.Document.TemplateTagGroups
  ( TagGroup
  , get
  ) where

import qualified Buffet.Ir.Ir as Ir
import qualified Buffet.Toolbox.TextTools as TextTools
import qualified Data.Aeson as Aeson
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified GHC.Generics as Generics
import Prelude (Eq, Ord, Show, ($), (.), concatMap, fmap)

data TagGroup =
  TagGroup
    { TagGroup -> TagValue
value :: Ir.TagValue
    , TagGroup -> [Option]
dishes :: [Ir.Option]
    }
  deriving (TagGroup -> TagGroup -> Bool
(TagGroup -> TagGroup -> Bool)
-> (TagGroup -> TagGroup -> Bool) -> Eq TagGroup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagGroup -> TagGroup -> Bool
$c/= :: TagGroup -> TagGroup -> Bool
== :: TagGroup -> TagGroup -> Bool
$c== :: TagGroup -> TagGroup -> Bool
Eq, (forall x. TagGroup -> Rep TagGroup x)
-> (forall x. Rep TagGroup x -> TagGroup) -> Generic TagGroup
forall x. Rep TagGroup x -> TagGroup
forall x. TagGroup -> Rep TagGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TagGroup x -> TagGroup
$cfrom :: forall x. TagGroup -> Rep TagGroup x
Generics.Generic, Eq TagGroup
Eq TagGroup
-> (TagGroup -> TagGroup -> Ordering)
-> (TagGroup -> TagGroup -> Bool)
-> (TagGroup -> TagGroup -> Bool)
-> (TagGroup -> TagGroup -> Bool)
-> (TagGroup -> TagGroup -> Bool)
-> (TagGroup -> TagGroup -> TagGroup)
-> (TagGroup -> TagGroup -> TagGroup)
-> Ord TagGroup
TagGroup -> TagGroup -> Bool
TagGroup -> TagGroup -> Ordering
TagGroup -> TagGroup -> TagGroup
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 :: TagGroup -> TagGroup -> TagGroup
$cmin :: TagGroup -> TagGroup -> TagGroup
max :: TagGroup -> TagGroup -> TagGroup
$cmax :: TagGroup -> TagGroup -> TagGroup
>= :: TagGroup -> TagGroup -> Bool
$c>= :: TagGroup -> TagGroup -> Bool
> :: TagGroup -> TagGroup -> Bool
$c> :: TagGroup -> TagGroup -> Bool
<= :: TagGroup -> TagGroup -> Bool
$c<= :: TagGroup -> TagGroup -> Bool
< :: TagGroup -> TagGroup -> Bool
$c< :: TagGroup -> TagGroup -> Bool
compare :: TagGroup -> TagGroup -> Ordering
$ccompare :: TagGroup -> TagGroup -> Ordering
$cp1Ord :: Eq TagGroup
Ord, Int -> TagGroup -> ShowS
[TagGroup] -> ShowS
TagGroup -> String
(Int -> TagGroup -> ShowS)
-> (TagGroup -> String) -> ([TagGroup] -> ShowS) -> Show TagGroup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagGroup] -> ShowS
$cshowList :: [TagGroup] -> ShowS
show :: TagGroup -> String
$cshow :: TagGroup -> String
showsPrec :: Int -> TagGroup -> ShowS
$cshowsPrec :: Int -> TagGroup -> ShowS
Show)

instance Aeson.ToJSON TagGroup where
  toJSON :: TagGroup -> Value
toJSON = Options -> TagGroup -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON Options
TextTools.defaultJsonOptions

get :: Ir.Buffet -> Map.Map Ir.TagKey [TagGroup]
get :: Buffet -> Map TagKey [TagGroup]
get = (Map TagValue (Set Option) -> [TagGroup])
-> Map TagKey (Map TagValue (Set Option)) -> Map TagKey [TagGroup]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map TagValue (Set Option) -> [TagGroup]
getTagGroup (Map TagKey (Map TagValue (Set Option)) -> Map TagKey [TagGroup])
-> (Buffet -> Map TagKey (Map TagValue (Set Option)))
-> Buffet
-> Map TagKey [TagGroup]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Buffet -> Map TagKey (Map TagValue (Set Option))
keyToValueToOption

getTagGroup :: Map.Map Ir.TagValue (Set.Set Ir.Option) -> [TagGroup]
getTagGroup :: Map TagValue (Set Option) -> [TagGroup]
getTagGroup =
  ((TagValue, Set Option) -> TagGroup)
-> [(TagValue, Set Option)] -> [TagGroup]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\(TagValue
value', Set Option
options) ->
       TagGroup :: TagValue -> [Option] -> TagGroup
TagGroup {value :: TagValue
value = TagValue
value', dishes :: [Option]
dishes = Set Option -> [Option]
forall a. Set a -> [a]
Set.toAscList Set Option
options}) ([(TagValue, Set Option)] -> [TagGroup])
-> (Map TagValue (Set Option) -> [(TagValue, Set Option)])
-> Map TagValue (Set Option)
-> [TagGroup]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Map TagValue (Set Option) -> [(TagValue, Set Option)]
forall k a. Map k a -> [(k, a)]
Map.toAscList

keyToValueToOption ::
     Ir.Buffet -> Map.Map Ir.TagKey (Map.Map Ir.TagValue (Set.Set Ir.Option))
keyToValueToOption :: Buffet -> Map TagKey (Map TagValue (Set Option))
keyToValueToOption Buffet
buffet = (Map TagValue (Set Option)
 -> Map TagValue (Set Option) -> Map TagValue (Set Option))
-> [Map TagKey (Map TagValue (Set Option))]
-> Map TagKey (Map TagValue (Set Option))
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith ((Set Option -> Set Option -> Set Option)
-> Map TagValue (Set Option)
-> Map TagValue (Set Option)
-> Map TagValue (Set Option)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Set Option -> Set Option -> Set Option
forall a. Ord a => Set a -> Set a -> Set a
Set.union) [Map TagKey (Map TagValue (Set Option))]
singletons
  where
    singletons :: [Map TagKey (Map TagValue (Set Option))]
singletons =
      ((Option, Dish) -> [Map TagKey (Map TagValue (Set Option))])
-> [(Option, Dish)] -> [Map TagKey (Map TagValue (Set Option))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
        (\(Option
option, Dish
dish) ->
           ((TagKey, [TagValue]) -> [Map TagKey (Map TagValue (Set Option))])
-> [(TagKey, [TagValue])]
-> [Map TagKey (Map TagValue (Set Option))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
             (\(TagKey
key, [TagValue]
values) ->
                (TagValue -> Map TagKey (Map TagValue (Set Option)))
-> [TagValue] -> [Map TagKey (Map TagValue (Set Option))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                  (\TagValue
value' ->
                     TagKey
-> Map TagValue (Set Option)
-> Map TagKey (Map TagValue (Set Option))
forall k a. k -> a -> Map k a
Map.singleton TagKey
key (Map TagValue (Set Option)
 -> Map TagKey (Map TagValue (Set Option)))
-> (Set Option -> Map TagValue (Set Option))
-> Set Option
-> Map TagKey (Map TagValue (Set Option))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TagValue -> Set Option -> Map TagValue (Set Option)
forall k a. k -> a -> Map k a
Map.singleton TagValue
value' (Set Option -> Map TagKey (Map TagValue (Set Option)))
-> Set Option -> Map TagKey (Map TagValue (Set Option))
forall a b. (a -> b) -> a -> b
$
                     Option -> Set Option
forall a. a -> Set a
Set.singleton Option
option)
                  [TagValue]
values) ([(TagKey, [TagValue])]
 -> [Map TagKey (Map TagValue (Set Option))])
-> (Metadata -> [(TagKey, [TagValue])])
-> Metadata
-> [Map TagKey (Map TagValue (Set Option))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
           Map TagKey [TagValue] -> [(TagKey, [TagValue])]
forall k a. Map k a -> [(k, a)]
Map.toList (Map TagKey [TagValue] -> [(TagKey, [TagValue])])
-> (Metadata -> Map TagKey [TagValue])
-> Metadata
-> [(TagKey, [TagValue])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> Map TagKey [TagValue]
Ir.tags (Metadata -> [Map TagKey (Map TagValue (Set Option))])
-> Metadata -> [Map TagKey (Map TagValue (Set Option))]
forall a b. (a -> b) -> a -> b
$
           Dish -> Metadata
Ir.metadata Dish
dish) ([(Option, Dish)] -> [Map TagKey (Map TagValue (Set Option))])
-> [(Option, Dish)] -> [Map TagKey (Map TagValue (Set Option))]
forall a b. (a -> b) -> a -> b
$
      Map Option Dish -> [(Option, Dish)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Option Dish
optionToDish
    optionToDish :: Map Option Dish
optionToDish = Buffet -> Map Option Dish
Ir.optionToDish Buffet
buffet