src/Main.hs

   1 {-# LANGUAGE ScopedTypeVariables #-}
   2 {-# LANGUAGE OverloadedStrings #-}
   3
   4 module Main
   5 where
   6
   7 import Control.Monad.IO.Class  (liftIO)
   8 import Data.Maybe ( listToMaybe )
   9 import Database.Persist ( insert )
  10 import Database.Persist.Sql ( runMigration )
  11 import Database.Persist.Sqlite ( runSqlite )
  12 import Text.Show.Pretty ( ppShow )
  13 import Text.XML.HXT.Core (
  14   SysConfigList,
  15   XmlPickler,
  16   no,
  17   runX,
  18   withPreserveComment,
  19   withRemoveWS,
  20   withValidate,
  21   xpickle,
  22   xunpickleDocument,
  23   yes )
  24
  25 import TSN.Injuries ( InjuriesMessage, migrate_injuries )
  26
  27
  28 parse_opts :: SysConfigList
  29 parse_opts =
  30   [ withPreserveComment no,
  31     withRemoveWS yes,
  32     withValidate no ]
  33
  34 parse_file :: XmlPickler a => FilePath -> IO (Maybe a)
  35 parse_file path =
  36   fmap listToMaybe $
  37     runX ( xunpickleDocument xpickle parse_opts path )
  38
  39 main_sql :: IO ()
  40 main_sql =
  41   runSqlite "foo.sqlite3" $ do
  42     runMigration migrate_injuries
  43     msg :: Maybe InjuriesMessage <- liftIO $ parse_file
  44                                                "test/xml/injuriesxml.xml"
  45     case msg of
  46       Nothing -> return ()
  47       Just m  -> do
  48         msg_id <- insert m
  49         return ()
  50
  51 main :: IO ()
  52 main = do
  53   msg :: Maybe InjuriesMessage <- parse_file "test/xml/injuriesxml.xml"
  54   putStr $ ppShow msg