Remove $ from Alpha

7 files changed, 36 insertions, 41 deletions

diff --git a/Alpha.hs b/Alpha.hs
index 934cc31..e19f9be 100644
--- a/Alpha.hs
+++ b/Alpha.hs
@@ -46,13 +46,11 @@ module Alpha
   )
 where
 
-import Data.Function ((&))
-import Data.Functor ((<&>))
 import Data.String
 import Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Text.Lazy as LazyText
-import Protolude as X
+import Protolude as X hiding (($), (&))
 
 -- | Debugging printf
 say :: Text -> IO ()
@@ -60,7 +58,7 @@ say = putText
 
 -- | Alias for map, fmap, <$>
 (</) :: Functor f => (a -> b) -> f a -> f b
-(</) = fmap
+f </ g = fmap f g
 
 -- | Double fmap. A function on the left goes "into" two functors
 -- (i.e. it goes "two levels deep"), applies the function to the inner
@@ -71,20 +69,20 @@ say = putText
 -- | Normal function application. Do the right side, then pass the
 -- return value to the function on the left side.
 (<|) :: (a -> b) -> a -> b
-(<|) = ($)
+f <| g = f (g)
 
 infixr 0 <|
 
 -- | Reverse function application. Do the left side, then pass the
 -- return value to the function on the right side.
 (|>) :: a -> (a -> b) -> b
-(|>) = (&)
+f |> g = g (f)
 
 -- | Alias for <&>. Can be read as "and then". Basically does into a
 -- functor, does some computation, then returns the same kind of
 -- functor. Could also be defined as `f >>= return . g`
 (/>) :: Functor f => f a -> (a -> b) -> f b
-(/>) = (<&>)
+f /> g = fmap g f
 
 -- | Removes newlines from text.
 chomp :: Text -> Text
diff --git a/Biz/Bild/Deps.nix b/Biz/Bild/Deps.nix
index dccbd81..a1e72ba 100644
--- a/Biz/Bild/Deps.nix
+++ b/Biz/Bild/Deps.nix
@@ -7,6 +7,7 @@
   "bytestring"
   "capability"
   "clay"
+  "cmark"
   "config-ini"
   "containers"
   "directory"
diff --git a/Biz/Bild/Rules.nix b/Biz/Bild/Rules.nix
index 6afe9a0..9fea5df 100644
--- a/Biz/Bild/Rules.nix
+++ b/Biz/Bild/Rules.nix
@@ -36,6 +36,10 @@ let
     deps = lib.lists.flatten (removeNull
       (map (builtins.match "^-- : dep ([[:alnum:]._-]*)$")
         (lines content)));
+
+    sysdeps = lib.lists.flatten (removeNull
+      (map (builtins.match "^-- : sys ([[:alum:]._-]*)$")
+        (lines content)));
   };
 
   mkGhc = compiler: (deps: compiler (hp:
@@ -56,7 +60,7 @@ in {
     in stdenv.mkDerivation {
       name = data.module;
       src = ../.;
-      nativeBuildInputs = [ ghc ];
+      nativeBuildInputs = [ ghc ] ++ depsToPackageSet nixpkgs data.sysdeps;
       strictDeps = true;
       buildPhase = ''
         mkdir -p $out/bin
@@ -111,6 +115,7 @@ in {
         "ghcjs-base"
       ])
 
+      nixpkgs.cmark
       nixpkgs.figlet
       nixpkgs.hlint
       nixpkgs.lolcat
diff --git a/Biz/Pie.hs b/Biz/Pie.hs
index 3823db3..7e1c19e 100644
--- a/Biz/Pie.hs
+++ b/Biz/Pie.hs
@@ -97,7 +97,7 @@ loadForm :: Namespace -> IO Form
 loadForm ns = Directory.doesFileExist file >>= \case
   False -> touch file >> return mempty
   True -> Aeson.decodeFileStrict file >>= \case
-    Nothing -> panic $ Text.pack $ "could not decode: " ++ file
+    Nothing -> panic <| Text.pack <| "could not decode: " ++ file
     Just x -> return x
   where
     file = formFile ns
@@ -123,7 +123,7 @@ move mov form = case mov of
             Exit.ExitFailure _ ->
               Process.callProcess "git" ["switch", "-c", branch]
           >> return form
-  Update -> Haskeline.runInputT Haskeline.defaultSettings $ do
+  Update -> Haskeline.runInputT Haskeline.defaultSettings <| do
     timestamp <- liftIO Clock.getCurrentTime
     onTrack <- parseBool </ question "Are you on track?"
     isLaunched <- parseBool </ question "Are you launched?"
@@ -135,7 +135,7 @@ move mov form = case mov of
     biggestObstacle <- parseText </ question "What is your biggest obstacle?"
     goals <- parseText </ question "What are your top 1-3 goals for next week?"
     return <| form {roll = BuildSprint {..} : (roll form)}
-  Feedback -> Haskeline.runInputT Haskeline.defaultSettings $ do
+  Feedback -> Haskeline.runInputT Haskeline.defaultSettings <| do
     timestamp <- liftIO Clock.getCurrentTime
     user <- parseText </ question "User?"
     howDisappointed <- parseDisappointment </ question "How disappointed? (1=very, 2=somewhat, 3=not)"
diff --git a/Control/Concurrent/Go.hs b/Control/Concurrent/Go.hs
index 08a1d65..69d35b8 100644
--- a/Control/Concurrent/Go.hs
+++ b/Control/Concurrent/Go.hs
@@ -50,7 +50,7 @@ fork = Concurrent.forkIO
 chan :: Int -> IO (Channel a)
 chan n = do
   (i, o) <- Chan.newChan n
-  return $ Channel i o n
+  return <| Channel i o n
 
 -- | A channel for broadcasting to multiple consumers. See 'mult'.
 type Mult a = Chan.OutChan a
diff --git a/Que/Server.hs b/Que/Server.hs
index 4cb0b32..9217ee8 100644
--- a/Que/Server.hs
+++ b/Que/Server.hs
@@ -25,13 +25,7 @@ module Que.Server
   )
 where
 
-import Alpha hiding
-  ( Text,
-    get,
-    gets,
-    modify,
-    poll,
-  )
+import Alpha hiding (gets, modify, poll)
 import qualified Control.Concurrent.Go as Go
 import qualified Control.Concurrent.STM as STM
 import qualified Control.Exception as Exception
@@ -41,11 +35,8 @@ import qualified Data.ByteString.Lazy as BSL
 import Data.HashMap.Lazy (HashMap)
 import qualified Data.HashMap.Lazy as HashMap
 import qualified Data.Text.Encoding as Encoding
-import Data.Text.Lazy
-  ( Text,
-    fromStrict,
-  )
-import qualified Data.Text.Lazy.IO as Text
+import qualified Data.Text.Lazy as Text.Lazy
+import qualified Data.Text.Lazy.IO as Text.Lazy.IO
 import qualified Network.HTTP.Types.Status as Http
 import qualified Network.Wai as Wai
 import qualified Network.Wai.Handler.Warp as Warp
@@ -105,7 +96,7 @@ instance Envy.DefConfig Config where
 
 instance Envy.FromEnv Config
 
-routes :: Scotty.ScottyT Text App ()
+routes :: Scotty.ScottyT Text.Lazy.Text App ()
 routes = do
   Scotty.middleware logStdout
   let quepath = "^\\/([[:alnum:]_-]+)\\/([[:alnum:]._/-]*)$"
@@ -117,7 +108,7 @@ routes = do
   -- GET /_/dash
   Scotty.get (Scotty.literal "/_/dash") <| do
     authkey <- fromMaybe "" </ Scotty.header "Authorization"
-    adminkey <- liftIO <| lchomp </ Text.readFile "/run/keys/que-admin"
+    adminkey <- liftIO <| lchomp </ Text.Lazy.IO.readFile "/run/keys/que-admin"
     if authkey == adminkey
       then do
         d <- app <| gets ques
@@ -141,7 +132,7 @@ routes = do
     q <- app <| que ns qp
     poll <- Scotty.param "poll" !: (pure . const False)
     if poll
-      then Scotty.stream $ streamQue q
+      then Scotty.stream <| streamQue q
       else do
         r <- liftIO <| Go.read q
         Scotty.html <| fromStrict <| Encoding.decodeUtf8 r
@@ -150,7 +141,7 @@ routes = do
   -- Put a value on a que. Returns immediately.
   Scotty.post (Scotty.regex quepath) <| do
     authkey <- fromMaybe "" </ Scotty.header "Authorization"
-    adminkey <- liftIO <| lchomp </ Text.readFile "/run/keys/que-admin"
+    adminkey <- liftIO <| lchomp </ Text.Lazy.IO.readFile "/run/keys/que-admin"
     (ns, qp) <- extract
     -- Only allow my IP or localhost to publish to '_' namespace
     when ("_" == ns && authkey /= adminkey)
@@ -167,7 +158,7 @@ routes = do
 
 -- | Given `guardNs ns whitelist`, if `ns` is not in the `whitelist`
 -- list, return a 405 error.
-guardNs :: Text -> [Text] -> Scotty.ActionT Text App ()
+guardNs :: Text.Lazy.Text -> [Text.Lazy.Text] -> Scotty.ActionT Text.Lazy.Text App ()
 guardNs ns whitelist = when (not <| ns `elem` whitelist) <| do
   Scotty.status Http.methodNotAllowed405
   Scotty.text
@@ -179,10 +170,10 @@ guardNs ns whitelist = when (not <| ns `elem` whitelist) <| do
 -- | recover from a scotty-thrown exception.
 (!:) ::
   -- | action that might throw
-  Scotty.ActionT Text App a ->
+  Scotty.ActionT Text.Lazy.Text App a ->
   -- | a function providing a default response instead
-  (Text -> Scotty.ActionT Text App a) ->
-  Scotty.ActionT Text App a
+  (Text.Lazy.Text -> Scotty.ActionT Text.Lazy.Text App a) ->
+  Scotty.ActionT Text.Lazy.Text App a
 (!:) = Scotty.rescue
 
 -- | Forever write the data from 'Que' to 'Wai.StreamingBody'.
@@ -212,7 +203,7 @@ insertQue ns qp q as = as {ques = newQues}
     newQues = HashMap.insert ns newQbase (ques as)
     newQbase = HashMap.insert qp q <| grab ns <| ques as
 
-extract :: Scotty.ActionT Text App (Namespace, Quepath)
+extract :: Scotty.ActionT Text.Lazy.Text App (Namespace, Quepath)
 extract = do
   ns <- Scotty.param "1"
   path <- Scotty.param "2"
@@ -232,7 +223,7 @@ modify :: (AppState -> AppState) -> App ()
 modify f = ask >>= liftIO . atomically . flip STM.modifyTVar' f
 
 -- | housing for a set of que paths
-type Namespace = Text
+type Namespace = Text.Lazy.Text
 
 -- | a que is just a channel of bytes
 type Que = Go.Channel Message
diff --git a/Que/Website.hs b/Que/Website.hs
index 7eb3ae6..623173b 100644
--- a/Que/Website.hs
+++ b/Que/Website.hs
@@ -38,8 +38,8 @@ main = do
     [src, ns] -> return (src, Text.pack ns)
     _ -> Exit.die "usage: que-website <srcdir> [namespace]"
   mKey <- getKey ns
-  putText $ "serving " <> Text.pack src <> " at " <> ns
-  run mKey ns $
+  putText <| "serving " <> Text.pack src <> " at " <> ns
+  run mKey ns <|
     Sources
       { index = src </> "index.md",
         client = src </> "client.py",
@@ -98,7 +98,7 @@ run key ns Sources {..} = Async.runConcurrently actions |> void
     toHtml :: FilePath -> IO ByteString
     toHtml md =
       BS.pack
-        <$> Process.readProcess
+        </ Process.readProcess
           "pandoc"
           [ "--include-in-header",
             style,
@@ -112,7 +112,7 @@ run key ns Sources {..} = Async.runConcurrently actions |> void
           []
 
 serve :: Maybe Key -> Namespace -> Text -> ByteString -> IO ()
-serve Nothing "pub" path content = runReq defaultHttpConfig $ do
+serve Nothing "pub" path content = runReq defaultHttpConfig <| do
   _ <-
     req
       POST
@@ -120,9 +120,9 @@ serve Nothing "pub" path content = runReq defaultHttpConfig $ do
       (ReqBodyBs content)
       ignoreResponse
       mempty
-  liftIO $ return ()
+  liftIO <| return ()
 serve Nothing p _ _ = panic <| "no auth key provided for ns: " <> p
-serve (Just key) ns path content = runReq defaultHttpConfig $ do
+serve (Just key) ns path content = runReq defaultHttpConfig <| do
   let options =
         header "Authorization" (encodeUtf8 key) <> responseTimeout maxBound
   _ <-
@@ -132,4 +132,4 @@ serve (Just key) ns path content = runReq defaultHttpConfig $ do
       (ReqBodyBs content)
       ignoreResponse
       options
-  liftIO $ return ()
+  liftIO <| return ()