{-# LANGUAGE OverloadedLabels #-} module WikiMusic.SSR.View.Components.Forms where import Principium import Text.Blaze.Html5 as H hiding (map) import Text.Blaze.Html5.Attributes as A import WikiMusic.Model.Artwork import WikiMusic.SSR.View.Components.Icons mkSortingForm :: ViewVars -> SortOrder -> Text -> Text -> Html mkSortingForm :: ViewVars -> SortOrder -> Text -> Text -> Html mkSortingForm ViewVars vv SortOrder sortOrder Text action' Text fieldName = Html -> Html section (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ Html -> Html H.form (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute action (Text -> AttributeValue textToAttrValue Text action') (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute method AttributeValue "POST" (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute enctype AttributeValue "multipart/form-data" (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ do Html -> Html select (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! Set Text -> Attribute css (ViewVars -> Set Text cssSelect ViewVars vv) (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute onchange AttributeValue "this.form.submit()" (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute name (Text -> AttributeValue textToAttrValue Text fieldName) (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ ((Text, Text) -> Html) -> [(Text, Text)] -> Html forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ (Text, Text) -> Html mkOption [(Text, Text)] entries Html -> Html noscript (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ Html -> Html button (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute type_ AttributeValue "submit" (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ Html "submit" where mkOption :: (Text, Text) -> Html mkOption :: (Text, Text) -> Html mkOption (Text, Text) o = Html -> Html option (Html -> Html) -> (Bool, Attribute) -> Html -> Html forall h. Attributable h => h -> (Bool, Attribute) -> h H.!? ((Text, Text) -> Text forall a b. (a, b) -> a fst (Text, Text) o Text -> Text -> Bool forall a. Eq a => a -> a -> Bool == SortOrder sortOrder SortOrder -> Optic' An_Iso NoIx SortOrder Text -> Text forall k s (is :: IxList) a. Is k A_Getter => s -> Optic' k is s a -> a ^. Optic' An_Iso NoIx SortOrder Text #value, AttributeValue -> Attribute selected AttributeValue "true") (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute value (Text -> AttributeValue textToAttrValue (Text -> AttributeValue) -> Text -> AttributeValue forall a b. (a -> b) -> a -> b $ (Text, Text) -> Text forall a b. (a, b) -> a fst (Text, Text) o) (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ Text -> Html text (Text "↕ " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> (Text, Text) -> Text forall a b. (a, b) -> b snd (Text, Text) o) entries :: [(Text, Text)] entries = [ (Text "display-name-asc", (ApplicationDictionary -> Optic' A_Lens NoIx ApplicationDictionary DictTerm -> DictTerm forall k s (is :: IxList) a. Is k A_Getter => s -> Optic' k is s a -> a ^. Optic A_Lens NoIx ApplicationDictionary ApplicationDictionary Sortings Sortings #sortings Optic A_Lens NoIx ApplicationDictionary ApplicationDictionary Sortings Sortings -> Optic A_Lens NoIx Sortings Sortings DictTerm DictTerm -> Optic' A_Lens NoIx ApplicationDictionary DictTerm forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a b. (JoinKinds k l m, AppendIndices is js ks) => Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b % Optic A_Lens NoIx Sortings Sortings DictTerm DictTerm #alphabeticalAsc) (ApplicationDictionary -> DictTerm) -> Language -> Text |##| (ViewVars vv ViewVars -> Optic' A_Lens NoIx ViewVars Language -> Language forall k s (is :: IxList) a. Is k A_Getter => s -> Optic' k is s a -> a ^. Optic' A_Lens NoIx ViewVars Language #language)), (Text "display-name-desc", (ApplicationDictionary -> Optic' A_Lens NoIx ApplicationDictionary DictTerm -> DictTerm forall k s (is :: IxList) a. Is k A_Getter => s -> Optic' k is s a -> a ^. Optic A_Lens NoIx ApplicationDictionary ApplicationDictionary Sortings Sortings #sortings Optic A_Lens NoIx ApplicationDictionary ApplicationDictionary Sortings Sortings -> Optic A_Lens NoIx Sortings Sortings DictTerm DictTerm -> Optic' A_Lens NoIx ApplicationDictionary DictTerm forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a b. (JoinKinds k l m, AppendIndices is js ks) => Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b % Optic A_Lens NoIx Sortings Sortings DictTerm DictTerm #alphabeticalDesc) (ApplicationDictionary -> DictTerm) -> Language -> Text |##| (ViewVars vv ViewVars -> Optic' A_Lens NoIx ViewVars Language -> Language forall k s (is :: IxList) a. Is k A_Getter => s -> Optic' k is s a -> a ^. Optic' A_Lens NoIx ViewVars Language #language)), (Text "created-at-asc", (ApplicationDictionary -> Optic' A_Lens NoIx ApplicationDictionary DictTerm -> DictTerm forall k s (is :: IxList) a. Is k A_Getter => s -> Optic' k is s a -> a ^. Optic A_Lens NoIx ApplicationDictionary ApplicationDictionary Sortings Sortings #sortings Optic A_Lens NoIx ApplicationDictionary ApplicationDictionary Sortings Sortings -> Optic A_Lens NoIx Sortings Sortings DictTerm DictTerm -> Optic' A_Lens NoIx ApplicationDictionary DictTerm forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a b. (JoinKinds k l m, AppendIndices is js ks) => Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b % Optic A_Lens NoIx Sortings Sortings DictTerm DictTerm #createdAtAsc) (ApplicationDictionary -> DictTerm) -> Language -> Text |##| (ViewVars vv ViewVars -> Optic' A_Lens NoIx ViewVars Language -> Language forall k s (is :: IxList) a. Is k A_Getter => s -> Optic' k is s a -> a ^. Optic' A_Lens NoIx ViewVars Language #language)), (Text "created-at-desc", (ApplicationDictionary -> Optic' A_Lens NoIx ApplicationDictionary DictTerm -> DictTerm forall k s (is :: IxList) a. Is k A_Getter => s -> Optic' k is s a -> a ^. Optic A_Lens NoIx ApplicationDictionary ApplicationDictionary Sortings Sortings #sortings Optic A_Lens NoIx ApplicationDictionary ApplicationDictionary Sortings Sortings -> Optic A_Lens NoIx Sortings Sortings DictTerm DictTerm -> Optic' A_Lens NoIx ApplicationDictionary DictTerm forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a b. (JoinKinds k l m, AppendIndices is js ks) => Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b % Optic A_Lens NoIx Sortings Sortings DictTerm DictTerm #createdAtDesc) (ApplicationDictionary -> DictTerm) -> Language -> Text |##| (ViewVars vv ViewVars -> Optic' A_Lens NoIx ViewVars Language -> Language forall k s (is :: IxList) a. Is k A_Getter => s -> Optic' k is s a -> a ^. Optic' A_Lens NoIx ViewVars Language #language)), (Text "last-edited-at-desc", (ApplicationDictionary -> Optic' A_Lens NoIx ApplicationDictionary DictTerm -> DictTerm forall k s (is :: IxList) a. Is k A_Getter => s -> Optic' k is s a -> a ^. Optic A_Lens NoIx ApplicationDictionary ApplicationDictionary Sortings Sortings #sortings Optic A_Lens NoIx ApplicationDictionary ApplicationDictionary Sortings Sortings -> Optic A_Lens NoIx Sortings Sortings DictTerm DictTerm -> Optic' A_Lens NoIx ApplicationDictionary DictTerm forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a b. (JoinKinds k l m, AppendIndices is js ks) => Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b % Optic A_Lens NoIx Sortings Sortings DictTerm DictTerm #lastEditedAtDesc) (ApplicationDictionary -> DictTerm) -> Language -> Text |##| (ViewVars vv ViewVars -> Optic' A_Lens NoIx ViewVars Language -> Language forall k s (is :: IxList) a. Is k A_Getter => s -> Optic' k is s a -> a ^. Optic' A_Lens NoIx ViewVars Language #language)), (Text "last-edited-at-asc", (ApplicationDictionary -> Optic' A_Lens NoIx ApplicationDictionary DictTerm -> DictTerm forall k s (is :: IxList) a. Is k A_Getter => s -> Optic' k is s a -> a ^. Optic A_Lens NoIx ApplicationDictionary ApplicationDictionary Sortings Sortings #sortings Optic A_Lens NoIx ApplicationDictionary ApplicationDictionary Sortings Sortings -> Optic A_Lens NoIx Sortings Sortings DictTerm DictTerm -> Optic' A_Lens NoIx ApplicationDictionary DictTerm forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a b. (JoinKinds k l m, AppendIndices is js ks) => Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b % Optic A_Lens NoIx Sortings Sortings DictTerm DictTerm #lastEditedAtAsc) (ApplicationDictionary -> DictTerm) -> Language -> Text |##| (ViewVars vv ViewVars -> Optic' A_Lens NoIx ViewVars Language -> Language forall k s (is :: IxList) a. Is k A_Getter => s -> Optic' k is s a -> a ^. Optic' A_Lens NoIx ViewVars Language #language)) ] requiredTextInput :: Text -> Text -> Html requiredTextInput :: Text -> Text -> Html requiredTextInput Text name' Text displayLabel = Text -> Maybe Text -> Bool -> AttributeValue -> Maybe Text -> Html formInput Text name' (Text -> Maybe Text forall a. a -> Maybe a Just Text displayLabel) Bool True AttributeValue "text" Maybe Text forall a. Maybe a Nothing searchInput :: Text -> Html searchInput :: Text -> Html searchInput Text name' = Text -> Maybe Text -> Bool -> AttributeValue -> Maybe Text -> Html formInput Text name' Maybe Text forall a. Maybe a Nothing Bool True AttributeValue "text" Maybe Text forall a. Maybe a Nothing requiredTextInput' :: Text -> Text -> Maybe Text -> Html requiredTextInput' :: Text -> Text -> Maybe Text -> Html requiredTextInput' Text name' Text displayLabel = Text -> Maybe Text -> Bool -> AttributeValue -> Maybe Text -> Html formInput Text name' (Text -> Maybe Text forall a. a -> Maybe a Just Text displayLabel) Bool True AttributeValue "text" requiredTextArea :: Text -> Text -> Html requiredTextArea :: Text -> Text -> Html requiredTextArea Text name' Text displayLabel = Text -> Maybe Text -> Bool -> Bool -> AttributeValue -> Maybe Text -> Html formArea Text name' (Text -> Maybe Text forall a. a -> Maybe a Just Text displayLabel) Bool True Bool False AttributeValue "text" Maybe Text forall a. Maybe a Nothing requiredTextArea' :: Text -> Text -> Maybe Text -> Html requiredTextArea' :: Text -> Text -> Maybe Text -> Html requiredTextArea' Text name' Text displayLabel = Text -> Maybe Text -> Bool -> Bool -> AttributeValue -> Maybe Text -> Html formArea Text name' (Text -> Maybe Text forall a. a -> Maybe a Just Text displayLabel) Bool True Bool False AttributeValue "text" requiredMonoArea :: Text -> Text -> Html requiredMonoArea :: Text -> Text -> Html requiredMonoArea Text name' Text displayLabel = Text -> Maybe Text -> Bool -> Bool -> AttributeValue -> Maybe Text -> Html formArea Text name' (Text -> Maybe Text forall a. a -> Maybe a Just Text displayLabel) Bool True Bool True AttributeValue "text" Maybe Text forall a. Maybe a Nothing requiredMonoArea' :: Text -> Text -> Maybe Text -> Html requiredMonoArea' :: Text -> Text -> Maybe Text -> Html requiredMonoArea' Text name' Text displayLabel = Text -> Maybe Text -> Bool -> Bool -> AttributeValue -> Maybe Text -> Html formArea Text name' (Text -> Maybe Text forall a. a -> Maybe a Just Text displayLabel) Bool True Bool True AttributeValue "text" optionalTextInput :: Text -> Text -> Html optionalTextInput :: Text -> Text -> Html optionalTextInput Text name' Text displayLabel = Text -> Maybe Text -> Bool -> AttributeValue -> Maybe Text -> Html formInput Text name' (Text -> Maybe Text forall a. a -> Maybe a Just Text displayLabel) Bool False AttributeValue "text" Maybe Text forall a. Maybe a Nothing optionalTextInput' :: Text -> Text -> Maybe Text -> Html optionalTextInput' :: Text -> Text -> Maybe Text -> Html optionalTextInput' Text name' Text displayLabel = Text -> Maybe Text -> Bool -> AttributeValue -> Maybe Text -> Html formInput Text name' (Text -> Maybe Text forall a. a -> Maybe a Just Text displayLabel) Bool False AttributeValue "text" optionalTextArea :: Text -> Text -> Html optionalTextArea :: Text -> Text -> Html optionalTextArea Text name' Text displayLabel = Text -> Maybe Text -> Bool -> Bool -> AttributeValue -> Maybe Text -> Html formArea Text name' (Text -> Maybe Text forall a. a -> Maybe a Just Text displayLabel) Bool False Bool False AttributeValue "text" Maybe Text forall a. Maybe a Nothing optionalTextArea' :: Text -> Text -> Maybe Text -> Html optionalTextArea' :: Text -> Text -> Maybe Text -> Html optionalTextArea' Text name' Text displayLabel = Text -> Maybe Text -> Bool -> Bool -> AttributeValue -> Maybe Text -> Html formArea Text name' (Text -> Maybe Text forall a. a -> Maybe a Just Text displayLabel) Bool False Bool False AttributeValue "text" optionalMonoArea :: Text -> Text -> Html optionalMonoArea :: Text -> Text -> Html optionalMonoArea Text name' Text displayLabel = Text -> Maybe Text -> Bool -> Bool -> AttributeValue -> Maybe Text -> Html formArea Text name' (Text -> Maybe Text forall a. a -> Maybe a Just Text displayLabel) Bool False Bool True AttributeValue "text" Maybe Text forall a. Maybe a Nothing optionalMonoArea' :: Text -> Text -> Maybe Text -> Html optionalMonoArea' :: Text -> Text -> Maybe Text -> Html optionalMonoArea' Text name' Text displayLabel = Text -> Maybe Text -> Bool -> Bool -> AttributeValue -> Maybe Text -> Html formArea Text name' (Text -> Maybe Text forall a. a -> Maybe a Just Text displayLabel) Bool False Bool True AttributeValue "text" requiredEmailInput :: Text -> Text -> Html requiredEmailInput :: Text -> Text -> Html requiredEmailInput Text name' Text displayLabel = Text -> Maybe Text -> Bool -> AttributeValue -> Maybe Text -> Html formInput Text name' (Text -> Maybe Text forall a. a -> Maybe a Just Text displayLabel) Bool True AttributeValue "email" Maybe Text forall a. Maybe a Nothing requiredPasswordInput :: Text -> Text -> Html requiredPasswordInput :: Text -> Text -> Html requiredPasswordInput Text name' Text displayLabel = Text -> Maybe Text -> Bool -> AttributeValue -> Maybe Text -> Html formInput Text name' (Text -> Maybe Text forall a. a -> Maybe a Just Text displayLabel) Bool True AttributeValue "password" Maybe Text forall a. Maybe a Nothing optionalFileInput :: Text -> Text -> Html optionalFileInput :: Text -> Text -> Html optionalFileInput Text name' Text displayLabel = Html -> Html H.div (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ do Html -> Html H.div (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ Html -> Html H.label (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute A.for AttributeValue name'' (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ Text -> Html text Text displayLabel Html H.input Html -> Attribute -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute class_ AttributeValue "rounded-2xl px-10 py-6 font-mono" Html -> Attribute -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute A.name AttributeValue name'' Html -> Attribute -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute A.id AttributeValue name'' Html -> Attribute -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute type_ AttributeValue "file" where name'' :: AttributeValue name'' = Text -> AttributeValue textToAttrValue Text name' formInput :: Text -> Maybe Text -> Bool -> AttributeValue -> Maybe Text -> Html formInput :: Text -> Maybe Text -> Bool -> AttributeValue -> Maybe Text -> Html formInput Text name' Maybe Text displayLabel Bool isRequired AttributeValue type' Maybe Text content' = Html -> Html H.div (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ do Html -> Html H.div (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ do (Text -> Html) -> Maybe Text -> Html forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ ((Html -> Html H.label (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute A.for AttributeValue name'') (Html -> Html) -> (Text -> Html) -> Text -> Html forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> Html text) Maybe Text displayLabel (Text -> Html) -> Maybe Text -> Html forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ (\Text _ -> (Html -> Html) -> Maybe Html -> Html forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ (Html -> Html H.span (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! [Text] -> Attribute css' [Text "font-bold"]) (if Bool isRequired then Html -> Maybe Html forall a. a -> Maybe a Just Html "*" else Maybe Html forall a. Maybe a Nothing)) Maybe Text displayLabel Html H.input Html -> Attribute -> Html forall h. Attributable h => h -> Attribute -> h ! Set Text -> Attribute css Set Text cssInput Html -> (Bool, Attribute) -> Html forall h. Attributable h => h -> (Bool, Attribute) -> h H.!? (Bool isRequired, AttributeValue -> Attribute required AttributeValue "") Html -> Attribute -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute A.name AttributeValue name'' Html -> Attribute -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute A.id AttributeValue name'' Html -> Attribute -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute type_ AttributeValue type' Html -> Attribute -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute A.value (Text -> AttributeValue textToAttrValue (Text -> AttributeValue) -> Text -> AttributeValue forall a b. (a -> b) -> a -> b $ Text -> Maybe Text -> Text forall a. a -> Maybe a -> a fromMaybe Text "" Maybe Text content') where name'' :: AttributeValue name'' = Text -> AttributeValue textToAttrValue Text name' formArea :: Text -> Maybe Text -> Bool -> Bool -> AttributeValue -> Maybe Text -> Html formArea :: Text -> Maybe Text -> Bool -> Bool -> AttributeValue -> Maybe Text -> Html formArea Text name' Maybe Text displayLabel Bool isRequired Bool isMono AttributeValue type' Maybe Text content' = do let optionalMonoCss :: Set Text optionalMonoCss = [Item (Set Text)] -> Set Text forall l. IsList l => [Item l] -> l fromList [if Bool isMono then Text Item (Set Text) "font-mono" else Text Item (Set Text) "font-mono"] :: Set Text Html -> Html H.div (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ do Html -> Html H.div (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ do (Text -> Html) -> Maybe Text -> Html forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ ((Html -> Html H.label (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute A.for AttributeValue name'') (Html -> Html) -> (Text -> Html) -> Text -> Html forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> Html text) Maybe Text displayLabel (Html -> Html) -> Maybe Html -> Html forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ (Html -> Html H.span (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute class_ AttributeValue "color-error") (if Bool isRequired then Html -> Maybe Html forall a. a -> Maybe a Just Html "*" else Maybe Html forall a. Maybe a Nothing) Html -> Html H.textarea (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! Set Text -> Attribute css (Set Text cssTextarea Set Text -> Set Text -> Set Text forall a. Ord a => Set a -> Set a -> Set a `setUnion` Set Text optionalMonoCss) (Html -> Html) -> (Bool, Attribute) -> Html -> Html forall h. Attributable h => h -> (Bool, Attribute) -> h H.!? (Bool isRequired, AttributeValue -> Attribute required AttributeValue "") (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute A.name AttributeValue name'' (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute A.id AttributeValue name'' (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute type_ AttributeValue type' (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ Text -> Html text (Text -> Maybe Text -> Text forall a. a -> Maybe a -> a fromMaybe Text "" Maybe Text content') where name'' :: AttributeValue name'' = Text -> AttributeValue textToAttrValue Text name' deleteButton :: ViewVars -> Html deleteButton :: ViewVars -> Html deleteButton ViewVars vv = Html -> Html button (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! Set Text -> Attribute css (ViewVars -> Set Text cssButton ViewVars vv) (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute type_ AttributeValue "submit" (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ Text -> Html text (Text -> Html) -> Text -> Html forall a b. (a -> b) -> a -> b $ (ApplicationDictionary -> Optic' A_Lens NoIx ApplicationDictionary DictTerm -> DictTerm forall k s (is :: IxList) a. Is k A_Getter => s -> Optic' k is s a -> a ^. Optic A_Lens NoIx ApplicationDictionary ApplicationDictionary Forms Forms #forms Optic A_Lens NoIx ApplicationDictionary ApplicationDictionary Forms Forms -> Optic A_Lens NoIx Forms Forms DictTerm DictTerm -> Optic' A_Lens NoIx ApplicationDictionary DictTerm forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a b. (JoinKinds k l m, AppendIndices is js ks) => Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b % Optic A_Lens NoIx Forms Forms DictTerm DictTerm #delete) (ApplicationDictionary -> DictTerm) -> Language -> Text |##| (ViewVars vv ViewVars -> Optic' A_Lens NoIx ViewVars Language -> Language forall k s (is :: IxList) a. Is k A_Getter => s -> Optic' k is s a -> a ^. Optic' A_Lens NoIx ViewVars Language #language) submitButton :: ViewVars -> Html submitButton :: ViewVars -> Html submitButton ViewVars vv = Html -> Html button (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! Set Text -> Attribute css Set Text cssSubmitButton (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute type_ AttributeValue "submit" (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ do Html -> Html H.span Html "✓" Text -> Html text (Text -> Html) -> Text -> Html forall a b. (a -> b) -> a -> b $ (ApplicationDictionary -> Optic' A_Lens NoIx ApplicationDictionary DictTerm -> DictTerm forall k s (is :: IxList) a. Is k A_Getter => s -> Optic' k is s a -> a ^. Optic A_Lens NoIx ApplicationDictionary ApplicationDictionary Forms Forms #forms Optic A_Lens NoIx ApplicationDictionary ApplicationDictionary Forms Forms -> Optic A_Lens NoIx Forms Forms DictTerm DictTerm -> Optic' A_Lens NoIx ApplicationDictionary DictTerm forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a b. (JoinKinds k l m, AppendIndices is js ks) => Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b % Optic A_Lens NoIx Forms Forms DictTerm DictTerm #submit) (ApplicationDictionary -> DictTerm) -> Language -> Text |##| (ViewVars vv ViewVars -> Optic' A_Lens NoIx ViewVars Language -> Language forall k s (is :: IxList) a. Is k A_Getter => s -> Optic' k is s a -> a ^. Optic' A_Lens NoIx ViewVars Language #language) submitButton' :: ViewVars -> Html submitButton' :: ViewVars -> Html submitButton' ViewVars vv = Html -> Html button (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! Set Text -> Attribute css Set Text cssSubmitButton (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute type_ AttributeValue "submit" (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ do Html -> Html H.span Html "✓" Text -> Html text (Text -> Html) -> Text -> Html forall a b. (a -> b) -> a -> b $ (ApplicationDictionary -> Optic' A_Lens NoIx ApplicationDictionary DictTerm -> DictTerm forall k s (is :: IxList) a. Is k A_Getter => s -> Optic' k is s a -> a ^. Optic A_Lens NoIx ApplicationDictionary ApplicationDictionary Forms Forms #forms Optic A_Lens NoIx ApplicationDictionary ApplicationDictionary Forms Forms -> Optic A_Lens NoIx Forms Forms DictTerm DictTerm -> Optic' A_Lens NoIx ApplicationDictionary DictTerm forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a b. (JoinKinds k l m, AppendIndices is js ks) => Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b % Optic A_Lens NoIx Forms Forms DictTerm DictTerm #submit) (ApplicationDictionary -> DictTerm) -> Language -> Text |##| (ViewVars vv ViewVars -> Optic' A_Lens NoIx ViewVars Language -> Language forall k s (is :: IxList) a. Is k A_Getter => s -> Optic' k is s a -> a ^. Optic' A_Lens NoIx ViewVars Language #language) submitButtonNoText :: Html submitButtonNoText :: Html submitButtonNoText = Html -> Html button (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! [Text] -> Attribute css' [Text "transparent", Text "text-3xl", Text "px-4"] (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute type_ AttributeValue "submit" (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ Html -> Html H.span Html "🔍" dangerPostForm :: ViewVars -> Text -> Html -> Html dangerPostForm :: ViewVars -> Text -> Html -> Html dangerPostForm ViewVars vv Text action' = Html -> Html H.form (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute method AttributeValue "POST" (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute action (Text -> AttributeValue textToAttrValue Text action') (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute enctype AttributeValue "multipart/form-data" (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute onsubmit (Text -> AttributeValue textToAttrValue (Text -> AttributeValue) -> Text -> AttributeValue forall a b. (a -> b) -> a -> b $ Text "alert('" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> ((ApplicationDictionary -> Optic' A_Lens NoIx ApplicationDictionary DictTerm -> DictTerm forall k s (is :: IxList) a. Is k A_Getter => s -> Optic' k is s a -> a ^. Optic A_Lens NoIx ApplicationDictionary ApplicationDictionary More More #more Optic A_Lens NoIx ApplicationDictionary ApplicationDictionary More More -> Optic A_Lens NoIx More More DictTerm DictTerm -> Optic' A_Lens NoIx ApplicationDictionary DictTerm forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a b. (JoinKinds k l m, AppendIndices is js ks) => Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b % Optic A_Lens NoIx More More DictTerm DictTerm #irreversibleAction) (ApplicationDictionary -> DictTerm) -> Language -> Text |##| (ViewVars vv ViewVars -> Optic' A_Lens NoIx ViewVars Language -> Language forall k s (is :: IxList) a. Is k A_Getter => s -> Optic' k is s a -> a ^. Optic' A_Lens NoIx ViewVars Language #language)) Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "')") postForm :: Text -> Html -> Html postForm :: Text -> Html -> Html postForm Text action' = Html -> Html H.form (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute method AttributeValue "POST" (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute action (Text -> AttributeValue textToAttrValue Text action') (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute enctype AttributeValue "multipart/form-data" postForm' :: Text -> [Text] -> Html -> Html postForm' :: Text -> [Text] -> Html -> Html postForm' Text action' [Text] class' = Html -> Html H.form (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! [Text] -> Attribute css' [Text] class' (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute method AttributeValue "POST" (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute action (Text -> AttributeValue textToAttrValue Text action') (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute enctype AttributeValue "multipart/form-data" searchForm :: Text -> Html -> Html searchForm :: Text -> Html -> Html searchForm Text action' = Html -> Html H.form (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute class_ (Text -> AttributeValue textToAttrValue Text "margin-top-medium flex direction-row align-items-flex-end no-gap") (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute method AttributeValue "POST" (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute action (Text -> AttributeValue textToAttrValue Text action') (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute enctype AttributeValue "multipart/form-data" entityArtworkForm :: ViewVars -> Text -> [Artwork] -> Html entityArtworkForm :: ViewVars -> Text -> [Artwork] -> Html entityArtworkForm ViewVars vv Text path [Artwork] xs = Html -> Html section (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ do Bool -> Html -> Html forall (f :: * -> *). Applicative f => Bool -> f () -> f () unless ([Artwork] -> Bool forall a. [a] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [Artwork] xs) (Html hr Html -> Html -> Html forall a b. MarkupM a -> MarkupM b -> MarkupM b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> (Html -> Html H.h2 (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute A.id AttributeValue "edit-artwork" (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ Html "Edit artwork")) Html -> Html H.div (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ do let arts :: [Artwork] arts = (Artwork -> Artwork -> Ordering) -> [Artwork] -> [Artwork] forall a. (a -> a -> Ordering) -> [a] -> [a] sortBy (\Artwork x Artwork y -> Int -> Int -> Ordering forall a. Ord a => a -> a -> Ordering compare (Artwork x Artwork -> Optic' A_Lens NoIx Artwork Int -> Int forall k s (is :: IxList) a. Is k A_Getter => s -> Optic' k is s a -> a ^. Optic' A_Lens NoIx Artwork Int #orderValue) (Artwork y Artwork -> Optic' A_Lens NoIx Artwork Int -> Int forall k s (is :: IxList) a. Is k A_Getter => s -> Optic' k is s a -> a ^. Optic' A_Lens NoIx Artwork Int #orderValue)) [Artwork] xs (Artwork -> Html) -> [Artwork] -> Html forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ (ViewVars -> Text -> Artwork -> Html mkArtworkManager ViewVars vv Text path) [Artwork] arts mkArtworkManager :: ViewVars -> Text -> Artwork -> Html mkArtworkManager :: ViewVars -> Text -> Artwork -> Html mkArtworkManager ViewVars vv Text path Artwork artwork = Html -> Html H.div (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! [Text] -> Attribute css' [Text "flex", Text "flex-col", Text "flex-wrap", Text "justify-center", Text "w-64"] (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ do Html img Html -> Attribute -> Html forall h. Attributable h => h -> Attribute -> h ! [Text] -> Attribute css' [Text "object-cover", Text "w-64", Text "h-auto", Text "rounded-2xl"] Html -> Attribute -> Html forall h. Attributable h => h -> Attribute -> h ! Tag -> AttributeValue -> Attribute customAttribute Tag "loading" AttributeValue "lazy" Html -> Attribute -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute src (Text -> AttributeValue textToAttrValue (Text -> AttributeValue) -> Text -> AttributeValue forall a b. (a -> b) -> a -> b $ Artwork artwork Artwork -> Optic' A_Lens NoIx Artwork Text -> Text forall k s (is :: IxList) a. Is k A_Getter => s -> Optic' k is s a -> a ^. Optic' A_Lens NoIx Artwork Text #contentUrl) (Text -> Html) -> Maybe Text -> Html forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ (Html -> Html H.span (Html -> Html) -> (Text -> Html) -> Text -> Html forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> Html text) (Artwork artwork Artwork -> Optic' A_Lens NoIx Artwork (Maybe Text) -> Maybe Text forall k s (is :: IxList) a. Is k A_Getter => s -> Optic' k is s a -> a ^. Optic' A_Lens NoIx Artwork (Maybe Text) #contentCaption) Html -> Html H.div (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! [Text] -> Attribute css' [Text "flex", Text "flex-row", Text "flex-wrap", Text "justify-center", Text "gap-4"] (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ do Text -> Html -> Html postForm (Text "/" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text path Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "/artworks/order/" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> UUID -> Text uuidToText (Artwork artwork Artwork -> Optic' A_Lens NoIx Artwork UUID -> UUID forall k s (is :: IxList) a. Is k A_Getter => s -> Optic' k is s a -> a ^. Optic' A_Lens NoIx Artwork UUID #identifier)) (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ do Html input Html -> Attribute -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute type_ AttributeValue "hidden" Html -> Attribute -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute name AttributeValue "orderValue" Html -> Attribute -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute A.value (Text -> AttributeValue textToAttrValue Text plusOne) Html -> Html button (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! Set Text -> Attribute css (ViewVars -> Set Text cssButton ViewVars vv) (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute type_ AttributeValue "submit" (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ Html -> Html small (Html -> Html) -> (Text -> Html) -> Text -> Html forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> Html text (Text -> Html) -> Text -> Html forall a b. (a -> b) -> a -> b $ Text plusOne Text -> Html -> Html postForm (Text "/" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text path Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "/artworks/order/" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> UUID -> Text uuidToText (Artwork artwork Artwork -> Optic' A_Lens NoIx Artwork UUID -> UUID forall k s (is :: IxList) a. Is k A_Getter => s -> Optic' k is s a -> a ^. Optic' A_Lens NoIx Artwork UUID #identifier)) (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ do Html input Html -> Attribute -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute type_ AttributeValue "hidden" Html -> Attribute -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute name AttributeValue "orderValue" Html -> Attribute -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute A.value (Text -> AttributeValue textToAttrValue Text minusOne) Html -> Html button (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! Set Text -> Attribute css (ViewVars -> Set Text cssButton ViewVars vv) (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute type_ AttributeValue "submit" (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ Html -> Html small (Html -> Html) -> (Text -> Html) -> Text -> Html forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> Html text (Text -> Html) -> Text -> Html forall a b. (a -> b) -> a -> b $ Text minusOne Html -> Html H.div (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! [Text] -> Attribute css' [] (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ ViewVars -> Text -> Html -> Html dangerPostForm ViewVars vv ( Text "/" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text path Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "/artworks/delete/" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> UUID -> Text uuidToText (Artwork artwork Artwork -> Optic' A_Lens NoIx Artwork UUID -> UUID forall k s (is :: IxList) a. Is k A_Getter => s -> Optic' k is s a -> a ^. Optic' A_Lens NoIx Artwork UUID #identifier) ) (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ Html -> Html button (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! Set Text -> Attribute css Set Text cssSubmitButton (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute type_ AttributeValue "submit" (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ Html -> Html small (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ Text -> Text -> Html simpleIcon Text "❌" Text "delete" where plusOne :: Text plusOne = Int -> Text intToText (Int -> Text) -> Int -> Text forall a b. (a -> b) -> a -> b $ Artwork artwork Artwork -> Optic' A_Lens NoIx Artwork Int -> Int forall k s (is :: IxList) a. Is k A_Getter => s -> Optic' k is s a -> a ^. Optic' A_Lens NoIx Artwork Int #orderValue Int -> Int -> Int forall a. Num a => a -> a -> a + Int 1 minusOne :: Text minusOne = if Artwork artwork Artwork -> Optic' A_Lens NoIx Artwork Int -> Int forall k s (is :: IxList) a. Is k A_Getter => s -> Optic' k is s a -> a ^. Optic' A_Lens NoIx Artwork Int #orderValue Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int 1 then Text "0" else Int -> Text intToText (Int -> Text) -> Int -> Text forall a b. (a -> b) -> a -> b $ Artwork artwork Artwork -> Optic' A_Lens NoIx Artwork Int -> Int forall k s (is :: IxList) a. Is k A_Getter => s -> Optic' k is s a -> a ^. Optic' A_Lens NoIx Artwork Int #orderValue Int -> Int -> Int forall a. Num a => a -> a -> a - Int 1 entityNewArtworkForm :: ViewVars -> Text -> UUID -> Html entityNewArtworkForm :: ViewVars -> Text -> UUID -> Html entityNewArtworkForm ViewVars vv Text path UUID identifier = do Html -> Html H.h2 Html "New artwork" Text -> Html -> Html postForm (Text "/" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text path Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "/artworks/create/" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> UUID -> Text uuidToText UUID identifier) (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ do Text -> Text -> Html requiredTextInput Text "contentUrl" Text "url" Text -> Text -> Html optionalTextInput Text "contentCaption" Text "caption" Text -> Text -> Maybe Text -> Html requiredTextInput' Text "orderValue" Text "position" (Text -> Maybe Text forall a. a -> Maybe a Just Text "0") ViewVars -> Html submitButton ViewVars vv