plus :: Int -> Int -> Int
plus x y = x + y

plusAndPrint :: Int -> Int -> IO Int
plusAndPrint x y = do
  let result = plus x y
  print result
  return result

initDB :: IO Database
initDB = do
  conn <- open ":memory:"                                             -- create in memory database
  exec conn "CREATE TABLE person (id INTEGER PRIMARY KEY, name TEXT)" -- initialize table
  exec conn "INSERT INTO person (name) VALUES ('Tim')"
  exec conn "INSERT INTO person (name) VALUES ('Mark')"               -- insert some data
  exec conn "INSERT INTO person (name) VALUES ('Sarah')"
  return conn                                                         -- return connection for future access to DB

readDB :: Database -> IO ()
readDB = flip execPrint "select * from person"                        -- print database contents to stdout

closeDB :: Database -> IO ()
closeDB =  close                                                      -- cleanup database

insertDB :: Database -> Text -> IO ()                               -- make the horrible mistake of
insertDB conn name =                                                -- building up an insert statement by
  exec conn $ "INSERT INTO person (name) VALUES ('" <> name <> "')" -- string concatenation

-- Please don't use this sanitization function in real life!
sanitize :: Text -> Text                                            -- hokey sanitization function that strips
sanitize =                                                          -- off the rest of the sql statement once
  takeWhile (`notElem` [';','\'','"'])                              -- it encounters one of [; ' "]

module MySafeStore                    -- carefully control what is visible outside of module
  (
    ...

  , UserInput                         -- only export the type of UserInput, not its constructor
  , readInput                         -- export readInput so we can convert Text to UserInput

  ) where

data Clean                            -- create types Clean and Dirty, with no values
data Dirty

newtype UserInput a = UserInput {     -- put phantom type parameter a in UserInput
  input :: Text
}

readInput :: Text -> UserInput Dirty  -- force bare Text values to begin life Dirty
readInput = UserInput

insertDB :: DataStore -> UserInput Clean -> IO ()                         -- we still concatenate strings to
insertDB DataStore{..} UserInput{..} =                                    -- build up sql statements, but we
  exec conn $ "INSERT INTO person (name) VALUES ('" <> input <> "')"      -- only accept sanitized input

-- Please don't use this sanitization function in real life!
sanitize :: UserInput Dirty -> UserInput Clean                            -- the only public way to
sanitize =                                                                -- sanitize a UserInput Dirty
  UserInput . takeWhile (`notElem` [';','\'','"']) . input

main :: IO ()
main = main1 -- unsanitized version

main1 = do
  conn <- initDB
  print "Contents of initial database:"
  readDB conn

  insertDB conn "Haskell Curry"
  print "Contents after insert of our saint"
  readDB conn

  insertDB conn (sanitize "Evil'); drop table person; --")
  print "Contents after allowing my sadistic co-worker to use my library"
  readDB conn

  insertDB conn "Evil'); drop table person; --"
  print "Contents after allowing my sadistic co-worker to use my library a second time"
  readDB conn
{-
main2 :: IO ()
main2 = ...
-}

data Status = OK | Fail
  deriving (Generic, Show, Read, Ord, Eq)

data Log = Log {
  ident :: Int
, timestamp :: Int
, message :: Text
} deriving (Generic, Show, Typeable)

server :: Server LogApi
server = undefined :<|> undefined :<|> undefined -- line 68

foo :: Log -> Handler Status
foo _ = return OK

bar :: Handler [Log]
bar = return [
    Log {ident = 1, timestamp = 101, message = "msg1"}
  , Log {ident = 2, timestamp = 201, message = "msg2"}
  ]

baz :: Int -> Handler Log
baz n = return Log {ident = n, timestamp = 102, message = "message"}

start :: MonadWidget t m => m ()
start = do
  el "div" (text "hello")

start :: MonadWidget t m => m ()
start = mdo
  inp <- mdlInput ""                  -- create input element
  let inpEv   = _textInput_input inp  -- grab the keypress events

  inpValDyn <- foldDyn const "" inpEv -- build dynamic from input events

  el "div" (display inpValDyn)        -- render contents of above dynamic

start :: MonadWidget t m => m ()
start = mdo
  inp <- mdlInput' "" clickEv                      -- create input element
  b   <- btn "clear"                               -- create button

  let inpEv   = _textInput_input inp               -- grab input events
      clickEv = fmap (const "") (domEvent Click b) -- grab button click events
      combEv  = appendEvents clickEv inpEv         -- merge input and click events

  inpValDyn <- foldDyn const "" combEv             -- create dynamic over combined events

  el "div" (display inpValDyn)                     -- render contents of dynammic

start :: MonadWidget t m => m ()
start = grid $ do
  cell2 blank
  cell8 $ do
    let defInp  = "<span>spooky user input</span>"

    inp <- mdlInput defInp                                 -- create input element
    let inpEv   = _textInput_input inp                     -- grab input events

    safeDyn   <- foldDyn (\n _ -> sanitize n) defInp inpEv -- dynamic with sanitized input
    unsafeDyn <- foldDyn const defInp inpEv                -- dynamic with raw input

    grid $ do
      cell5 $ mdlTitleCard "Sanitized"    "clsf"   $ elDynHtml' "span" safeDyn
      cell2 blank
      cell5 $ mdlTitleCard "Un-Sanitized" "clunsf" $ elDynHtml' "span" unsafeDyn
    blank
  cell2 blank

-- unsafe function which is hidden from library users
elDynHtmlUnsafe :: MonadWidget t m => Text -> Dynamic t Text -> m (El t)
elDynHtmlUnsafe e = ...

-- safe version of elDynHtmlUnsafe (only this function is exposed to users)
elDynHtml :: MonadWidget t m => Text -> Dynamic t (UserInput Clean) -> m (El t)
elDynHtml e = elDynHtmlUnsafe e . fmap getInput

type SanitizeApi =
       "sanitize" :> ReqBody '[PlainText] Text :> Post '[PlainText] Text -- POST for sanitization
  :<|> Raw                                                               -- serve static content

sanitizer :: Text -> Handler Text                                        -- Servant handler that
sanitizer = return . sanitize                                            -- wrap our friend sanitize

endpoints :: Server SanitizeApi
endpoints = sanitizer :<|> serveDirectory "static"                       -- the server

main :: IO ()
main = run 8080 $ serve (Proxy :: Proxy SanitizeApi) endpoints           -- run the thing

sanitize :: MonadWidget t m => Event t (UserInput Dirty) -> m (Event t (UserInput Clean))
sanitize inp = do
  evResp <- performRequestAsync $ fmap makeReq inp        -- build a XhrRequest and send it

  let evInp = _xhrResponse_responseText <$> evResp        -- when the XhrResponse Event fires, wrap
  return $ fmap (maybe (UserInput "") UserInput) evInp    -- up in the correct UserInput type

makeReq :: UserInput Dirty -> XhrRequest Text             -- plumbing for building up the XhrRequest
makeReq inp =
  xhrRequest
    "POST" "/sanitize"
    (def {_xhrRequestConfig_sendData = (getInput inp)} )

data Democrat   = Obama   | LBJ                     -- create some enums
data Republican = Lincoln | Eisenhower

class (Policy p) => Politician p where              -- define Policy, scoped to specific party
  data Policy p :: *
  govern :: p -> Policy p

instance Politician Democrat where                  -- define Democrats, with their policies
  data Policy Democrat = Obamacare | CivilRights
  govern Obama = Obamacare
  govern LBJ   = CivilRights

instance Politician Republican where                -- define Republicans, with their policies
  data Policy Republican = EstablishNASA | ThirteenthAmendment
  govern Lincoln    = ThirteenthAmendment
  govern Eisenhower = EstablishNASA

data Strategy = Subsidize | Amend | Legislate       -- one more enum

class (Politician p) => Enact p where               -- politicians are only allowed to enact
  enact :: p -> Strategy                            -- their own policies

instance Enact Democrat where
  enact p = case govern p of                        -- type level determination of allowed
    Obamacare   -> Subsidize                        -- policies for Democrats
    CivilRights -> Legislate

instance Enact Republican where                     -- type level determination of allowed
  enact p = case govern p of                        -- policies for Republicans
    ThirteenthAmendment -> Amend
    EstablishNASA       -> Subsidize