Almost done, just hung up on learning conduit

2 files changed, 221 insertions, 0 deletions

diff --git a/verve-wireless/README.org b/verve-wireless/README.org
new file mode 100644
index 0000000..5ad3862
--- /dev/null
+++ b/verve-wireless/README.org
@@ -0,0 +1,2 @@
+See [[file:software-challenge/README.md::#%20Challenge%20for%20Software%20Engineer%20or%20Frontend%20Engineer][software-challenge/README.md]]
+
diff --git a/verve-wireless/main.hs b/verve-wireless/main.hs
new file mode 100755
index 0000000..9e9fb56
--- /dev/null
+++ b/verve-wireless/main.hs
@@ -0,0 +1,219 @@
+#!/usr/bin/env stack
+{- stack
+     --nix
+     --resolver lts-10.3
+     --install-ghc
+     runghc
+     --package http-types
+     --package yesod
+     --package yesod-core
+     --package text
+     --package aeson
+     --package acid-state
+     --package ixset
+     --package split
+     --package conduit
+     --package conduit-extra
+-}
+
+
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE RecordWildCards #-}
+
+import Control.Exception (bracket)
+import Control.Monad.Reader (ask)
+import Control.Monad.State (get, put)
+import Data.Acid.Advanced (groupUpdates)
+import Data.Acid.Local (createCheckpointAndClose)
+import Data.Acid
+import Data.Conduit
+import qualified Data.Conduit.Text as CT
+import Data.Conduit.Binary (sourceFile)
+import qualified Data.Conduit.List as CL
+import Data.Data (Data, Typeable)
+import Data.IxSet (Indexable(..), IxSet(..), (@=), Proxy(..), getOne, ixFun, ixSet)
+import qualified Data.IxSet as IxSet
+import Data.List.Split (splitOn)
+import Data.SafeCopy
+import qualified Data.Text as T
+import Data.Text (Text, pack, unpack)
+import Data.Text.Encoding (decodeUtf8)
+import qualified Data.Vector as V
+import qualified Data.Vector.Generic as GV
+import qualified Data.Vector.Generic.Mutable as GMV
+import GHC.Generics
+import Yesod hiding (Update, update, get)
+
+newtype BusinessId = BusinessId { unBusinessId :: Int }
+  deriving (Show, Eq, Enum, Ord, Data, Typeable, Generic)
+
+$(deriveSafeCopy 0 'base ''BusinessId)
+
+instance ToJSON BusinessId where
+  toJSON BusinessId{..} = toJSON unBusinessId
+
+instance FromJSON BusinessId
+
+data Business = Business
+  { businessId :: BusinessId
+  , name :: Text
+  , address :: Text
+  , city :: Text
+  , state :: Text
+  , postalCode :: Text
+  , country :: Text
+  , latitude :: Double
+  , longitude :: Double
+  }
+  deriving (Show, Eq, Ord, Generic, ToJSON, FromJSON)
+
+$(deriveSafeCopy 0 'base ''Business)
+
+newtype Name = Name Text deriving (Eq, Ord, Data, Typeable)
+newtype Address = Address Text deriving (Eq, Ord, Data, Typeable)
+newtype City = City Text deriving (Eq, Ord, Data, Typeable)
+newtype State = State Text deriving (Eq, Ord, Data, Typeable)
+newtype PostalCode = PostalCode Text deriving (Eq, Ord, Data, Typeable)
+newtype Country = Country Text deriving (Eq, Ord, Data, Typeable)
+newtype Latitude = Latitude Double deriving (Eq, Ord, Data, Typeable)
+newtype Longitude = Longitude Double deriving (Eq, Ord, Data, Typeable)
+
+$(deriveSafeCopy 0 'base ''Name)
+$(deriveSafeCopy 0 'base ''Address)
+$(deriveSafeCopy 0 'base ''City)
+$(deriveSafeCopy 0 'base ''State)
+$(deriveSafeCopy 0 'base ''PostalCode)
+$(deriveSafeCopy 0 'base ''Country)
+$(deriveSafeCopy 0 'base ''Latitude)
+$(deriveSafeCopy 0 'base ''Longitude)
+
+instance Indexable Business where
+  empty = ixSet [ ixFun $ \b -> [ Name $ name b ]
+                , ixFun $ \b -> [ Address $ address b ]
+                , ixFun $ \b -> [ City $ city b ]
+                , ixFun $ \b -> [ State $ state b ]
+                , ixFun $ \b -> [ PostalCode $ postalCode b ]
+                , ixFun $ \b -> [ Country $ country b ]
+                , ixFun $ \b -> [ Latitude $ latitude b ]
+                , ixFun $ \b -> [ Longitude $ longitude b ]
+                ]
+
+data Database = Database
+  { nextBusinessId :: BusinessId
+  , businesses :: IxSet Business
+  }
+  deriving (Typeable)
+
+instance Data Database
+$(deriveSafeCopy 0 'base ''Database)
+
+initDatabase :: Database
+initDatabase = Database
+  { nextBusinessId = BusinessId 1 -- ^ Index starting at 1
+  , businesses = empty
+  }
+
+data AddBusinessData = AddBusinessData
+  { _name :: Text
+  , _address :: Text
+  , _city :: Text
+  , _state :: Text
+  , _postalCode :: Text
+  , _country :: Text
+  , _latitude :: Double
+  , _longitude :: Double
+  }
+
+addBusiness :: AddBusinessData -> Update Database Business
+addBusiness AddBusinessData{..} = do
+  db@Database{..} <- get
+  let b = Business { businessId = nextBusinessId
+                   , name = _name
+                   , address = _address
+                   , city = _city
+                   , state = _state
+                   , postalCode = _postalCode
+                   , country = _country
+                   , latitude = _latitude
+                   , longitude = _longitude
+                   }
+  put $ db { nextBusinessId = succ nextBusinessId
+           , businesses = IxSet.insert b businesses
+           }
+  return b
+
+$(makeAcidic ''Database [])
+
+mkYesod "App" [parseRoutes|/upload UploadR GET POST|]
+
+data App = App
+  { appState :: AcidState Database
+  }
+
+instance Yesod App
+
+instance RenderMessage App FormMessage where
+  renderMessage _ _ = defaultFormMessage
+
+uploadForm = renderDivs $ fileAFormReq "File: "
+
+getUploadR = do
+  ((_, widget), enctype) <- runFormPost uploadForm
+  defaultLayout [whamlet|
+<p>Upload "offers_poi.tsv" here:
+<form method=post enctype=#{enctype}>
+  ^{widget}
+  <br>
+  <input type=submit>
+|]
+
+
+-- toBusinessData = map AddBusinessData . map (splitOn "\t") . lines
+
+postUploadR = do
+  ((result, widget), enctype) <- runFormPost uploadForm
+  let mFile = case result of
+        FormSuccess res -> Just res
+        _ -> Nothing
+  defaultLayout $ do
+    [whamlet|
+$maybe f <- mFile
+  <p>File received: #{fileName f}
+<p>Upload "offers_poi.tsv" here:
+<form method=post enctype=#{enctype}>
+  ^{widget}
+  <br>
+  <input type=submit>
+|]
+
+main = do
+  bracket
+    (openLocalState initDatabase)
+    (createCheckpointAndClose)
+    (\db -> do
+        putStrLn "Ready"
+        warp 3000 (App db))
+
+
+
+-- TSV File utils
+--------------------
+
+
+readTsvFile :: _
+readTsvFile fp = runConduitRes
+  $ sourceFile fp
+  .| CT.decode CT.utf8
+  .| CT.lines
+  .| CL.map (T.split (=='\t'))