> -- | High level view helpers > module Frame.View ( > module Frame.GUI, > module Frame.Data, > module Database.HaskellDB.BoundedList, > FrameView, > -- *** General, > (-.-), > title, > list, > errorList, > text, > link, > -- *** Forms > formGen, > form, > formField, > submitButton, > deleteLink, > cancelLink, > paragraph > ) where > import Database.HaskellDB.BoundedList > import Database.HaskellDB.DBLayout hiding (fieldName) > import Frame.Model > import Frame.State > import Frame.Config > import Frame.GUI > import Frame.Data > import Frame.Types > import Frame.Validation > import Frame.Utilities > class (FrameConfig m, FrameReader m) => FrameView m > instance (FrameConfig m, FrameReader m) => FrameView m > -- | Helper function for a submit button > submitButton :: FormElement > submitButton = Button "submit" $ WrapString Nothing "Submit" > -- | Helper function for a delete link > deleteLink :: URL -- ^ Route for deletion > -> FormElement > deleteLink u = ButtonLink "Delete" u > -- | Helper function for a cancel link > cancelLink :: URL -- ^ Route for cancelation > -> FormElement > cancelLink u = ButtonLink "Cancel" u > -- | Helper function to create a single simple element paragraph > paragraph :: Element -- ^ Element > -> Container -- ^ Paragraph > paragraph e = Paragraph [e] [] > singleton :: a -> [a] > singleton l = [l] > -- | Abstract list generator > list :: (a -> Container) -- ^ List item generator > -> [a] -- ^ Items > -> [Class] -- ^ Classes > -> Container -- ^ List > list f as cs = List (map (singleton . f) as) cs > -- | Creates element level text > text :: String -- ^ Text to use > -> Element -- ^ Element created > text s = Element $ Text s > -- | Creates a link with just a text element > link :: URL -- ^ URL to use > -> String -- ^ Text to use > -> Element -- ^ The link > link u s = Link u $ Text s > -- | Helper function for generating a potential error list > errorList :: [String] -- ^ Errors > -> Maybe Container -- ^ Error list (if errors) > errorList [] = Nothing > errorList es = Just $ list (\e -> paragraph $ text e) es ["error"] > -- | Helper function for creating a form field > formField :: FieldName > -> Label > -> FormValue -- ^ Set value of field > -> Maybe Int -- ^ Potential length restriction of the field > -> [String] -- ^ List of errors > -> Bool -- ^ Is the form field hidden? > -> FormElement -- ^ The field > formField fn f v ml@(Just l) es False = if l <= 255 then TextField fn f v ml $ errorList es else TextArea fn f v $ errorList es > formField fn f v Nothing es False = TextField fn f v Nothing $ errorList es > formField fn f v _ _ True = HiddenField fn v > -- | Helper function to create a simple form with a single group > form :: Label -- ^ Group label > -> [FormElement] -- ^ Form elements > -> [String] -- ^ Any classes > -> Container -- ^ The form > form l es cs = Form [ > FormGroup es l > ] cs > -- | Generates a form based on a database description > formGen :: FrameView m => (Table r) -- ^ The table for which the form will be gotten > -> [FormElement] -- ^ A set of form elements to append to the form > -> [String] -- ^ A set of form fields to hide/not display > -> m Container -- ^ The form > formGen t es hs = do > db <- asks database > n <- asks dbName > formGen' es hs n (tableName t) db > formGen' :: FrameView m => [FormElement] -> [String] -> String -> String -> DBInfo -> m Container > formGen' es hs d t (DBInfo {dbname=n, tbls=ts}) > = if (d == n) then > formGenTbl es hs d t ts > else > return $ paragraph $ text "Database not found" > formGenTbl :: FrameView m => [FormElement] -> [String] -> String -> String -> [TInfo] -> m Container > formGenTbl es hs d t [] = return $ paragraph $ text "Table not found" > formGenTbl es hs d t ((TInfo {tname=tn, cols=cs}):ts) > = if (t == tn) then > do > cs <- formGenCol hs d t cs > return $ form t (cs ++ es) [t] > else > formGenTbl es hs d t ts > formGenCol :: FrameView m => [String] -> String -> String -> [CInfo] -> m [FormElement] > formGenCol hs d t [] = return [] > formGenCol hs d t ((CInfo {cname=n, descr=(ty,_)}):cs') = do > cs <- formGenCol hs d t cs' > mf <- getField $ fieldName t n > mv <- getValidator $ fieldName t n > case mf of > Just f -> return $ (formField (fieldName t n) (humaniseCamel n) f (maxLen ty) (errors mv f) $ hide n):cs > Nothing -> return $ if hide n then cs else (formField (fieldName t n) (humaniseCamel n) (WrapEmpty StringT) (maxLen ty) [] False):cs > where > errors (Just v) f = map fromJust $ filter isJust $ validateField v f > errors Nothing _ = [] > maxLen (BStrT n) = Just n > maxLen _ = Nothing > hide n = elem (fieldName t n) $ (fieldName t "id"):hs > -- | The 'title' function wraps a ViewPart in a View if not an Ajax request > title :: FrameView m > => String -- ^ The title of the View > -> m Data -- ^ The ViewPart to wrap > -> m Data -- ^ The resulting Data type > title t d = do > a <- gets ajax > c <- asks css > case a of > True -> d > False -> do > d' <- d > return $ title' t c d' > title' :: String -> [String] -> Data -> Data > title' t c (ViewPart cs) = View $ Frame t c cs > title' _ _ d = d