[Fencommits] fenserve: some csv importing code
Benja Fallenstein
benja.fallenstein at gmail.com
Sat Jun 9 06:04:32 EEST 2007
Sat Jun 9 06:04:17 EEST 2007 Benja Fallenstein <benja.fallenstein at gmail.com>
* some csv importing code
diff -rN -u old-fenserve/fendata/Main.hs new-fenserve/fendata/Main.hs
--- old-fenserve/fendata/Main.hs 2007-06-09 06:04:31.000000000 +0300
+++ new-fenserve/fendata/Main.hs 2007-06-09 06:04:31.000000000 +0300
@@ -1,4 +1,97 @@
+{-# OPTIONS_GHC -fglasgow-exts -fno-monomorphism-restriction #-}
import Potions
+import Types
+import HTML
+import Utils
-main = print "Hello world!"
+import CSV
+
+import HAppS
+import Control.Monad.State
+import qualified Control.Exception
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import qualified System.IO.Unsafe
+
+main = stdHTTP [ debugFilter
+ , h (Prefix ()) () $ \(path::[String]) req -> do
+ getTime -> time; get -> state :: DB
+ let ?time = time; ?state = state; ?db = state; ?req = req
+ ?root = concatMap (const "../") $ drop 1 path
+ runServerParts [app] req
+ ]
+
+hl = bold . ital -- highlight, actual style might change in the future
+
+evaluate x = System.IO.Unsafe.unsafePerformIO $ Control.Exception.catch
+ (Control.Exception.evaluate (length (show x) `seq` Right x))
+ (\e -> return $ Left e)
+
+page path _ content = h (path :: [String]) GET $ ok $ \() () -> respond $
+ case evaluate (html content) of
+ Right s -> s; Left e -> "Internal server error: " ++ show e
+
+runPost path target m = h (path :: [String]) POST $ seeOther $ \() () ->
+ case evaluate (target, execState m ?state) of
+ Right (uri,state') -> put state' >> respond (uri, uri)
+ Left e -> respond ("", "Internal server error: " ++ show e)
+
+app = multi
+ [ page [""] "Welcome to Fenlight!"
+ ( h2 "A more practical way to store your data than in Excel"
+ , para ( "We are building here a better place for the data you might "
+ , "currently store in Excel: your contacts, your sales data, "
+ , "your article submissions. We give you new powers to "
+ , "customize how you view and speak about these on the computer."
+
+ , "examples, generality and customizability, free!!!, "
+ , "hope that everybody will use it, many views, teach it to do "
+ , "repetitive things "
+ )
+ , h3 "Why you should store your data in an online database"
+ , para "many views"
+ , para "accessible from anywhere"
+ , para "collaboration"
+ , para "data is safe"
+ , h3 "Why you might want to use Fenlight"
+ , para "make it speak your language (own defns for analytics)"
+ , para "workflow"
+ , para "complex actions"
+ , para "(no email yet -- need to prevent spam)"
+ , para "versioning"
+ , para "price"
+ , h3 ( "Why you might ", ital "not", " want to use Fenlight yet" )
+ , para "no import yet"
+ , para "can't download your data yet"
+ , para ( hl ( "We're fallible (problem likely to remain "
+ , "in future versions of Fenlight)." ) )
+ , para "** Sign-up link **" )
+
+ , page ["import"] "Import"
+ ( h2 "Import CSV"
+ , formP ""
+ ( para $ "Category name: " & textfield "catName" ""
+ , para "Paste CSV here:"
+ , para $ textarea "csv" 10 80 ""
+ , submit "Submit" ) )
+
+ , runPost ["import"] "/table" $ do
+ cat <- new_category $ lookE "catName"
+ let fieldNames : rows = parseCSV $ lookE "csv"
+ fields <- forM fieldNames $ \n -> new_field n cat $ Single InlineType
+ forM_ rows $ \r -> do
+ item <- new_item $ Set.singleton cat
+ forM_ (zip fields r) $ \(field, value) ->
+ modify $ u_value item field [InlineValue value]
+
+ , page ["table"] "Table"
+ ( h2 "Table of all data in the database (if any)"
+ , catFor (Map.elems $ dbCategories ?db) $ \(Category cat name fs) ->
+ ( h3 ("Category ", name)
+ , tag "table" [P "border" "1"]
+ ( tag "tr" [] $ catFor fs $ tag "th" [] . fieldName . getField
+ , catFor (getItems cat) $ \(Item _ _ vs) ->
+ ( tag "tr" [] $ catFor fs $ \f ->
+ tag "td" [] $ renderValues $ Map.findWithDefault [] f vs))))
+ ]
diff -rN -u old-fenserve/fendata/Types.hs new-fenserve/fendata/Types.hs
--- old-fenserve/fendata/Types.hs 2007-06-09 06:04:31.000000000 +0300
+++ new-fenserve/fendata/Types.hs 2007-06-09 06:04:31.000000000 +0300
@@ -5,6 +5,8 @@
import HTML
import Utils
+import HAppS (StartState, startStateM)
+
import Control.Monad.Reader (Reader)
import Control.Monad.State
@@ -59,6 +61,15 @@
dbFields :: Map FieldId Field,
dbItems :: Map ItemId Item }
deriving (Read, Show, Typeable, Data, Eq, Ord)
+
+instance StartState DB where
+ startStateM = return $ DB Map.empty Map.empty Map.empty
+
+
+
+----------------------------------------------------------------------------
+-- Accessor and update functions
+----------------------------------------------------------------------------
getCategory cat = dbCategories ?db Map.! cat
getField field = dbFields ?db Map.! field
@@ -86,15 +97,18 @@
u_field x f = u_dbFields $ Map.adjust f x
u_item x f = u_dbItems $ Map.adjust f x
+u_value item field value = u_item item $ u_itemValues $ Map.insert field value
+
new :: a -> State (Map Id a) Id
new x = State $ \m -> let i = if Map.null m then 0 else fst (Map.findMax m) + 1
in (i, Map.insert i x m)
-new_cat name = mfix $ \cat -> mdo
+new_category name = mfix $ \cat -> do
field <- new_field "Name" cat $ Single InlineType
inside dbCategories u_dbCategories $ new $ Category cat name [field]
-new_field name cat ty = mfix $ \field ->
+new_field name cat ty = mfix $ \field -> do
+ modify $ u_cat cat $ u_catFields $ (++[field])
inside dbFields u_dbFields $ new $ Field field name cat ty
new_item cats = mfix $ \item ->
diff -rN -u old-fenserve/fendata/Utils.hs new-fenserve/fendata/Utils.hs
--- old-fenserve/fendata/Utils.hs 2007-06-09 06:04:31.000000000 +0300
+++ new-fenserve/fendata/Utils.hs 2007-06-09 06:04:31.000000000 +0300
@@ -82,7 +82,7 @@
uncapitalize "" = ""
plural s | last s == 'y' = init s ++ "ies"
- | last s == 's' = init s ++ "es"
+ | last s == 's' = s ++ "es"
| otherwise = s ++ "s"
mdot = style "margin-left: 0.5em; margin-right: 0.5em; font-weight: bold" $
More information about the Fencommits
mailing list