DataImportServer: configurable parsers

app/Main.hs

@@ -10,6 +10,8 @@ import Data.IORef
 import Graphics.UI.Gtk hiding (Action, backspace)
 import Control.Concurrent.BoundedChan
 import Data.ATrade
+import QuoteSource.TableParsers.AllParamsTableParser
+import QuoteSource.TableParser
 
 callback :: DdeCallback
 callback = undefined
@@ -20,7 +22,7 @@ main = do
   forkIO $ forever $ do
     tick <- readChan chan
     when (datatype tick == Price) $ print tick
-  dis <- initDataImportServer chan "atrade"
+  dis <- initDataImportServer [MkTableParser $ mkAllParamsTableParser "allparams"] chan "atrade"
   void initGUI
   window <- windowNew
   window `on` deleteEvent $ do

quik-connector.cabal

@@ -19,6 +19,8 @@ library
                      , QuoteSource.DDE
                      , QuoteSource.DataImport
                      , Data.ATrade
+                     , QuoteSource.TableParser
+                     , QuoteSource.TableParsers.AllParamsTableParser
   ghc-options:         -Wincomplete-patterns
   build-depends:       base >= 4.7 && < 5
                      , Win32
@@ -37,8 +39,6 @@ library
   default-language:    Haskell2010
   extra-libraries:     "user32"
   other-modules:       QuoteSource.XlParser
-                     , QuoteSource.TableParser
-                     , QuoteSource.TableParsers.AllParamsTableParser
 
 executable quik-connector-exe
   hs-source-dirs:      app

src/QuoteSource/DataImport.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE ExistentialQuantification #-}
 
 module QuoteSource.DataImport
 (
@@ -14,13 +13,10 @@ import Data.IORef
 import Data.Time.Clock
 import QuoteSource.DDE
 import QuoteSource.TableParser
-import QuoteSource.TableParsers.AllParamsTableParser
 import QuoteSource.XlParser
 
 import qualified Data.Map as M
 
-data TableParserInstance = forall a . TableParser a => MkTableParser a
-
 data ServerState = ServerState {
   appName :: String,
   parsers :: IORef (M.Map String TableParserInstance),
@@ -41,9 +37,9 @@ ddeCallback state topic table = do
     _ -> return False
 
 
-initDataImportServer :: BoundedChan Tick -> String -> IO (ServerState, IORef DdeState)
-initDataImportServer tickChan applicationName = do
-  parsers <- newIORef $ M.fromList $ map (\p -> (getTableId p, MkTableParser p)) [mkAllParamsTableParser "allparams"]
+initDataImportServer :: [TableParserInstance] -> BoundedChan Tick -> String -> IO (ServerState, IORef DdeState)
+initDataImportServer parsers tickChan applicationName = do
+  parsers <- newIORef $ M.fromList $ map (\(MkTableParser p) -> (getTableId p, MkTableParser p)) parsers
   let s = ServerState { appName = applicationName, parsers = parsers, tickChannel = tickChan }
   d <- initializeDde applicationName "default" (ddeCallback s)
   return (s, d)

src/QuoteSource/TableParser.hs

@@ -1,6 +1,8 @@
+{-# LANGUAGE ExistentialQuantification #-}
 
 module QuoteSource.TableParser (
-  TableParser(..)
+  TableParser(..),
+  TableParserInstance(..)
 ) where
 
 import QuoteSource.XlParser
@@ -8,6 +10,8 @@ import Data.ATrade
 import Control.Monad.State.Strict
 import Data.Time.Clock
 
+data TableParserInstance = forall a . TableParser a => MkTableParser a
+
 class TableParser a where
   parseXlTable :: (Int, Int, [XlData]) -> State a [Tick]
   giveTimestampHint :: a -> UTCTime -> a