>
> module Frame.View (
> module Frame.GUI,
> module Frame.Data,
> module Database.HaskellDB.BoundedList,
> FrameView,
>
> (-.-),
> title,
> list,
> errorList,
> text,
> link,
>
> 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
>
> submitButton :: FormElement
> submitButton = Button "submit" $ WrapString Nothing "Submit"
>
> deleteLink :: URL
> -> FormElement
> deleteLink u = ButtonLink "Delete" u
>
> cancelLink :: URL
> -> FormElement
> cancelLink u = ButtonLink "Cancel" u
>
> paragraph :: Element
> -> Container
> paragraph e = Paragraph [e] []
> singleton :: a -> [a]
> singleton l = [l]
>
> list :: (a -> Container)
> -> [a]
> -> [Class]
> -> Container
> list f as cs = List (map (singleton . f) as) cs
>
> text :: String
> -> Element
> text s = Element $ Text s
>
> link :: URL
> -> String
> -> Element
> link u s = Link u $ Text s
>
> errorList :: [String]
> -> Maybe Container
> errorList [] = Nothing
> errorList es = Just $ list (\e -> paragraph $ text e) es ["error"]
>
> formField :: FieldName
> -> Label
> -> FormValue
> -> Maybe Int
> -> [String]
> -> Bool
> -> FormElement
> 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
>
> form :: Label
> -> [FormElement]
> -> [String]
> -> Container
> form l es cs = Form [
> FormGroup es l
> ] cs
>
> formGen :: FrameView m => (Table r)
> -> [FormElement]
> -> [String]
> -> m Container
> 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
>
> title :: FrameView m
> => String
> -> m Data
> -> m Data
> 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