#!/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'))