Re-organize

1 files changed, 0 insertions, 279 deletions

diff --git a/main.hs b/main.hs
deleted file mode 100755
index 8845d3f..0000000
--- a/main.hs
+++ /dev/null
@@ -1,279 +0,0 @@
-#!/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 cassava
-     --package ixset
--}
-
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE RecordWildCards #-}
-
-import Data.Acid
-import Data.Acid.Advanced (groupUpdates)
-import Data.Acid.Local (createCheckpointAndClose)
-import qualified Data.ByteString.Lazy as BSL
-import qualified Data.Csv as Csv
-import Data.IxSet (Indexable(..), IxSet(..), (@=), Proxy(..), getOne, ixFun, ixSet)
-import qualified Data.IxSet as IxSet
-import Data.SafeCopy
-import Data.Semigroup
-import qualified Data.Vector as Vector
-import Data.Data (Data, Typeable)
-import GHC.Generics
-import Control.Exception (bracket)
-import Control.Monad
-import Control.Monad.Reader (ask)
-import Control.Monad.State (get, put)
-import Data.Maybe (isJust)
-import Data.Text (Text, pack, unpack, isPrefixOf)
-import Yesod hiding (Number, Update, update, get)
-import Network.HTTP.Types.Status (status400, status200)
-import Data.Aeson hiding (Number)
-
-----------------------------------------------------------------------
--- | Parser for standardizing phone number format
-
--- To properly implement this, I would use libphonenumber
-parsePhoneNumber :: Text -> Text
-parsePhoneNumber = countryCode . pack . stripInvalidChars . unpack
-  where
-    stripInvalidChars :: String -> String
-    countryCode :: Text -> Text
-    stripInvalidChars cs = [ c | c <- cs, not $ elem c (".()- " :: String) ]
-    countryCode t = if (isPrefixOf "+" t) then t else ("+1" <> t)
-
---------------------------------------------------------------------
--- | Here be the state and data model stuff.
-
-
--- | Wrap a regular Int for CallerId, so we can track unique callers.
-newtype CallerId = CallerId { unCallerId :: Int }
-  deriving (Show, Eq, Ord, Data, Enum, Typeable, Generic)
-
-$(deriveSafeCopy 0 'base ''CallerId)
-instance ToJSON CallerId where
-  toJSON CallerId{..} = toJSON unCallerId
-
-instance FromJSON CallerId
-
-
--- | A type to describe the shape of our core model
-data Caller = Caller
-  { callerId :: CallerId
-  , name :: Text
-  , number :: Text
-  , context :: Text
-  }
-  deriving (Show, Eq, Ord, Generic, ToJSON, FromJSON)
-
-$(deriveSafeCopy 0 'base ''Caller)
-
--- | Create reified types for each field we want to query
-
-newtype Name = Name Text deriving (Eq, Ord, Data, Typeable)
-newtype PhoneNumber = PhoneNumber Text deriving (Eq, Ord, Data, Typeable)
-newtype Context = Context Text deriving (Eq, Ord, Data, Typeable)
-
-$(deriveSafeCopy 0 'base ''Name)
-$(deriveSafeCopy 0 'base ''PhoneNumber)
-$(deriveSafeCopy 0 'base ''Context)
-
--- | Create the composite index
-
-instance Indexable Caller where
-  empty = ixSet [ ixFun $ (:[]) . callerId
-                , ixFun $ \c -> [ Name $ name c ]
-                , ixFun $ \c -> [ PhoneNumber $ parsePhoneNumber $ number c ]
-                , ixFun $ \c -> [ Context $ context c ]
-                ]
-
--- | The database is a set of @Caller@ records, plus a record counter, so we
--- know the next CallerId to use.
-data Database = Database
-  { nextCallerId :: CallerId
-  , callers :: IxSet Caller
-  }
-  deriving (Typeable)
-
-instance Data Database
-$(deriveSafeCopy 0 'base ''Database)
-
-initDatabase :: Database
-initDatabase =
-  Database
-  { nextCallerId = CallerId 1 -- ^ Index starting a 1
-  , callers = empty
-  }
-
----------------------------------------------------------------------------------
--- | CRUD operations on the state
-
-
--- | Insert the caller into database.
-addCaller :: Text -> Text -> Text -> Update Database Caller
-addCaller name number context = do
-  db@Database{..} <- get
-  let caller = Caller { callerId = nextCallerId
-                      , name = name
-                      , number = parsePhoneNumber number
-                      , context = context }
-  put $ db { nextCallerId = succ nextCallerId
-           , callers = IxSet.insert caller callers
-           }
-  return caller
-
--- | Return a list of the callers
-viewCallers :: Int -> Query Database [Caller]
-viewCallers limit = do
-  Database{..} <- ask
-  return $ take limit $ IxSet.toList callers
-
--- | Update a single caller record
-updateCaller :: Caller -> Update Database ()
-updateCaller updatedCaller =
-  do db@Database{..} <- get
-     put $ db { callers = IxSet.updateIx (callerId updatedCaller) updatedCaller callers }
-
--- | Lookup caller by CallerId
-callerById :: CallerId -> Query Database (Maybe Caller)
-callerById cid =
-  do Database{..} <- ask
-     return $ getOne $ callers @= cid
-
--- | Lookup caller by PhoneNumber
-callerByNumber :: PhoneNumber -> Query Database [Caller]
-callerByNumber num =
-  do Database{..} <- ask
-     return $ IxSet.toList $ callers @= num
-
-countCallers :: Query Database Int
-countCallers =
-  do Database{..} <- ask
-     return $ IxSet.size callers
-
-$(makeAcidic ''Database
-  ['addCaller
-  , 'updateCaller
-  , 'callerById
-  , 'callerByNumber
-  , 'viewCallers
-  , 'countCallers
-  ])
-
-
------------------------------------------------------------------------
--- | Here be the HTTP stuff
-
-data App = App
-  { appState :: AcidState Database
-  }
-
-mkYesod "App" [parseRoutes|
-/bootstrap BootstrapR POST
-/query QueryR GET
-/count CountR GET
-/number NumberR POST
-|]
-
--- | Initiate Yesod. The default method instances are fine for a prototype or
--- demo app.
-instance Yesod App
-
-data ApiError = ApiError
-  { msg :: Text
-  }
-  deriving (Show, Eq, Generic, ToJSON, FromJSON)
-
-getQueryR :: Handler RepJson
-getQueryR = do
-  qm <- lookupGetParam "number"
-  case qm of
-    Nothing -> do
-      app <- getYesod
-      let db = appState app
-      callers <- liftIO $ query db $ ViewCallers 20
-      sendStatusJSON status200 $ object [ "results" .= callers ]
-
-    Just q -> do
-      app <- getYesod
-      let db = appState app
-      caller <- liftIO $ query db $ CallerByNumber $ PhoneNumber q
-      sendStatusJSON status200 $ object [ "results" .= caller ]
-
-getCountR :: Handler RepJson
-getCountR = do
-  app <- getYesod
-  let db = appState app
-  n <- liftIO $ query db $ CountCallers
-  sendStatusJSON status200 $ object [ "count" .= n ]
-
-data PostRequest = PostRequest
-  { _name :: Text
-  , _number :: Text
-  , _context :: Text
-  }
-  deriving (Show, Eq, Generic)
-
-instance FromJSON PostRequest where
-  parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 1 }
-
-instance ToJSON PostRequest where
-  toJSON = genericToJSON defaultOptions { fieldLabelModifier = drop 1 }
-
-
-postNumberR :: Handler RepJson
-postNumberR = do
-  (obj :: Result PostRequest) <- parseJsonBody
-  case obj of
-    Error err ->
-      sendStatusJSON status400 $ ApiError $ "Invalid request. Could not parse JSON body: " <> pack err
-
-    Success PostRequest{..} -> do
-      app <- getYesod
-      let db = appState app
-      caller <- liftIO $ update db $ AddCaller _name _number _context
-      sendStatusJSON status200 $ caller
-
-
-callerFromCsv (number, context, name) = AddCaller name number context
-
-postBootstrapR :: Handler RepJson
-postBootstrapR = do
-  $logInfo "Initializing the database."
-  app <- getYesod
-  let db = appState app
-  $logInfo "Loading data from CSV."
-  seedData <- liftIO $ BSL.readFile "interview-callerid-data.csv"
-  callers <- case Csv.decode Csv.NoHeader seedData of
-         Left err -> fail err
-         Right v -> liftIO $ groupUpdates db $ Vector.toList $ Vector.map callerFromCsv v
-  sendStatusJSON status200 $ ("Bootstrap complete." :: Text)
-
-
--- | Start a simple warp server on 3000
-main :: IO ()
-main = do
-  bracket (openLocalState initDatabase)
-          (createCheckpointAndClose)
-          (\db -> do
-              putStrLn "Ready"
-              warp 3000 (App db))