Lint fixes, also delete Biz.Language

24 files changed, 114 insertions, 923 deletions

diff --git a/Alpha.hs b/Alpha.hs
index 8f823da..afcd59d 100644
--- a/Alpha.hs
+++ b/Alpha.hs
@@ -49,7 +49,7 @@ import Protolude as X
 
 -- | Debugging printf
 say :: Text -> IO ()
-say msg = putStrLn msg
+say = putText
 
 -- | Alias for map, fmap, <$>
 (</) :: Functor f => (a -> b) -> f a -> f b
diff --git a/Biz/Ibb/Client.hs b/Biz/Ibb/Client.hs
index 89e0ffc..c3dae4b 100644
--- a/Biz/Ibb/Client.hs
+++ b/Biz/Ibb/Client.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 
diff --git a/Biz/Ibb/Core.hs b/Biz/Ibb/Core.hs
index 2c1fbae..007d835 100644
--- a/Biz/Ibb/Core.hs
+++ b/Biz/Ibb/Core.hs
@@ -83,7 +83,7 @@ data Action
   deriving (Show, Eq)
 
 home :: Model -> View Action
-home m = see m
+home = see
 
 handlers :: Model -> View Action
 handlers = home
@@ -134,7 +134,7 @@ seePerson person =
             []
             [ a_
                 [ class_ "fab fa-twitter",
-                  href_ $ "https://twitter.com/" <> (ms $ _twitter person)
+                  href_ $ "https://twitter.com/" <> ms (_twitter person)
                 ]
                 [],
               a_ [class_ "fas fa-globe", href_ $ ms $ _website person] []
@@ -151,7 +151,7 @@ seeBook book =
     []
     [ a_
         [ class_ "text-dark",
-          href_ $ "https://www.amazon.com/dp/" <> (ms $ _amznref book)
+          href_ $ "https://www.amazon.com/dp/" <> ms (_amznref book)
         ]
         [text $ ms $ _title book]
     ]
diff --git a/Biz/Ibb/Influencers.hs b/Biz/Ibb/Influencers.hs
index cf53cc0..08ce3e8 100644
--- a/Biz/Ibb/Influencers.hs
+++ b/Biz/Ibb/Influencers.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Biz.Ibb.Influencers where
diff --git a/Biz/Ibb/Keep.hs b/Biz/Ibb/Keep.hs
index d546aae..8ee1228 100644
--- a/Biz/Ibb/Keep.hs
+++ b/Biz/Ibb/Keep.hs
@@ -27,7 +27,7 @@ import qualified Data.Text as Text
 -- * Keep
 
 -- | Main database. Need to think of a better name for this.
-data IbbKeep
+newtype IbbKeep
   = IbbKeep
       { _people :: IxSet Person
       }
@@ -79,9 +79,7 @@ newPerson name blurb = do
         }
 
 getPeople :: Int -> Acid.Query IbbKeep [Person]
-getPeople n = do
-  keep <- ask
-  return $ take n $ IxSet.toList $ _people keep
+getPeople n = take n $ IxSet.toList $ _people keep </ ask
 
 -- * Index @Book@
 
diff --git a/Biz/Ibb/Look.hs b/Biz/Ibb/Look.hs
index 1ab12c1..50cda9e 100644
--- a/Biz/Ibb/Look.hs
+++ b/Biz/Ibb/Look.hs
@@ -26,8 +26,8 @@ main = do
     justifyContent center
     flexDirection column
     fontFamily ["GillSans", "Calibri", "Trebuchet"] [sansSerif]
-  headings ? do
-    fontFamily
+  headings
+    ? fontFamily
       [ "Palatino",
         "Palatino Linotype",
         "Hoefler Text",
diff --git a/Biz/Ibb/Server.hs b/Biz/Ibb/Server.hs
index b5a7464..e87c55a 100644
--- a/Biz/Ibb/Server.hs
+++ b/Biz/Ibb/Server.hs
@@ -1,8 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE NoImplicitPrelude #-}
@@ -57,11 +55,11 @@ import System.Environment (lookupEnv)
 main :: IO ()
 main = do
   say "rise: ibb"
-  staticDir <- fromMaybe "static" <$> lookupEnv "STATIC_DIR" :: IO [Char]
-  port <- read <$> fromMaybe "3000" <$> lookupEnv "PORT" :: IO Int
+  staticDir <- fromMaybe "static" <$> lookupEnv "STATIC_DIR" :: IO String
+  port <- (read . fromMaybe "3000" <$> lookupEnv "PORT") :: IO Int
   keep <- Keep.openLocal "_keep/"
   say "port: 3000"
-  run port $ logStdout $ compress $ app staticDir $ keep
+  run port $ logStdout $ compress $ app staticDir keep
   where
     compress = gzip def {gzipFiles = GzipCompress}
 
@@ -75,8 +73,7 @@ instance L.ToHtml a => L.ToHtml (HtmlPage a) where
       L.meta_ [L.charset_ "utf-8"]
       jsRef "/static/ibb.js"
       cssRef "/css/main.css"
-    L.body_ $ do
-      page
+    L.body_ page
     where
       page = L.toHtml x
       jsRef href =
@@ -100,8 +97,7 @@ handle404 _ respond =
     $ responseLBS status404 [("Content-Type", "text/html")]
     $ renderBS
     $ toHtml
-    $ HtmlPage
-    $ notfound
+    $ HtmlPage notfound
 
 newtype CSS
   = CSS
@@ -128,7 +124,7 @@ type Routes =
 cssHandlers :: Server CssRoute
 cssHandlers = return . Lazy.toStrict . Clay.render $ Look.main
 
-app :: [Char] -> AcidState Keep.IbbKeep -> Application
+app :: String -> AcidState Keep.IbbKeep -> Application
 app staticDir keep =
   serve (Proxy @Routes) $
     static
@@ -137,7 +133,7 @@ app staticDir keep =
       :<|> apiHandlers keep
       :<|> Tagged handle404
   where
-    static = serveDirectoryWith (defaultWebAppSettings $ staticDir)
+    static = serveDirectoryWith (defaultWebAppSettings staticDir)
 
 type ApiRoutes = "people" :> Get '[JSON] [Person]
 
diff --git a/Biz/Language/Bs.hs b/Biz/Language/Bs.hs
deleted file mode 100644
index f2d4c9d..0000000
--- a/Biz/Language/Bs.hs
+++ /dev/null
@@ -1,13 +0,0 @@
--- https://github.com/write-you-a-scheme-v2/scheme
--- https://github.com/justinethier/husk-scheme
-module Language.Bs
-  ( module X,
-  )
-where
-
-import Language.Bs.Cli as X
-import Language.Bs.Eval as X
-import Language.Bs.Expr as X
-import Language.Bs.Parser as X
-import Language.Bs.Primitives as X
-import Language.Bs.Repl as X
diff --git a/Biz/Language/Bs/Cli.hs b/Biz/Language/Bs/Cli.hs
deleted file mode 100644
index d2ac1e4..0000000
--- a/Biz/Language/Bs/Cli.hs
+++ /dev/null
@@ -1,64 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-
-module Language.Bs.Cli
-  ( run,
-  )
-where
-
-import Data.String
-import Data.Text.IO as TIO
-import Language.Bs.Eval -- evalFile :: T.Text -> IO ()
-import Language.Bs.Repl -- Repl.mainLoop :: IO ()
-import Options.Applicative
-import Protolude
-import System.Directory
-
--- SOURCES
---http://book.realworldhaskell.org/read/io.html
--- https://github.com/pcapriotti/optparse-applicative
--- https://hackage.haskell.org/package/optparse-applicative
-
-runScript :: FilePath -> IO ()
-runScript fname = do
-  exists <- doesFileExist fname
-  if exists
-    then TIO.readFile fname >>= evalFile fname
-    else TIO.putStrLn "File does not exist."
-
-data LineOpts = UseReplLineOpts | RunScriptLineOpts String
-
-parseLineOpts :: Parser LineOpts
-parseLineOpts = runScriptOpt <|> runReplOpt
-  where
-    runScriptOpt =
-      RunScriptLineOpts
-        <$> strOption
-          ( long "script"
-              <> short 's'
-              <> metavar "SCRIPT"
-              <> help "File containing the script you want to run"
-          )
-    runReplOpt =
-      UseReplLineOpts
-        <$ flag'
-          ()
-          ( long "repl"
-              <> short 'r'
-              <> help "Run as interavtive read/evaluate/print/loop"
-          )
-
-schemeEntryPoint :: LineOpts -> IO ()
-schemeEntryPoint UseReplLineOpts = mainLoop --repl
-schemeEntryPoint (RunScriptLineOpts script) = runScript script
-
-run :: IO ()
-run = execParser opts >>= schemeEntryPoint
-  where
-    opts =
-      info
-        (helper <*> parseLineOpts)
-        ( fullDesc
-            <> header "Executable binary for Write You A Scheme v2.0"
-            <> progDesc "contains an entry point for both running scripts and repl"
-        )
diff --git a/Biz/Language/Bs/Eval.hs b/Biz/Language/Bs/Eval.hs
deleted file mode 100644
index 1198a3e..0000000
--- a/Biz/Language/Bs/Eval.hs
+++ /dev/null
@@ -1,224 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-
-module Language.Bs.Eval
-  ( evalText,
-    evalFile,
-    runParseTest,
-    safeExec,
-    runASTinEnv,
-    basicEnv,
-    fileToEvalForm,
-    textToEvalForm,
-    getFileContents,
-  )
-where
-
-import Control.Exception
-import Control.Monad.Reader
-import qualified Data.Map as Map
-import Data.String
-import qualified Data.Text as T
-import qualified Data.Text.IO as TIO
-import Language.Bs.Expr
-import Language.Bs.Parser
-import Language.Bs.Primitives
-import Protolude
-import System.Directory
-
-funcEnv :: Map.Map T.Text Expr
-funcEnv =
-  Map.fromList $
-    primEnv
-      <> [ ("read", IFun $ IFunc $ unop readFn),
-           ("parse", IFun $ IFunc $ unop parseFn),
-           ("eval", IFun $ IFunc $ unop eval),
-           ("show", IFun $ IFunc $ unop (return . Tape . ppexpr))
-         ]
-
-basicEnv :: Env
-basicEnv = Env Map.empty funcEnv
-
-readFn :: Expr -> Eval Expr
-readFn (Tape txt) = lineToEvalForm txt
-readFn val = throw $ TypeMismatch "read expects string, instead got:" val
-
-parseFn :: Expr -> Eval Expr
-parseFn (Tape txt) = either (throw . ParseError . show) return $ readExpr txt
-parseFn val = throw $ TypeMismatch "parse expects string, instead got:" val
-
-safeExec :: IO a -> IO (Either String a)
-safeExec m = do
-  result <- Control.Exception.try m
-  case result of
-    Left (eTop :: SomeException) ->
-      case fromException eTop of
-        Just (enclosed :: LispError) ->
-          return $ Left (show enclosed)
-        Nothing ->
-          return $ Left (show eTop)
-    Right val ->
-      return $ Right val
-
-runASTinEnv :: Env -> Eval b -> IO b
-runASTinEnv code action = runReaderT (unEval action) code
-
-lineToEvalForm :: T.Text -> Eval Expr
-lineToEvalForm input = either (throw . ParseError . show) eval $ readExpr input
-
-evalFile :: FilePath -> T.Text -> IO () -- program file
-evalFile filePath fileExpr = (runASTinEnv basicEnv $ fileToEvalForm filePath fileExpr) >>= print
-
-fileToEvalForm :: FilePath -> T.Text -> Eval Expr
-fileToEvalForm filePath input = either (throw . ParseError . show) evalBody $ readExprFile filePath input
-
-runParseTest :: T.Text -> T.Text -- for view AST
-runParseTest input = either (T.pack . show) (T.pack . show) $ readExpr input
-
-getFileContents :: FilePath -> IO T.Text
-getFileContents fname = do
-  exists <- doesFileExist fname
-  if exists then TIO.readFile fname else return "File does not exist."
-
-textToEvalForm :: T.Text -> Eval Expr
-textToEvalForm input = either (throw . ParseError . show) evalBody $ readExpr input
-
-evalText :: T.Text -> IO () --REPL
-evalText textExpr = do
-  res <- runASTinEnv basicEnv $ textToEvalForm textExpr
-  print res
-
-getVar :: Expr -> Eval Expr
-getVar (Atom atom) = do
-  Env {..} <- ask
-  case Map.lookup atom (Map.union fenv env) of -- lookup, but prefer functions
-    Just x -> return x
-    Nothing -> throw $ UnboundVar atom
-getVar n = throw $ TypeMismatch "failure to get variable: " n
-
-ensureAtom :: Expr -> Eval Expr
-ensureAtom n@(Atom _) = return n
-ensureAtom n@(List _) = throw $ TypeMismatch "got list" n
-ensureAtom n = throw $ TypeMismatch "expected an atomic value" n
-
-extractVar :: Expr -> T.Text
-extractVar (Atom atom) = atom
-extractVar n = throw $ TypeMismatch "expected an atomic value" n
-
-getEven :: [t] -> [t]
-getEven [] = []
-getEven (x : xs) = x : getOdd xs
-
-getOdd :: [t] -> [t]
-getOdd [] = []
-getOdd (_ : xs) = getEven xs
-
-applyFunc :: Expr -> [Expr] -> [Expr] -> Eval Expr
-applyFunc expr params args = bindArgsEval params args expr
-
-bindArgsEval :: [Expr] -> [Expr] -> Expr -> Eval Expr
-bindArgsEval params args expr = do
-  Env {..} <- ask
-  let newVars = zipWith (\a b -> (extractVar a, b)) params args
-  let (newEnv, newFenv) = Map.partition (not . isFunc) $ Map.fromList newVars
-  local (const $ Env (newEnv <> env) (newFenv <> fenv)) $ eval expr
-
-isFunc :: Expr -> Bool
-isFunc (List ((Atom "lambda") : _)) = True
-isFunc _ = False
-
-eval :: Expr -> Eval Expr
-eval (List [Atom "dumpEnv", x]) = do
-  Env {..} <- ask
-  liftIO $ print $ toList env
-  liftIO $ print $ toList fenv
-  eval x
-eval (Numb i) = return $ Numb i
-eval (Tape s) = return $ Tape s
-eval (Bool b) = return $ Bool b
-eval (List []) = return Nil
-eval Nil = return Nil
-eval n@(Atom _) = getVar n
-eval (List [Atom "showSF", rest]) = return . Tape . T.pack $ show rest
-eval (List ((:) (Atom "showSF") rest)) = return . Tape . T.pack . show $ List rest
-eval (List [Atom "quote", val]) = return val
-eval (List [Atom "if", pred_, then_, else_]) = do
-  ifRes <- eval pred_
-  case ifRes of
-    (Bool True) -> eval then_
-    (Bool False) -> eval else_
-    _ ->
-      throw $ BadSpecialForm "if's first arg must eval into a boolean"
-eval (List ((:) (Atom "if") _)) =
-  throw $ BadSpecialForm "(if <bool> <s-expr> <s-expr>)"
-eval (List [Atom "begin", rest]) = evalBody rest
-eval (List ((:) (Atom "begin") rest)) = evalBody $ List rest
--- top-level define
--- TODO: how to make this eval correctly?
-eval (List [Atom "define", List (name : args), body]) = do
-  Env {..} <- ask
-  _ <- eval body
-  bindArgsEval (name : args) [body] name
-eval (List [Atom "define", name, body]) = do
-  Env {..} <- ask
-  _ <- eval body
-  bindArgsEval [name] [body] name
-eval (List [Atom "let", List pairs, expr]) = do
-  Env {..} <- ask
-  atoms <- mapM ensureAtom $ getEven pairs
-  vals <- mapM eval $ getOdd pairs
-  bindArgsEval atoms vals expr
-eval (List (Atom "let" : _)) =
-  throw $ BadSpecialForm "let function expects list of parameters and S-Expression body\n(let <pairs> <s-expr>)"
-eval (List [Atom "lambda", List params, expr]) = do
-  ctx <- ask
-  return $ Func (IFunc $ applyFunc expr params) ctx
-eval (List (Atom "lambda" : _)) = throw $ BadSpecialForm "lambda function expects list of parameters and S-Expression body\n(lambda <params> <s-expr>)"
--- needed to get cadr, etc to work
-eval (List [Atom "cdr", List [Atom "quote", List (_ : xs)]]) =
-  return $ List xs
-eval (List [Atom "cdr", arg@(List (x : xs))]) =
-  case x of
-    -- proxy for if the list can be evaluated
-    Atom _ -> do
-      val <- eval arg
-      eval $ List [Atom "cdr", val]
-    _ -> return $ List xs
-eval (List [Atom "car", List [Atom "quote", List (x : _)]]) =
-  return $ x
-eval (List [Atom "car", arg@(List (x : _))]) =
-  case x of
-    Atom _ -> do
-      val <- eval arg
-      eval $ List [Atom "car", val]
-    _ -> return $ x
-eval (List ((:) x xs)) = do
-  Env {..} <- ask
-  funVar <- eval x
-  xVal <- mapM eval xs
-  case funVar of
-    (IFun (IFunc internalFn)) ->
-      internalFn xVal
-    (Func (IFunc definedFn) (Env benv _)) ->
-      local (const $ Env benv fenv) $ definedFn xVal
-    _ ->
-      throw $ NotFunction funVar
-
-updateEnv :: T.Text -> Expr -> Env -> Env
-updateEnv var e@(IFun _) Env {..} = Env env $ Map.insert var e fenv
-updateEnv var e@(Func _ _) Env {..} = Env env $ Map.insert var e fenv
-updateEnv var e Env {..} = Env (Map.insert var e env) fenv
-
-evalBody :: Expr -> Eval Expr
-evalBody (List [List ((:) (Atom "define") [Atom var, defExpr]), rest]) = do
-  evalVal <- eval defExpr
-  ctx <- ask
-  local (const $ updateEnv var evalVal ctx) $ eval rest
-evalBody (List ((:) (List ((:) (Atom "define") [Atom var, defExpr])) rest)) = do
-  evalVal <- eval defExpr
-  ctx <- ask
-  local (const $ updateEnv var evalVal ctx) $ evalBody $ List rest
-evalBody x = eval x
diff --git a/Biz/Language/Bs/Expr.hs b/Biz/Language/Bs/Expr.hs
deleted file mode 100644
index 2452622..0000000
--- a/Biz/Language/Bs/Expr.hs
+++ /dev/null
@@ -1,139 +0,0 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-
-module Language.Bs.Expr where
-
-import Data.String (String)
-import Data.Text (Text)
-import qualified Data.Text as T
-import GHC.Show
-import Protolude hiding (show)
-import qualified Text.PrettyPrint.Leijen.Text as PP
-import Text.PrettyPrint.Leijen.Text hiding ((<$>))
-
-type Ctx = Map Text Expr
-
-data Env = Env {env :: Ctx, fenv :: Ctx}
-  deriving (Eq)
-
-newtype Eval a = Eval {unEval :: ReaderT Env IO a}
-  deriving (Monad, Functor, Applicative, MonadReader Env, MonadIO)
-
-data IFunc = IFunc {fn :: [Expr] -> Eval Expr}
-  deriving (Typeable)
-
-instance Eq IFunc where
-  (==) _ _ = False
-
-data Expr
-  = Atom Text
-  | List [Expr]
-  | Numb Integer
-  | Tape Text
-  | IFun IFunc -- TODO: call this Kern
-  | Func IFunc Env
-  | Bool Bool
-  | Nil
-  deriving (Typeable, Eq)
-
-instance Show Expr where
-  show = T.unpack . ppexpr
-
-data LispErrorType
-  = NumArgs Integer [Expr]
-  | LengthOfList Text Int
-  | ExpectedList Text
-  | ParseError String
-  | TypeMismatch Text Expr
-  | BadSpecialForm Text
-  | NotFunction Expr
-  | UnboundVar Text
-  | Default Expr
-  | ReadFileError Text
-  deriving (Typeable)
-
-data LispError = LispError Expr LispErrorType
-
-instance Show LispErrorType where
-  show = T.unpack . ppexpr
-
-instance Show LispError where
-  show = T.unpack . ppexpr
-
-instance Exception LispErrorType
-
-instance Exception LispError
-
-ppexpr :: Pretty a => a -> Text
-ppexpr x = PP.displayTStrict (PP.renderPretty 1.0 70 (pretty x))
-
---prettyList :: [Doc] -> Doc
---prettyList = encloseSep lparen rparen PP.space
-
-instance Pretty Expr where
-  pretty v =
-    case v of
-      Atom a ->
-        textStrict a
-      List ls ->
-        prettyList $ fmap pretty ls
-      Numb n ->
-        integer n
-      Tape t ->
-        textStrict "\"" <> textStrict t <> textStrict "\""
-      IFun _ ->
-        textStrict "<internal function>"
-      Func _ _ ->
-        textStrict "<lambda function>"
-      Bool True ->
-        textStrict "#t"
-      Bool False ->
-        textStrict "#f"
-      Nil ->
-        textStrict "'()"
-
-instance Pretty LispErrorType where
-  pretty err = case err of
-    NumArgs i args ->
-      textStrict "number of arguments"
-        <$$> textStrict "expected"
-        <+> textStrict (T.pack $ show i)
-        <$$> textStrict "received"
-        <+> textStrict (T.pack $ show $ length args)
-    LengthOfList txt i ->
-      textStrict "length of list in:"
-        <+> textStrict txt
-        <$$> textStrict "length:"
-        <+> textStrict (T.pack $ show i)
-    ParseError txt ->
-      textStrict "cannot parse expr:"
-        <+> textStrict (T.pack txt)
-    TypeMismatch txt expr ->
-      textStrict "type mismatch:"
-        <$$> textStrict txt
-        <$$> pretty expr
-    BadSpecialForm txt ->
-      textStrict "bad special form:"
-        <$$> textStrict txt
-    NotFunction expr ->
-      textStrict "not a function"
-        <$$> pretty expr
-    UnboundVar txt ->
-      textStrict "unbound variable:"
-        <$$> textStrict txt
-    Default _ ->
-      textStrict "default error"
-    ReadFileError txt ->
-      textStrict "error reading file:"
-        <$$> textStrict txt
-    ExpectedList txt ->
-      textStrict "expected list:"
-        <$$> textStrict txt
-
-instance Pretty LispError where
-  pretty (LispError expr typ) =
-    textStrict "error evaluating:"
-      <$$> indent 4 (pretty expr)
-      <$$> pretty typ
diff --git a/Biz/Language/Bs/Parser.hs b/Biz/Language/Bs/Parser.hs
deleted file mode 100644
index 574536d..0000000
--- a/Biz/Language/Bs/Parser.hs
+++ /dev/null
@@ -1,129 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-
-module Language.Bs.Parser
-  ( readExpr,
-    readExprFile,
-  )
-where
-
-import Control.Monad (fail)
-import Control.Monad (mzero)
-import Data.Char (digitToInt)
-import Data.Functor.Identity (Identity)
-import Data.String
-import qualified Data.Text as T
-import Language.Bs.Expr
-import Protolude hiding ((<|>), try)
-import Text.Parsec
-import qualified Text.Parsec.Language as Lang
-import Text.Parsec.Text
-import qualified Text.Parsec.Token as Tok
-
-lexer :: Tok.GenTokenParser T.Text () Identity
-lexer = Tok.makeTokenParser style
-
-style :: Tok.GenLanguageDef T.Text () Identity
-style =
-  Lang.emptyDef
-    { Tok.commentStart = "#|",
-      Tok.commentEnd = "|#",
-      Tok.commentLine = ";",
-      Tok.opStart = mzero,
-      Tok.opLetter = mzero,
-      Tok.identStart = letter <|> oneOf "!$%&*/:<=>?^_~",
-      Tok.identLetter = digit <|> letter <|> oneOf "!$%&*/:<=>?^_~+-.@"
-    }
-
-parens :: Parser a -> Parser a
-parens = Tok.parens lexer
-
-whitespace :: Parser ()
-whitespace = Tok.whiteSpace lexer
-
-lexeme :: Parser a -> Parser a
-lexeme = Tok.lexeme lexer
-
-quoted :: Parser a -> Parser a
-quoted p = try (char '\'') *> p
-
-identifier :: Parser T.Text
-identifier = T.pack <$> (Tok.identifier lexer <|> specialIdentifier) <?> "identifier"
-  where
-    specialIdentifier :: Parser String
-    specialIdentifier =
-      lexeme $ try $
-        string "-" <|> string "+" <|> string "..."
-
--- | The @Radix@ type consists of a base integer (e.g. @10@) and a parser for
--- digits in that base (e.g. @digit@).
-type Radix = (Integer, Parser Char)
-
--- | Parse an integer, given a radix as output by @radix@.
--- Copied from Text.Parsec.Token
-numberWithRadix :: Radix -> Parser Integer
-numberWithRadix (base, baseDigit) = do
-  digits <- many1 baseDigit
-  let n = foldl (\x d -> base * x + toInteger (digitToInt d)) 0 digits
-  seq n (return n)
-
-decimal :: Parser Integer
-decimal = Tok.decimal lexer
-
--- | Parse a sign, return either @id@ or @negate@ based on the sign parsed.
--- Copied from Text.Parsec.Token
-sign :: Parser (Integer -> Integer)
-sign =
-  char '-' *> return negate
-    <|> char '+' *> return identity
-    <|> return identity
-
-intRadix :: Radix -> Parser Integer
-intRadix r = sign <*> numberWithRadix r
-
-textLiteral :: Parser T.Text
-textLiteral = T.pack <$> Tok.stringLiteral lexer
-
-nil :: Parser ()
-nil = try ((char '\'') *> string "()") *> return () <?> "nil"
-
-hashVal :: Parser Expr
-hashVal =
-  lexeme $
-    char '#'
-      *> ( char 't' *> return (Bool True)
-             <|> char 'f' *> return (Bool False)
-             <|> char 'b' *> (Numb <$> intRadix (2, oneOf "01"))
-             <|> char 'o' *> (Numb <$> intRadix (8, octDigit))
-             <|> char 'd' *> (Numb <$> intRadix (10, digit))
-             <|> char 'x' *> (Numb <$> intRadix (16, hexDigit))
-             <|> oneOf "ei" *> fail "Unsupported: exactness"
-             <|> char '(' *> fail "Unsupported: vector"
-             <|> char '\\' *> fail "Unsupported: char"
-         )
-
-lispVal :: Parser Expr
-lispVal =
-  hashVal
-    <|> Nil <$ nil
-    <|> Numb <$> try (sign <*> decimal)
-    <|> Atom <$> identifier
-    <|> Tape <$> textLiteral
-    <|> _Quote <$> quoted lispVal
-    <|> List <$> parens manyExpr
-
-manyExpr :: Parser [Expr]
-manyExpr = lispVal `sepBy` whitespace
-
-_Quote :: Expr -> Expr
-_Quote x = List [Atom "quote", x]
-
-contents :: Parser a -> ParsecT T.Text () Identity a
-contents p = whitespace *> lexeme p <* eof
-
-readExpr :: T.Text -> Either ParseError Expr
-readExpr = parse (contents lispVal) "<stdin>"
-
-readExprFile :: SourceName -> T.Text -> Either ParseError Expr
-readExprFile = parse (contents (List <$> manyExpr))
diff --git a/Biz/Language/Bs/Primitives.hs b/Biz/Language/Bs/Primitives.hs
deleted file mode 100644
index 4c70499..0000000
--- a/Biz/Language/Bs/Primitives.hs
+++ /dev/null
@@ -1,188 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-
--- | bs primitives
---
--- I would like to reduce the number of primitives in the language to some
--- minimal number, like SKI combinator or Nock instructions. I'm not sure what
--- the minimal number is. The idea is to move primitives from here into core.scm
--- over time.
-module Language.Bs.Primitives where
-
-import Control.Exception
-import Control.Monad.Except
-import Data.Text as T
-import Data.Text.IO as TIO
-import Language.Bs.Expr
-import Network.HTTP
-import Protolude
-import System.Directory
-import System.IO
-
-type Prim = [(T.Text, Expr)]
-
-type Unary = Expr -> Eval Expr
-
-type Binary = Expr -> Expr -> Eval Expr
-
-mkF :: ([Expr] -> Eval Expr) -> Expr
-mkF = IFun . IFunc
-
-primEnv :: Prim
-primEnv =
-  [ ("+", mkF $ binopFold (numOp (+)) (Numb 0)),
-    ("*", mkF $ binopFold (numOp (*)) (Numb 1)),
-    ("string-append", mkF $ binopFold (strOp (<>)) (Tape "")),
-    ("-", mkF $ binop $ numOp (-)),
-    ("<", mkF $ binop $ numCmp (<)),
-    ("<=", mkF $ binop $ numCmp (<=)),
-    (">", mkF $ binop $ numCmp (>)),
-    (">=", mkF $ binop $ numCmp (>=)),
-    ("==", mkF $ binop $ numCmp (==)),
-    ("even?", mkF $ unop $ numBool even),
-    ("odd?", mkF $ unop $ numBool odd),
-    ("neg?", mkF $ unop $ numBool (< 0)),
-    ("pos?", mkF $ unop $ numBool (> 0)),
-    ("eq?", mkF $ binop eqCmd),
-    ("null?", mkF $ unop (eqCmd Nil)),
-    ("bl-eq?", mkF $ binop $ eqOp (==)),
-    ("and", mkF $ binopFold (eqOp (&&)) (Bool True)),
-    ("or", mkF $ binopFold (eqOp (||)) (Bool False)),
-    ("not", mkF $ unop $ notOp),
-    ("cons", mkF $ Language.Bs.Primitives.cons),
-    ("cdr", mkF $ Language.Bs.Primitives.cdr),
-    ("car", mkF $ Language.Bs.Primitives.car),
-    ("quote", mkF $ quote),
-    ("file?", mkF $ unop fileExists),
-    ("slurp", mkF $ unop slurp),
-    ("wslurp", mkF $ unop wSlurp),
-    ("put", mkF $ binop put_)
-  ]
-
-unop :: Unary -> [Expr] -> Eval Expr
-unop op [x] = op x
-unop _ args = throw $ NumArgs 1 args
-
-binop :: Binary -> [Expr] -> Eval Expr
-binop op [x, y] = op x y
-binop _ args = throw $ NumArgs 2 args
-
-fileExists :: Expr -> Eval Expr
-fileExists (Tape txt) = Bool <$> liftIO (doesFileExist $ T.unpack txt)
-fileExists val = throw $ TypeMismatch "read expects string, instead got: " val
-
-slurp :: Expr -> Eval Expr
-slurp (Tape txt) = liftIO $ wFileSlurp txt
-slurp val = throw $ TypeMismatch "read expects string, instead got: " val
-
-wFileSlurp :: T.Text -> IO Expr
-wFileSlurp fileName = withFile (T.unpack fileName) ReadMode go
-  where
-    go = readTextFile fileName
-
-openURL :: T.Text -> IO Expr
-openURL x = do
-  req <- simpleHTTP (getRequest $ T.unpack x)
-  body <- getResponseBody req
-  return $ Tape $ T.pack body
-
-wSlurp :: Expr -> Eval Expr
-wSlurp (Tape txt) = liftIO $ openURL txt
-wSlurp val = throw $ TypeMismatch "wSlurp expects a string, instead got: " val
-
-readTextFile :: T.Text -> Handle -> IO Expr
-readTextFile fileName h = do
-  exists <- doesFileExist $ T.unpack fileName
-  if exists
-    then (TIO.hGetContents h) >>= (return . Tape)
-    else throw $ ReadFileError $ T.concat [" file does not exist: ", fileName]
-
-put_ :: Expr -> Expr -> Eval Expr
-put_ (Tape file) (Tape msg) = liftIO $ wFilePut file msg
-put_ (Tape _) val = throw $ TypeMismatch "put expects string in the second argument (try using show), instead got: " val
-put_ val _ = throw $ TypeMismatch "put expects string, instead got: " val
-
-wFilePut :: T.Text -> T.Text -> IO Expr
-wFilePut fileName msg = withFile (T.unpack fileName) WriteMode go
-  where
-    go = putTextFile fileName msg
-
-putTextFile :: T.Text -> T.Text -> Handle -> IO Expr
-putTextFile fileName msg h = do
-  canWrite <- hIsWritable h
-  if canWrite
-    then (TIO.hPutStr h msg) >> (return $ Tape msg)
-    else throw $ ReadFileError $ T.concat [" file does not exist: ", fileName]
-
-binopFold :: Binary -> Expr -> [Expr] -> Eval Expr
-binopFold op farg args = case args of
-  [] -> throw $ NumArgs 2 args
-  [a, b] -> op a b
-  _ -> foldM op farg args
-
-numBool :: (Integer -> Bool) -> Expr -> Eval Expr
-numBool op (Numb x) = return $ Bool $ op x
-numBool _ x = throw $ TypeMismatch "numeric op " x
-
-numOp :: (Integer -> Integer -> Integer) -> Expr -> Expr -> Eval Expr
-numOp op (Numb x) (Numb y) = return $ Numb $ op x y
-numOp _ Nil (Numb y) = return $ Numb y
-numOp _ (Numb x) Nil = return $ Numb x
-numOp _ x (Numb _) = throw $ TypeMismatch "numeric op" x
-numOp _ (Numb _) y = throw $ TypeMismatch "numeric op" y
-numOp _ x _ = throw $ TypeMismatch "numeric op" x
-
-strOp :: (T.Text -> T.Text -> T.Text) -> Expr -> Expr -> Eval Expr
-strOp op (Tape x) (Tape y) = return $ Tape $ op x y
-strOp _ Nil (Tape y) = return $ Tape y
-strOp _ (Tape x) Nil = return $ Tape x
-strOp _ x (Tape _) = throw $ TypeMismatch "string op" x
-strOp _ (Tape _) y = throw $ TypeMismatch "string op" y
-strOp _ x _ = throw $ TypeMismatch "string op" x
-
-eqOp :: (Bool -> Bool -> Bool) -> Expr -> Expr -> Eval Expr
-eqOp op (Bool x) (Bool y) = return $ Bool $ op x y
-eqOp _ x (Bool _) = throw $ TypeMismatch "bool op" x
-eqOp _ (Bool _) y = throw $ TypeMismatch "bool op" y
-eqOp _ x _ = throw $ TypeMismatch "bool op" x
-
-numCmp :: (Integer -> Integer -> Bool) -> Expr -> Expr -> Eval Expr
-numCmp op (Numb x) (Numb y) = return . Bool $ op x y
-numCmp _ x (Numb _) = throw $ TypeMismatch "numeric op" x
-numCmp _ (Numb _) y = throw $ TypeMismatch "numeric op" y
-numCmp _ x _ = throw $ TypeMismatch "numeric op" x
-
-notOp :: Expr -> Eval Expr
-notOp (Bool True) = return $ Bool False
-notOp (Bool False) = return $ Bool True
-notOp x = throw $ TypeMismatch " not expects Bool" x
-
-eqCmd :: Expr -> Expr -> Eval Expr
-eqCmd (Atom x) (Atom y) = return . Bool $ x == y
-eqCmd (Numb x) (Numb y) = return . Bool $ x == y
-eqCmd (Tape x) (Tape y) = return . Bool $ x == y
-eqCmd (Bool x) (Bool y) = return . Bool $ x == y
-eqCmd Nil Nil = return $ Bool True
-eqCmd _ _ = return $ Bool False
-
-cons :: [Expr] -> Eval Expr
-cons [x, (List ys)] = return $ List $ x : ys
-cons [x, y] = return $ List [x, y]
-cons _ = throw $ ExpectedList "cons, in second argument"
-
-car :: [Expr] -> Eval Expr
-car [List []] = return Nil
-car [List (x : _)] = return x
-car [] = return Nil
-car _ = throw $ ExpectedList "car"
-
-cdr :: [Expr] -> Eval Expr
-cdr [List (_ : xs)] = return $ List xs
-cdr [List []] = return Nil
-cdr [] = return Nil
-cdr _ = throw $ ExpectedList "cdr"
-
-quote :: [Expr] -> Eval Expr
-quote [List xs] = return $ List $ Atom "quote" : xs
-quote [expr] = return $ List $ Atom "quote" : [expr]
-quote args = throw $ NumArgs 1 args
diff --git a/Biz/Language/Bs/Repl.hs b/Biz/Language/Bs/Repl.hs
deleted file mode 100644
index 24f1bcd..0000000
--- a/Biz/Language/Bs/Repl.hs
+++ /dev/null
@@ -1,36 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-
-module Language.Bs.Repl
-  ( mainLoop,
-  )
-where
-
-import Control.Monad.Trans
-import Data.String
-import Data.Text as T
-import Language.Bs.Eval
-import Protolude
-import System.Console.Haskeline
-
-type Repl a = InputT IO a
-
-mainLoop :: IO ()
-mainLoop = runInputT defaultSettings repl
-
-repl :: Repl ()
-repl = do
-  minput <- getInputLine "bs> "
-  case minput of
-    Nothing -> outputStrLn "bye."
-    Just input -> (liftIO $ process input) >> repl
-
---Just input -> (liftIO $ processToAST input) >> repl
-
-process :: String -> IO ()
-process str = do
-  res <- safeExec $ evalText $ T.pack str
-  either putStrLn return res
-
-processToAST :: String -> IO ()
-processToAST str = print $ runParseTest $ T.pack str
diff --git a/Biz/Language/Bs/Test.hs b/Biz/Language/Bs/Test.hs
deleted file mode 100644
index 4a40036..0000000
--- a/Biz/Language/Bs/Test.hs
+++ /dev/null
@@ -1,2 +0,0 @@
--- TODO
-module Language.Bs.Test where
diff --git a/Hero/App.hs b/Hero/App.hs
index 6afcbd2..39cfa03 100644
--- a/Hero/App.hs
+++ b/Hero/App.hs
@@ -165,7 +165,7 @@ instance IsMediaObject Comic where
       title =
         "color" =: "red" <> "font-size" =: "1.6rem" <> uppercase
           <> "line-height"
-          =: "100%"
+            =: "100%"
           <> Look.condensed
           <> bold
       subtitle = "color" =: "#fff" <> "font-size" =: "1.2rem" <> bold <> Look.condensed
@@ -211,14 +211,14 @@ instance Elemental Button where
     if c `elem` lib -- in library
       then
         a_
-          [class_ $ "wrs-button saved", onClick $ ToggleInLibrary c]
+          [class_ "wrs-button saved", onClick $ ToggleInLibrary c]
           [ img_ [src_ $ ms $ Assets.icon <> "save.svg"],
             span_ [] [text "saved"]
           ]
       else-- not in library
 
         a_
-          [class_ $ "wrs-button", onClick $ ToggleInLibrary c]
+          [class_ "wrs-button", onClick $ ToggleInLibrary c]
           [ img_ [src_ $ ms $ Assets.icon <> "save.svg"],
             span_ [] [text "save"]
           ]
@@ -259,13 +259,13 @@ instance Elemental Button where
       ]
   el (Read c) =
     a_
-      [class_ $ "wrs-button", onClick $ SelectExperience c]
+      [class_ "wrs-button", onClick $ SelectExperience c]
       [ img_ [src_ $ ms $ Assets.icon <> "read.svg"],
         span_ [] [text "read"]
       ]
   el (Watch c) =
     a_
-      [class_ $ "wrs-button", onClick $ StartWatching c]
+      [class_ "wrs-button", onClick $ StartWatching c]
       [ img_ [src_ $ ms $ Assets.icon <> "watch.svg"],
         span_ [] [text "watch"]
       ]
@@ -284,7 +284,7 @@ data ComicReaderState
   deriving (Show, Eq)
 
 findComic :: ComicId -> [Comic] -> Maybe Comic
-findComic id ls = List.find (\c -> comicId c == id) ls
+findComic id = List.find . \c -> comicId c == id
 
 -- | Main model for the app.
 --
@@ -442,7 +442,7 @@ home :: Model -> View Action
 home = login
 
 discover :: Model -> View Action
-discover model@(Model {userLibrary = lib}) =
+discover model@Model {userLibrary = lib} =
   template
     "discover"
     [ topbar,
@@ -454,7 +454,7 @@ discover model@(Model {userLibrary = lib}) =
         Success (comic : rest) ->
           [ feature comic lib,
             shelf "Recent Releases" (comic : rest),
-            maybeView (flip info lib) $ dMediaInfo model
+            maybeView (`info` lib) $ dMediaInfo model
           ],
       appmenu,
       discoverFooter
@@ -462,7 +462,7 @@ discover model@(Model {userLibrary = lib}) =
 
 -- | If 'View' had a 'Monoid' instance, then '(text "")' could just be 'mempty'
 maybeView :: (a -> View action) -> Maybe a -> View action
-maybeView f obj = maybe (text "") f obj
+maybeView = maybe (text "")
 
 mediaInfo :: Maybe Comic -> Library -> View Action
 mediaInfo Nothing _ = text ""
@@ -481,7 +481,7 @@ appmenu = aside_ [id_ "appmenu"] $ btn </ links
     btn (lnk, img, label) =
       a_
         [ class_ "button",
-          onPreventClick $ ChangeURI $ lnk
+          onPreventClick $ ChangeURI lnk
         ]
         [ img_ [src_ $ ms $ Assets.icon <> img],
           span_ [] [text label]
@@ -540,7 +540,7 @@ discoverFooter =
         [img_ [src_ $ ms $ Assets.cdnEdge <> "/old-assets/images/icons/" <> x]]
 
 comicCover :: ComicId -> Model -> View Action
-comicCover comicId_ model = comicPlayer comicId_ 1 model
+comicCover comicId_ = comicPlayer comicId_ 1
 
 data ComicReaderView = Spread | Full
   deriving (Show, Eq)
@@ -572,7 +572,7 @@ viewOr404 comics f id pg model =
     Nothing -> the404 model
 
 template :: MisoString -> [View Action] -> View Action
-template id rest = div_ [id_ id, class_ "app is-black"] rest
+template id = div_ [id_ id, class_ "app is-black"]
 
 closeButton :: View Action
 closeButton =
@@ -631,7 +631,7 @@ comicSpread comic page model =
       ms Assets.demo
         <> ms (comicSlug comic)
         <> "-"
-        <> (padLeft $ 1 + page)
+        <> padLeft (1 + page)
         <> ".png"
 
 frameborder_ :: MisoString -> Attribute action
@@ -661,7 +661,7 @@ comicVideo _ _ _ =
 
 padLeft :: Int -> MisoString
 padLeft n
-  | n < 10 = ms $ ("0" <> Legacy.show n)
+  | n < 10 = ms ("0" <> Legacy.show n)
   | otherwise = ms $ Legacy.show n
 
 comicControls :: Comic -> Page -> Model -> View Action
@@ -670,7 +670,7 @@ comicControls comic page model =
     [id_ "app-foot", class_ "comic-controls"]
     [ div_
         [ class_ "comic-nav-audio",
-          css $ flexCenter
+          css flexCenter
         ]
         [ audio_
             [id_ audioId, loop_ True, crossorigin_ "anonymous"]
@@ -682,9 +682,9 @@ comicControls comic page model =
         ],
       div_
         [class_ "comic-controls-pages", css euro]
-        [ el $ Arrow $ PrevPage,
+        [ el $ Arrow PrevPage,
           span_ [] [text $ leftPage <> "-" <> rightPage <> " of " <> totalpages],
-          el $ Arrow $ NextPage
+          el $ Arrow NextPage
         ],
       div_
         [class_ "comic-controls-share"]
@@ -767,7 +767,7 @@ chooseExperiencePage comic page model =
             [ img_ [src_ $ ms $ Assets.demo <> name <> ".png"],
               span_ [] [text $ ms name]
             ],
-          span_ [css $ thicc] [text $ ms artist],
+          span_ [css thicc] [text $ ms artist],
           span_ [] [text $ ms track]
         ]
     experiences :: [(Text, Text, Text)]
@@ -821,7 +821,7 @@ column = div_ [css $ Clay.display Clay.flex <> Clay.flexDirection Clay.column]
 
 -- | Links
 comicLink :: ComicId -> URI
-comicLink comicId_ = linkURI $ safeLink routes comicProxy $ comicId_
+comicLink comicId_ = linkURI $ safeLink routes comicProxy comicId_
 
 comicPlayerSpreadLink :: ComicId -> Page -> URI
 comicPlayerSpreadLink id page =
diff --git a/Hero/Client.hs b/Hero/Client.hs
index 0472d48..a513dcd 100644
--- a/Hero/Client.hs
+++ b/Hero/Client.hs
@@ -122,7 +122,7 @@ move PrevPage model = case cpState model of
       pure $ ChangeURI $ comicPlayerFullLink id (pg -1)
   Cover _ -> noEff model
   _ -> noEff model
-move (ToggleZoom c pg) m = m {cpState = newState} <# do pure act
+move (ToggleZoom c pg) m = m {cpState = newState} <# pure act
   where
     goto lnk = ChangeURI $ lnk (comicId c) pg
     reading v = Reading v (comicId c) pg
@@ -133,9 +133,9 @@ move (ToggleZoom c pg) m = m {cpState = newState} <# do pure act
 move (ToggleInLibrary c) model = model {userLibrary = newLib} <# pure NoOp
   where
     newLib
-      | c `elem` (userLibrary model) =
+      | c `elem` userLibrary model =
         Protolude.filter (/= c) $ userLibrary model
-      | otherwise = c : (userLibrary model)
+      | otherwise = c : userLibrary model
 move (HandleURI u) model = model {uri = u} <# pure NoOp
 move (ChangeURI u) model = model <# do
   pushURI u
@@ -162,8 +162,8 @@ move ToggleFullscreen model = model {cpState = newState} <# do
       Reading Spread c n -> (Fullscreen.request, Reading Spread c n)
       -- otherwise, do nothing:
       x -> (pure, x)
-move (SetMediaInfo x) model = model {dMediaInfo = x} <# do
-  case x of
+move (SetMediaInfo x) model = model {dMediaInfo = x}
+  <# case x of
     Just Comic {comicId = id} ->
       pure $ ScrollIntoView $ "comic-" <> ms id
     Nothing ->
diff --git a/Hero/Database.hs b/Hero/Database.hs
index 0166c6f..5b7f75d 100644
--- a/Hero/Database.hs
+++ b/Hero/Database.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
diff --git a/Hero/Look.hs b/Hero/Look.hs
index 662b223..b676c13 100644
--- a/Hero/Look.hs
+++ b/Hero/Look.hs
@@ -27,17 +27,12 @@ main = do
   -- base
   ".fixed" ? position fixed
   ".clickable" ? clickable
-  ".row" ? do
-    display flex
-    alignItems center
-    justifyContent spaceBetween
+  ".row" ? centerJustify
   a <> a # hover <> a # visited ? do
     color white
     textDecoration none
   ".loading" ? do
-    display flex
-    justifyContent center
-    alignItems center
+    centered
     height $ vh 100
     width $ vw 100
   -- animations
@@ -113,7 +108,7 @@ main = do
   "#app-foot" ? do
     alignSelf flexEnd
     bottom (px 0)
-    mobile $ remove
+    mobile remove
   "#app-foot-social" ? do
     display flex
     flexDirection column
@@ -127,20 +122,17 @@ main = do
     textTransform Clay.uppercase
     textAlign center
     -- hide app-foot-quote when it gets crowded
-    query Clay.all [Media.maxDeviceWidth (px 800)] $
+    query
+      Clay.all
+      [Media.maxDeviceWidth (px 800)]
       hide
   -- login
   "#login" ? do
     -- TODO: next 3 lines can be DRYed up, methinks
-    display flex
-    justifyContent center
-    alignItems center
-    alignSelf center
+    centered
     height (vh 100)
   "#login-inner" ? do
-    display flex
-    justifyContent center
-    alignItems center
+    centered
     flexDirection column
     zIndex 1
     height (vh 100)
@@ -151,8 +143,8 @@ main = do
     display flex
     alignItems center
     flexDirection column
-  "#login" ** form <> "#login" ** hr ? do
-    width (pct 100)
+  "#login" ** form <> "#login" ** hr
+    ? width (pct 100)
   "#login" ** hr ? border solid (px 1) grai
   "#login" ** ".button" ? do
     marginTop (px 10)
@@ -228,7 +220,7 @@ main = do
     lineHeight z
     let m = 24 :: Double
     top $ px $ navbarHeight + m
-    left $ px $ m
+    left $ px m
     zIndex 999
   -- zoom button and slider
   "#zoom-button" ? do
@@ -259,9 +251,7 @@ main = do
     borderTop solid (px 1) white
     borderBottom solid (px 1) white
     flexDirection row
-    display flex
-    alignItems center
-    justifyContent spaceBetween
+    centerJustify
     mobile $ do
       margin (rem 2) 0 (rem 2) 0
       padding 0 0 0 (rem 0)
@@ -277,7 +267,7 @@ main = do
       width (vw 90) -- this line can be commented if you want to center the meta
       img ? width (px 150)
       order (-1)
-      Flexbox.flex 1 1 (auto)
+      Flexbox.flex 1 1 auto
   ".media-info-summary" ? do
     Flexbox.flex 2 1 (px 0)
     paddingRight (rem 3)
@@ -293,7 +283,7 @@ main = do
     mobile $ do
       maxWidth (vw 100)
       flexDirection row
-      order (1)
+      order 1
       flexBasis auto -- initial
       height (px 50)
   -- appmenu
@@ -333,9 +323,8 @@ main = do
     button ? margin (rem 0.5) 0 (rem 0.5) 0
   -- feature
   "#featured-comic" ? do
-    display flex
+    centered
     flexDirection column
-    justifyContent center
     Typo.euro
     height (px 411)
     mobile $ do
@@ -347,8 +336,8 @@ main = do
       background $
         linearGradient
           (straight sideTop)
-          [ (setA 0 nite, (pct 0)),
-            (nite, (pct 100))
+          [ (setA 0 nite, pct 0),
+            (nite, pct 100)
           ]
       let h = 149
       marginTop (px (- h))
@@ -360,7 +349,7 @@ main = do
       fontSize (rem 1.2)
     ".description" ? do
       width (px 400)
-      mobile $ remove
+      mobile remove
   "#featured-banner" ? do
     position relative
     minHeight (px 411)
@@ -415,9 +404,8 @@ main = do
       padding (rem 0.5) (rem 0.5) (rem 0.5) (rem 0.5)
       width (vw 100)
     ".comic" ? do
-      display flex
+      centered
       flexDirection column
-      justifyContent center
       textAlign center
       euro
       maxWidth (px 110)
@@ -449,9 +437,18 @@ main = do
 navbarHeight :: Double
 navbarHeight = 74
 
----------------------------------------------------------------------------------
--- utilities
----------------------------------------------------------------------------------
+centered :: Css
+centered = do
+  display flex
+  justifyContent center
+  alignItems center
+  alignSelf center
+
+centerJustify :: Css
+centerJustify = do
+  display flex
+  alignItems center
+  justifyContent spaceBetween
 
 hide :: Css
 hide = visibility hidden
@@ -472,7 +469,7 @@ rounded :: Css
 rounded = borderRadius (px 30) (px 30) (px 30) (px 30)
 
 appmenuWidth :: Size LengthUnit
-appmenuWidth = (px 67)
+appmenuWidth = px 67
 
 flexCenter :: Css
 flexCenter = do
diff --git a/Hero/Server.hs b/Hero/Server.hs
index 450bd0d..bf92f88 100644
--- a/Hero/Server.hs
+++ b/Hero/Server.hs
@@ -1,14 +1,12 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 
 -- | Hero web app
@@ -78,8 +76,8 @@ main = bracket startup shutdown $ uncurry Warp.run
       Left e -> Exit.die e
       Right c -> do
         db <- Database.dummy
-        say $ "hero"
-        say $ "port: " ++ (show $ heroPort c)
+        say "hero"
+        say $ "port: " ++ show $ heroPort c
         say $ "client: " ++ heroClient c
         let waiapp = app db c
         return (heroPort c, waiapp)
@@ -275,7 +273,7 @@ serverHandlers =
     :<|> chooseExperienceHandler
 
 jsonHandlers :: Database.ComicDB -> Server JsonApi
-jsonHandlers db = Database.getComics db
+jsonHandlers = Database.getComics
 
 homeHandler :: Handler (HtmlPage (View Action))
 homeHandler = pure . HtmlPage . home $ initModel homeLink
diff --git a/Que/Server.hs b/Que/Server.hs
index b0f3fbd..9e8d893 100644
--- a/Que/Server.hs
+++ b/Que/Server.hs
@@ -84,7 +84,7 @@ newtype App a
         (STM.TVar AppState)
     )
 
-data AppState
+newtype AppState
   = AppState
       { ques :: HashMap Namespace Quebase
       }
@@ -92,7 +92,7 @@ data AppState
 initialAppState :: AppState
 initialAppState = AppState {ques = mempty}
 
-data Config
+newtype Config
   = Config
       { -- | QUE_PORT
         quePort :: Warp.Port
@@ -139,9 +139,9 @@ routes = do
     q <- app <| que ns qp
     poll <- Scotty.param "poll" !: (pure . const False)
     guardNs ns ["pub", "_"]
-    case poll of
-      True -> Scotty.stream $ streamQue q
-      _ -> do
+    if poll
+      then Scotty.stream $ streamQue q
+      else do
         r <- liftIO <| Go.read q
         Scotty.html <| fromStrict <| Encoding.decodeUtf8 r
   -- POST que
@@ -225,7 +225,7 @@ app = lift
 
 -- | Get something from the app state
 gets :: (AppState -> b) -> App b
-gets f = ask >>= liftIO . STM.readTVarIO >>= return . f
+gets f = ask >>= liftIO . STM.readTVarIO >>= return </ f
 
 -- | Apply a function to the app state
 modify :: (AppState -> AppState) -> App ()
diff --git a/Que/Website.hs b/Que/Website.hs
index cfb860c..7eb3ae6 100644
--- a/Que/Website.hs
+++ b/Que/Website.hs
@@ -53,7 +53,7 @@ getKey :: Namespace -> IO (Maybe Key)
 getKey ns = do
   home <- Directory.getHomeDirectory
   let file = home </> ".config" </> "que.conf"
-  exists <- (Directory.doesFileExist file)
+  exists <- Directory.doesFileExist file
   unless exists <| panic <| "not found: " <> Text.pack file
   conf <- Text.readFile file
   print (home </> ".config" </> "que.conf")
@@ -84,7 +84,7 @@ auth "pub" = pure Nothing
 auth ns = Config.sectionMb ns <| Config.field "key"
 
 run :: Maybe Key -> Text -> Sources -> IO ()
-run key ns Sources {..} = Async.runConcurrently actions >> return ()
+run key ns Sources {..} = Async.runConcurrently actions |> void
   where
     actions =
       traverse
diff --git a/Que/client.py b/Que/client.py
index 3d9291d..6958576 100755
--- a/Que/client.py
+++ b/Que/client.py
@@ -17,16 +17,16 @@ MAX_TIMEOUT = 99999999  # basically never timeout
 
 
 def auth(args):
-    ns = args.target.split("/")[0]
-    if ns == "pub":
+    "Returns the auth key for the given ns from ~/.config/que.conf"
+    namespace = args.target.split("/")[0]
+    if namespace == "pub":
         return None
-    else:
-        conf_file = os.path.expanduser("~/.config/que.conf")
-        if not os.path.exists(conf_file):
-            sys.exit("you need a ~/.config/que.conf")
+    conf_file = os.path.expanduser("~/.config/que.conf")
+    if not os.path.exists(conf_file):
+        sys.exit("you need a ~/.config/que.conf")
         cfg = configparser.ConfigParser()
         cfg.read(conf_file)
-        return cfg[ns]["key"]
+    return cfg[namespace]["key"]
 
 
 def send(args):
@@ -53,7 +53,9 @@ def recv(args):
         print(msg)
         if args.then:
             subprocess.run(
-                args.then.replace("\msg", msg).replace("\que", args.target), shell=True
+                args.then.replace(r"\msg", msg).replace(r"que", args.target),
+                shell=True,
+                check=False,
             )
 
     params = urllib.parse.urlencode({"poll": args.poll})
@@ -70,8 +72,8 @@ def recv(args):
             _recv(_req)
 
 
-def autodecode(b):
-    """Attempt to decode bytes `b` into common codecs, preferably utf-8. If
+def autodecode(bytestring):
+    """Attempt to decode bytes `bs` into common codecs, preferably utf-8. If
     no decoding is available, just return the raw bytes.
 
     For all available codecs, see:
@@ -81,13 +83,14 @@ def autodecode(b):
     codecs = ["utf-8", "ascii"]
     for codec in codecs:
         try:
-            return b.decode(codec)
+            return bytestring.decode(codec)
         except UnicodeDecodeError:
             pass
-    return b
+    return bytestring
 
 
 def get_args():
+    "Command line parser"
     cli = argparse.ArgumentParser(description=__doc__)
     cli.add_argument(
         "--host", default="http://que.run", help="where que-server is running"
@@ -101,7 +104,7 @@ def get_args():
             [
                 "when polling, run this shell command after each response,",
                 "presumably for side effects,"
-                "replacing '\que' with the target and '\msg' with the body of the response",
+                r"replacing '\que' with the target and '\msg' with the body of the response",
             ]
         ),
     )
@@ -129,21 +132,21 @@ def get_args():
 
 
 if __name__ == "__main__":
-    args = get_args()
+    ARGV = get_args()
     try:
-        if args.infile:
-            send(args)
+        if ARGV.infile:
+            send(ARGV)
         else:
-            recv(args)
+            recv(ARGV)
     except KeyboardInterrupt:
         sys.exit(0)
-    except urllib.error.HTTPError as e:
-        print(e)
+    except urllib.error.HTTPError as err:
+        print(err)
         sys.exit(1)
-    except http.client.RemoteDisconnected as e:
+    except http.client.RemoteDisconnected as err:
         print("disconnected... retrying in 5 seconds")
         time.sleep(5)
-        if args.infile:
-            send(args)
+        if ARGV.infile:
+            send(ARGV)
         else:
-            recv(args)
+            recv(ARGV)
diff --git a/System/Random/Shuffle.hs b/System/Random/Shuffle.hs
index 774e7b4..d3cd387 100644
--- a/System/Random/Shuffle.hs
+++ b/System/Random/Shuffle.hs
@@ -25,8 +25,7 @@ module System.Random.Shuffle
 where
 
 import Control.Monad
-  ( liftM,
-    liftM2,
+  ( liftM2,
   )
 import Control.Monad.Random
   ( MonadRandom,
@@ -49,13 +48,13 @@ data Tree a
 
 -- | Convert a sequence (e1...en) to a complete binary tree
 buildTree :: [a] -> Tree a
-buildTree = (fix growLevel) . (map Leaf)
+buildTree = fix growLevel . map Leaf
   where
     growLevel _ [node] = node
     growLevel self l = self $ inner l
     inner [] = []
     inner [e] = [e]
-    inner (e1 : e2 : es) = e1 `seq` e2 `seq` (join e1 e2) : inner es
+    inner (e1 : e2 : es) = e1 `seq` e2 `seq` join e1 e2 : inner es
     join l@(Leaf _) r@(Leaf _) = Node 2 l r
     join l@(Node ct _ _) r@(Leaf _) = Node (ct + 1) l r
     join l@(Leaf _) r@(Node ct _ _) = Node (ct + 1) l r
@@ -70,7 +69,7 @@ shuffle elements = shuffleTree (buildTree elements)
   where
     shuffleTree (Leaf e) [] = [e]
     shuffleTree tree (r : rs) =
-      let (b, rest) = extractTree r tree in b : (shuffleTree rest rs)
+      let (b, rest) = extractTree r tree in b : shuffleTree rest rs
     shuffleTree _ _ = error "[shuffle] called with lists of different lengths"
     -- Extracts the n-th element from the tree and returns
     -- that element, paired with a tree with the element
@@ -99,7 +98,7 @@ shuffle' elements len = shuffle elements . rseq len
     -- independent sample from a uniform random distribution
     -- [0..n-i]
     rseq :: RandomGen gen => Int -> gen -> [Int]
-    rseq n = fst . unzip . rseq' (n - 1)
+    rseq n = map fst . rseq' (n - 1)
       where
         rseq' :: RandomGen gen => Int -> gen -> [(Int, gen)]
         rseq' 0 _ = []
@@ -111,7 +110,7 @@ shuffle' elements len = shuffle elements . rseq len
 shuffleM :: (MonadRandom m) => [a] -> m [a]
 shuffleM elements
   | null elements = return []
-  | otherwise = liftM (shuffle elements) (rseqM (length elements - 1))
+  | otherwise = shuffle elements <$> rseqM (length elements - 1)
   where
     rseqM :: (MonadRandom m) => Int -> m [Int]
     rseqM 0 = return []