Commit persistent stuff.

[dead/htsn-import.git] / src / Main.hs

diff --git a/src/Main.hs b/src/Main.hs
index d2e51727f9468b58417c0ecbb7ba71cdefeef324..950a2a117a04915821042e94979b01f381a6e817 100644 (file)
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,18 +1,54 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE OverloadedStrings #-}
+
 module Main
 where
 
+import Control.Monad.IO.Class  (liftIO)
+import Data.Maybe ( listToMaybe )
+import Database.Persist ( insert )
+import Database.Persist.Sql ( runMigration )
+import Database.Persist.Sqlite ( runSqlite )
 import Text.Show.Pretty ( ppShow )
-import Text.XML.HXT.Core
+import Text.XML.HXT.Core (
+  SysConfigList,
+  XmlPickler,
+  no,
+  runX,
+  withPreserveComment,
+  withRemoveWS,
+  withValidate,
+  xpickle,
+  xunpickleDocument,
+  yes )
+
+import TSN.Injuries ( InjuriesMessage, migrate_injuries )
+
+
+parse_opts :: SysConfigList
+parse_opts =
+  [ withPreserveComment no,
+    withRemoveWS yes,
+    withValidate no ]
 
-import qualified TSN.Injuries as Injuries
+parse_file :: XmlPickler a => FilePath -> IO (Maybe a)
+parse_file path =
+  fmap listToMaybe $
+    runX ( xunpickleDocument xpickle parse_opts path )
 
+main_sql :: IO ()
+main_sql =
+  runSqlite "foo.sqlite3" $ do
+    runMigration migrate_injuries
+    msg :: Maybe InjuriesMessage <- liftIO $ parse_file
+                                               "test/xml/injuriesxml.xml"
+    case msg of
+      Nothing -> return ()
+      Just m  -> do
+        msg_id <- insert m
+        return ()
 
 main :: IO ()
 main = do
-  res <- runX ( xunpickleDocument Injuries.pickle_message
-                       [ withValidate no
-                       , withTrace 1
-                       , withRemoveWS yes
-                       , withPreserveComment no
-                       ] "test/xml/injuriesxml.xml" )
-  putStr $ ppShow res
+  msg :: Maybe InjuriesMessage <- parse_file "test/xml/injuriesxml.xml"
+  putStr $ ppShow msg