Fix formatting

2022-06-29 21:30:55 +03:00 · 2022-06-29 21:30:55 +03:00 · 33c2b5421d
parent 8b6ee9a76d
commit 33c2b5421d
12 changed files with 303 additions and 201 deletions
--- a/app/Api.hs
+++ b/app/Api.hs
@ -5,8 +5,8 @@ import Relude
 import Polysemy (Members, Sem)
 import Polysemy.Error (Error)
 import Servant.API
-import Servant.Client.Streaming (ClientM, ClientError, client)
-import Servant.Polysemy.Client (runClient, ServantClient)
+import Servant.Client.Streaming (ClientError, ClientM, client)
+import Servant.Polysemy.Client (ServantClient, runClient)

 import Api.Spec
 import Api.Types
--- a/app/Api/Spec.hs
+++ b/app/Api/Spec.hs
@ -4,6 +4,9 @@ import Servant.API

 import Api.Types

-type Api = "api" :> (ReqBody '[FormUrlEncoded] GetSections :> Post '[JSON] [Section]
-                     :<|> ReqBody '[FormUrlEncoded] GetTopics :> Post '[JSON] [TopicInfo]
-                     :<|> ReqBody '[FormUrlEncoded] GetTopic :> Post '[JSON] Topic)
+type Api =
+  "api"
+    :> ( ReqBody '[FormUrlEncoded] GetSections :> Post '[JSON] [Section]
+          :<|> ReqBody '[FormUrlEncoded] GetTopics :> Post '[JSON] [TopicInfo]
+          :<|> ReqBody '[FormUrlEncoded] GetTopic :> Post '[JSON] Topic
+       )
--- a/app/Api/Types.hs
+++ b/app/Api/Types.hs
@ -1,35 +1,37 @@
 {-# LANGUAGE Strict #-}

-module Api.Types ( GetSections(GetSections)
-                 , Section(..)
-                 , GetTopics(GetTopics)
-                 , TopicInfo(..)
-                 , GetTopic(..)
-                 , Topic(..)
-                 , ThreadHead(..)
-                 , ThreadPost(..)
-                 ) where
+module Api.Types (
+  GetSections (GetSections)
+  , Section (..)
+  , GetTopics (GetTopics)
+  , TopicInfo (..)
+  , GetTopic (..)
+  , Topic (..)
+  , ThreadHead (..)
+  , ThreadPost (..)
+) where

 import Relude

-import Data.Aeson (FromJSON(parseJSON), Value(Object), (.:), withObject)
+import Color.Print
+import Color.Utils
+import Data.Aeson (FromJSON (parseJSON), Value (Object), withObject, (.:))
 import Data.HashMap.Strict qualified as M
 import Polysemy.Commonmark.AST (commonmark)
 import Polysemy.Output.IO
 import Polysemy.Sgr
-import Color.Print
 import System.Console.ANSI
-import Web.FormUrlEncoded (Form(Form), ToForm(toForm))
-import Color.Utils
+import Web.FormUrlEncoded (Form (Form), ToForm (toForm))

 data GetSections = GetSections
 instance ToForm GetSections where
  toForm GetSections = Form $ M.fromList [("type", ["sections"]), ("key", ["anon"])]

-data Section = Section { id :: Integer
-                       , thread_group_name, description :: Text
-                       }
-                       deriving stock (Generic, Show)
+data Section = Section
+  { id :: Integer
+  , thread_group_name, description :: Text
+  }
+  deriving stock (Generic, Show)
 instance NFData Section
 instance FromJSON Section

@ -45,10 +47,11 @@ data GetTopics = GetTopics
 instance ToForm GetTopics where
  toForm GetTopics = Form $ M.fromList [("type", ["threads"]), ("key", ["anon"])]

-data TopicInfo = TopicInfo { id, group_id, nbr_ansfers :: Integer
-                           , thrname, date, name, last_activity_date, last_activity_user :: Text
-                           }
-                           deriving stock (Generic, Show)
+data TopicInfo = TopicInfo
+  { id, group_id, nbr_ansfers :: Integer
+  , thrname, date, name, last_activity_date, last_activity_user :: Text
+  }
+  deriving stock (Generic, Show)
 instance NFData TopicInfo
 instance FromJSON TopicInfo

@ -62,17 +65,21 @@ instance PrintColor TopicInfo where
    withSgr [SetColor Foreground Dull White] do
      putTextLnO $ " at " <> last_activity_date <> " #" <> show topic_id

-data GetTopic = GetTopic { topic_id :: Integer }
+data GetTopic = GetTopic {topic_id :: Integer}
 instance ToForm GetTopic where
-  toForm GetTopic {topic_id} = Form $ M.fromList [ ("type", ["topic"])
-                                                 , ("key", ["anon"])
-                                                 , ("id", [show topic_id])
-                                                 ]
+  toForm GetTopic{topic_id} =
+    Form $
+      M.fromList
+        [ ("type", ["topic"])
+        , ("key", ["anon"])
+        , ("id", [show topic_id])
+        ]

-data Topic = Topic { thread :: ThreadHead
-                   , post :: [ThreadPost]
-                   }
-                   deriving stock (Generic, Show)
+data Topic = Topic
+  { thread :: ThreadHead
+  , post :: [ThreadPost]
+  }
+  deriving stock (Generic, Show)
 instance NFData Topic
 instance FromJSON Topic

@ -80,37 +87,44 @@ instance PrintColor Topic where
  printColor Topic{thread, post} =
    sequenceA_ $ intersperse (putTextLnO "") (printColor <$> threadHeadToPost thread : post)

-data ThreadHead = ThreadHead { info :: TopicInfo
-                             , message :: Text
-                             }
-                             deriving stock (Generic, Show)
+data ThreadHead = ThreadHead
+  { info :: TopicInfo
+  , message :: Text
+  }
+  deriving stock (Generic, Show)
 instance NFData ThreadHead
 instance FromJSON ThreadHead where
-  parseJSON = withObject "ThreadHead" \o -> ThreadHead <$> parseJSON (Object o)
-                                                       <*> o .: "message"
+  parseJSON = withObject "ThreadHead" \o ->
+    ThreadHead <$> parseJSON (Object o)
+      <*> o .: "message"

 threadHeadToPost :: ThreadHead -> ThreadPost
-threadHeadToPost ThreadHead{info, message} = ThreadPost { id = info.id
-                                                        , topic_id = info.id
-                                                        , name = info.name
-                                                        , date = info.date
-                                                        , message
-                                                        }
+threadHeadToPost ThreadHead{info, message} =
+  ThreadPost
+    { id = info.id
+    , topic_id = info.id
+    , name = info.name
+    , date = info.date
+    , message
+    }

-data ThreadPost = ThreadPost { id, topic_id :: Integer
-                             , name, date, message :: Text
-                             }
-                             deriving stock (Generic, Show)
+data ThreadPost = ThreadPost
+  { id, topic_id :: Integer
+  , name, date, message :: Text
+  }
+  deriving stock (Generic, Show)
 instance NFData ThreadPost
 instance FromJSON ThreadPost

 instance PrintColor ThreadPost where
  printColor ThreadPost{id = post_id, name, date, message} = do
-    withSgr [ SetPaletteColor Foreground (textColor name)
-            , SetConsoleIntensity BoldIntensity
-            -- , SetSwapForegroundBackground True
-            ] do
-      putTextO $ "@" <> name
+    withSgr
+      [ SetPaletteColor Foreground (textColor name)
+      , SetConsoleIntensity BoldIntensity
+      -- , SetSwapForegroundBackground True
+      ]
+      do
+        putTextO $ "@" <> name
    withSgr [SetColor Foreground Dull White] do
      putTextLnO $ " " <> date <> " #" <> show post_id
    case commonmark "<message>" message of
--- a/app/Cli.hs
+++ b/app/Cli.hs
@ -1,12 +1,13 @@
 {-# LANGUAGE Strict #-}

-module Cli ( Options(..)
-           , Choice(..)
-           , optsParser
-           , choiceParser
-           , optsInfo
-           , getOpts
-           ) where
+module Cli (
+  Options (..)
+  , Choice (..)
+  , optsParser
+  , choiceParser
+  , optsInfo
+  , getOpts
+) where

 import Relude
 import Prelude (foldl1)
@ -24,39 +25,68 @@ data Options = Options
 optsParser :: Parser Options
 optsParser =
  Options <$> switch (long "no-ansi" <> short 'A' <> help "disable ANSI codes")
-          <*> (Just <$> option auto (metavar "COLUMNS_NUMBER"
-                                      <> long "columns"
-                                      <> short 'c'
-                                      <> help "number of columns")
-                <|> pure Nothing)
-          <*> choiceParser
+    <*> ( Just
+            <$> option
+              auto
+              ( metavar "COLUMNS_NUMBER"
+                  <> long "columns"
+                  <> short 'c'
+                  <> help "number of columns"
+              )
+            <|> pure Nothing
+        )
+    <*> choiceParser

-data Choice = GetSections
-            | GetTopics { maxEntries :: Maybe Int }
-            | GetTopic { topic_id :: Integer }
-            deriving stock (Show)
+data Choice
+  = GetSections
+  | GetTopics {maxEntries :: Maybe Int}
+  | GetTopic {topic_id :: Integer}
+  deriving stock (Show)

 choiceParser :: Parser Choice
-choiceParser = foldl1 (<|>)
-  [ subparser
-      (command "ss" (info
-        (pure GetSections
-          <**> helper)
-        (progDesc "Request list of sections")))
-  , subparser
-      (command "ts" (info
-        (GetTopics <$> (Just <$> option auto (metavar "MAX_ENTRIES_NUMBER"
-                                              <> long "max-entries"
-                                              <> short 'm'
-                                              <> help "max number of entries"))
-          <**> helper)
-        (progDesc "Request list of topics")))
-  , subparser
-      (command "t" (info
-        (GetTopic <$> argument auto (metavar "TOPIC_ID")
-          <**> helper)
-        (progDesc "Request a topic")))
-  ]
+choiceParser =
+  foldl1
+    (<|>)
+    [ subparser
+        ( command
+            "ss"
+            ( info
+                ( pure GetSections
+                    <**> helper
+                )
+                (progDesc "Request list of sections")
+            )
+        )
+    , subparser
+        ( command
+            "ts"
+            ( info
+                ( GetTopics
+                    <$> ( Just
+                            <$> option
+                              auto
+                              ( metavar "MAX_ENTRIES_NUMBER"
+                                  <> long "max-entries"
+                                  <> short 'm'
+                                  <> help "max number of entries"
+                              )
+                        )
+                    <**> helper
+                )
+                (progDesc "Request list of topics")
+            )
+        )
+    , subparser
+        ( command
+            "t"
+            ( info
+                ( GetTopic <$> argument auto (metavar "TOPIC_ID")
+                    <**> helper
+                )
+                (progDesc "Request a topic")
+            )
+        )
+    ]

 optsInfo :: ParserInfo Options
 optsInfo = info (optsParser <**> helper) mempty
--- a/app/Color/Print.hs
+++ b/app/Color/Print.hs
@ -1,4 +1,4 @@
-module Color.Print (PrintColor(..)) where
+module Color.Print (PrintColor (..)) where

 import Relude

--- a/app/Color/Utils.hs
+++ b/app/Color/Utils.hs
@ -7,5 +7,6 @@ import Data.ByteString qualified as B

 -- | Returns number < 216
 textColor :: Text -> Word8
-textColor t = let result = B.head . finalize . start $ encodeUtf8 t
-               in result `mod` 216
+textColor t =
+  let result = B.head . finalize . start $ encodeUtf8 t
+   in result `mod` 216
--- a/app/Main.hs
+++ b/app/Main.hs
@ -5,15 +5,15 @@ import Relude hiding (Proxy)
 import Api qualified as Api
 import Api.Types (last_activity_date)
 import Cli
+import Color.Print
 import Network.HTTP.Client
 import Polysemy (Member, Members, Sem)
 import Polysemy.Embed (Embed)
 import Polysemy.Error (Error, errorToIOFinal)
+import Polysemy.Final (Final, embedToFinal, runFinal)
 import Polysemy.Output (Output)
 import Polysemy.Output.IO (putTextLnO, runOutputToStdout)
 import Polysemy.Sgr (Sgr, SgrRegion, ignoreSgrFull, runSgrFull, withSgr)
-import Polysemy.Final (Final, embedToFinal, runFinal)
-import Color.Print
 import Servant.Client
 import Servant.Polysemy.Client (ServantClient, runServantClientWith)
 import System.Console.ANSI
@ -21,12 +21,17 @@ import System.Console.ANSI
 defProxy :: Proxy
 defProxy = Proxy "127.0.0.1" 4444

-runProgram :: ClientEnv
-           -> Sem [ Output Text
-                  , ServantClient, Error ClientError
-                  , Embed IO, Final IO
-                  ] ()
-           -> IO ()
+runProgram ::
+  ClientEnv ->
+  Sem
+    [ Output Text
+    , ServantClient
+    , Error ClientError
+    , Embed IO
+    , Final IO
+    ]
+    () ->
+  IO ()
 runProgram clientEnv =
  (>>= either (error . fromString . displayException) pure)
    . runFinal
@ -35,12 +40,17 @@ runProgram clientEnv =
    . runServantClientWith clientEnv
    . runOutputToStdout

-sgrFullInterpreter :: Member (Output Text) r
-                   => Bool -> Sem (SgrRegion : Sgr : r) a -> Sem r a
+sgrFullInterpreter ::
+  Member (Output Text) r =>
+  Bool ->
+  Sem (SgrRegion : Sgr : r) a ->
+  Sem r a
 sgrFullInterpreter noAnsi = if noAnsi then ignoreSgrFull else runSgrFull

-program :: Members [Error ClientError, ServantClient, Output Text, Sgr, SgrRegion] r
-        => Choice -> Sem r ()
+program ::
+  Members [Error ClientError, ServantClient, Output Text, Sgr, SgrRegion] r =>
+  Choice ->
+  Sem r ()
 program GetSections = do
  sections <- Api.getSections
  withSgr [SetColor Foreground Vivid White] do
@ -48,8 +58,10 @@ program GetSections = do
 program GetTopics{maxEntries} = do
  topics <- Api.getTopics
  withSgr [SetColor Foreground Vivid White] do
-    sequenceA_ $ intersperse (putTextLnO "")
-                 (fmap printColor . maybe id take maxEntries . reverse $ sortBy (comparing (.last_activity_date)) topics)
+    sequenceA_ $
+      intersperse
+        (putTextLnO "")
+        (fmap printColor . maybe id take maxEntries . reverse $ sortBy (comparing (.last_activity_date)) topics)
 program GetTopic{topic_id} = do
  topic <- Api.getTopic topic_id
  withSgr [SetColor Foreground Vivid White] do
@ -58,9 +70,10 @@ program GetTopic{topic_id} = do
 main :: IO ()
 main = do
  Options{noAnsi, choice} <- getOpts
-  manager' <- newManager $
-                defaultManagerSettings
-                  & (managerSetProxy $ proxyEnvironmentNamed "I2P_HTTP_PROXY" $ Just defProxy)
+  manager' <-
+    newManager $
+      defaultManagerSettings
+        & (managerSetProxy $ proxyEnvironmentNamed "I2P_HTTP_PROXY" $ Just defProxy)
  let clientEnv = mkClientEnv manager' (BaseUrl Http "4rum.i2p" 80 "")

  runProgram clientEnv . sgrFullInterpreter noAnsi $ program choice
--- a/app/Polysemy/Commonmark/AST.hs
+++ b/app/Polysemy/Commonmark/AST.hs
@ -4,54 +4,62 @@ module Polysemy.Commonmark.AST (Inline, Block, commonmark) where

 import Relude

+import Color.Print
+import Color.Utils
 import Commonmark (commonmarkWith)
 import Commonmark.Extensions.Strikethrough
 import Commonmark.Parser (ParseError)
 import Commonmark.Syntax (defaultSyntaxSpec)
 import Commonmark.Types
 import Data.Char qualified as C
-import Data.Sequence ( Seq ((:<|), Empty)
-                     , ViewL ((:<)), ViewR ((:>))
-                     , viewl, viewr
-                     )
+import Data.Sequence (
+  Seq (Empty, (:<|))
+  , ViewL ((:<))
+  , ViewR ((:>))
+  , viewl
+  , viewr
+ )
 import Data.Text qualified as T
-import Polysemy.Output.IO (putTextO, putTextLnO)
+import Polysemy.Output.IO (putTextLnO, putTextO)
 import Polysemy.Sgr (withSgr)
-import Color.Print
 import System.Console.ANSI qualified as ANSI
-import Color.Utils

 commonmark :: String -> Text -> Either ParseError Block
 commonmark filename source =
-  runIdentity $ commonmarkWith @Identity @Inline @Block (defaultSyntaxSpec <> strikethroughSpec)
-                                                        filename
-                                                        source
+  runIdentity $
+    commonmarkWith @Identity @Inline @Block
+      (defaultSyntaxSpec <> strikethroughSpec)
+      filename
+      source

 -- TODO: add spoilers
-data InlinePiece = Str Text
-                 | Emph Inline
-                 | Strong Inline
-                 | Underline Inline
-                 | Strikethrough Inline
-                 | Autolink { dest :: Text }
-                 | Link { dest :: Text
-                        , descr :: Inline
-                        }
-                 | Code Text
-                 deriving stock (Show)
+data InlinePiece
+  = Str Text
+  | Emph Inline
+  | Strong Inline
+  | Underline Inline
+  | Strikethrough Inline
+  | Autolink {dest :: Text}
+  | Link
+      { dest :: Text
+      , descr :: Inline
+      }
+  | Code Text
+  deriving stock (Show)

 newtype Inline = Inline (Seq InlinePiece)
-               deriving newtype (IsList, Show)
+  deriving newtype (IsList, Show)

 mapText :: (Text -> Text) -> Inline -> Inline
-mapText f (Inline pieces) = Inline (mapText' <$> pieces) where
+mapText f (Inline pieces) = Inline (mapText' <$> pieces)
+ where
  mapText' (Str t) = Str (f t)
  mapText' (Emph i) = Emph (mapText f i)
  mapText' (Strong i) = Strong (mapText f i)
  mapText' (Underline i) = Underline (mapText f i)
  mapText' (Strikethrough i) = Strikethrough (mapText f i)
-  mapText' (Autolink t) = Link {dest = t, descr = str (f t)}
-  mapText' Link{dest, descr} = Link { dest, descr = mapText f descr }
+  mapText' (Autolink t) = Link{dest = t, descr = str (f t)}
+  mapText' Link{dest, descr} = Link{dest, descr = mapText f descr}
  mapText' (Code t) = Code t

 instance Semigroup Inline where
@ -81,27 +89,31 @@ instance IsInline Inline where
  escapedChar c = str $ "\\" <> one c
  emph = Inline . one . Emph
  strong = Inline . one . Strong
-  link dest _title (Inline (Str descr :<| Empty)) | dest == descr = Inline $ one Autolink {dest}
+  link dest _title (Inline (Str descr :<| Empty)) | dest == descr = Inline $ one Autolink{dest}
  link dest _title descr =
-    descr <> fromList [ Str " ("
-                      , Underline (str dest)
-                      , Str ")"]
+    descr
+      <> fromList
+        [ Str " ("
+        , Underline (str dest)
+        , Str ")"
+        ]
  image = link
  code c = Inline . one $ Code $ "`" <> c <> "`"
  rawInline _ = code

-data BlockPiece = Paragraph Inline
-                | Plain Inline
-                | ThematicBreak
-                | BlockQuote Block
-                | CodeBlock Text Text
-                | Heading Int Inline
-                | ReferenceLinkDefinition { label, dest, title :: Text }
-                | List ListType ListSpacing [Block]
-                deriving stock (Show)
+data BlockPiece
+  = Paragraph Inline
+  | Plain Inline
+  | ThematicBreak
+  | BlockQuote Block
+  | CodeBlock Text Text
+  | Heading Int Inline
+  | ReferenceLinkDefinition {label, dest, title :: Text}
+  | List ListType ListSpacing [Block]
+  deriving stock (Show)

 newtype Block = Block [BlockPiece]
-              deriving newtype (Show, Semigroup, Monoid)
+  deriving newtype (Show, Semigroup, Monoid)

 instance Rangeable Block where
  ranged = const id
@ -123,7 +135,8 @@ instance IsBlock Inline Block where
 instance PrintColor Inline where
  -- TODO: needs to be aware of prefix and line length
  -- and perform line wrapping
-  printColor (Inline pieces) = for_ pieces printPiece where
+  printColor (Inline pieces) = for_ pieces printPiece
+   where
    printPiece (Str t) = case t of
      "" -> pass
      "@" -> putTextO t
@ -134,22 +147,24 @@ instance PrintColor Inline where
         in if not (T.null withUsername) && isNotPartOfWord
              then do
                putTextO beforeUsername
-                withSgr [ ANSI.SetPaletteColor ANSI.Foreground (textColor username)
-                        -- , ANSI.SetSwapForegroundBackground True
-                        , ANSI.SetConsoleIntensity ANSI.BoldIntensity
-                        ] do
-                  putTextO $ "@" <> username
+                withSgr
+                  [ ANSI.SetPaletteColor ANSI.Foreground (textColor username)
+                  , -- , ANSI.SetSwapForegroundBackground True
+                    ANSI.SetConsoleIntensity ANSI.BoldIntensity
+                  ]
+                  do
+                    putTextO $ "@" <> username
                printPiece (Str rest)
              else putTextO t
-      where
-        isUsernameSym c = C.isAlphaNum c || elem c ['_', '-']
+     where
+      isUsernameSym c = C.isAlphaNum c || elem c ['_', '-']
    printPiece (Emph i) = withSgr [ANSI.SetItalicized True] $ printColor i
    printPiece (Strong i) = withSgr [ANSI.SetConsoleIntensity ANSI.BoldIntensity] $ printColor i
    printPiece (Underline i) = withSgr [ANSI.SetUnderlining ANSI.SingleUnderline] $ printColor i
    printPiece (Strikethrough i) = printColor (mapText mkStrikethrough i)
-      where
-        mkStrikethrough :: (IsString s, ToString s) => s -> s
-        mkStrikethrough s = fromString do { c <- toString s; [c, chr 822] }
+     where
+      mkStrikethrough :: (IsString s, ToString s) => s -> s
+      mkStrikethrough s = fromString do c <- toString s; [c, chr 822]
    printPiece Autolink{dest} = do
      withSgr [ANSI.SetUnderlining ANSI.SingleUnderline] do
        putTextO dest
@ -158,16 +173,19 @@ instance PrintColor Inline where
      withSgr [ANSI.SetUnderlining ANSI.SingleUnderline] do
        putTextO $ " (" <> dest <> ")"
    printPiece (Code t) =
-      withSgr [ ANSI.SetColor ANSI.Background ANSI.Vivid ANSI.Black
-              , ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.White
-              ] do
-        putTextO t
+      withSgr
+        [ ANSI.SetColor ANSI.Background ANSI.Vivid ANSI.Black
+        , ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.White
+        ]
+        do
+          putTextO t

 instance HasStrikethrough Inline where
  strikethrough = Inline . one . Strikethrough

 instance PrintColor Block where
-  printColor = printBlockP "" where
+  printColor = printBlockP ""
+   where
    printBlockP prefix (Block b) = for_ b (printBlockOne prefix)

    printBlockOne prefix (Paragraph i) = do
@ -207,14 +225,14 @@ instance PrintColor Block where
    listPrefixes :: ListType -> [Text]
    listPrefixes (BulletList c) = repeat (fromString [c, ' '])
    listPrefixes (OrderedList start enumType delimType) =
-      [start..] <&> \i -> enumFor i <> delim <> " "
-      where
-        infAlph xs = xs ++ ((<>) <$> infAlph xs <*> xs)
-        enumFor i = case enumType of
-          UpperAlpha -> infAlph (fromString . one <$> ['A'..'Z']) !!? i & fromMaybe (error "Impossible")
-          LowerAlpha -> infAlph (fromString . one <$> ['a'..'z']) !!? i & fromMaybe (error "Impossible")
-          _ -> show i
-        delim = case delimType of
-          Period -> "."
-          OneParen -> ")"
-          TwoParens -> "))"
+      [start ..] <&> \i -> enumFor i <> delim <> " "
+     where
+      infAlph xs = xs ++ ((<>) <$> infAlph xs <*> xs)
+      enumFor i = case enumType of
+        UpperAlpha -> infAlph (fromString . one <$> ['A' .. 'Z']) !!? i & fromMaybe (error "Impossible")
+        LowerAlpha -> infAlph (fromString . one <$> ['a' .. 'z']) !!? i & fromMaybe (error "Impossible")
+        _ -> show i
+      delim = case delimType of
+        Period -> "."
+        OneParen -> ")"
+        TwoParens -> "))"
--- a/app/Polysemy/Output/IO.hs
+++ b/app/Polysemy/Output/IO.hs
@ -1,14 +1,17 @@
-module Polysemy.Output.IO ( runOutputToIO
-                          , runOutputToStdout, runOutputToStderr
-                          , putTextO, putTextLnO
-                          ) where
+module Polysemy.Output.IO (
+  runOutputToIO
+  , runOutputToStdout
+  , runOutputToStderr
+  , putTextO
+  , putTextLnO
+) where

 import Relude

 import Data.Text (unpack)
 import Polysemy (Member, Sem, interpret)
 import Polysemy.Embed (Embed, embed)
-import Polysemy.Output (Output(Output), output)
+import Polysemy.Output (Output (Output), output)
 import System.IO (hPutStr)

 runOutputToIO :: Member (Embed IO) r => Handle -> Sem (Output Text ': r) () -> Sem r ()
--- a/app/Polysemy/Sgr.hs
+++ b/app/Polysemy/Sgr.hs
@ -1,10 +1,16 @@
 {-# LANGUAGE TemplateHaskell #-}

-module Polysemy.Sgr ( Sgr, sgr
-                    , runSgrToOutput, ignoreSgr
-                    , SgrRegion, withSgr
-                    , SgrFull, runSgrFull, ignoreSgrFull
-                    ) where
+module Polysemy.Sgr (
+  Sgr
+  , sgr
+  , runSgrToOutput
+  , ignoreSgr
+  , SgrRegion
+  , withSgr
+  , SgrFull
+  , runSgrFull
+  , ignoreSgrFull
+) where

 import Relude hiding (Reader, ask, asks, local, runReader)

@ -19,9 +25,10 @@ data Sgr :: Effect where

 $(makeSem ''Sgr)

-runSgrToOutput :: Member (Output Text) r
-               => Sem (Sgr : r) a
-               -> Sem r a
+runSgrToOutput ::
+  Member (Output Text) r =>
+  Sem (Sgr : r) a ->
+  Sem r a
 runSgrToOutput = interpret \(Sgr cs) -> output $ pack $ ANSI.setSGRCode cs

 ignoreSgr :: Sem (Sgr : r) a -> Sem r a
@ -30,10 +37,11 @@ ignoreSgr = interpret \(Sgr _) -> pass
 type SgrRegion :: Effect
 type SgrRegion = Reader [ANSI.SGR]

-withSgr :: Members [SgrRegion, Sgr] r
-        => [ANSI.SGR]
-        -> Sem r a
-        -> Sem r a
+withSgr ::
+  Members [SgrRegion, Sgr] r =>
+  [ANSI.SGR] ->
+  Sem r a ->
+  Sem r a
 withSgr es act = do
  asks (++ es) >>= sgr
  result <- local (++ es) act
@ -46,8 +54,10 @@ runSgrRegion = runReader [ANSI.Reset]
 type SgrFull :: [Effect]
 type SgrFull = [SgrRegion, Sgr]

-runSgrFull :: Member (Output Text) r
-           => Sem (SgrRegion : Sgr : r) a -> Sem r a
+runSgrFull ::
+  Member (Output Text) r =>
+  Sem (SgrRegion : Sgr : r) a ->
+  Sem r a
 runSgrFull = runSgrToOutput . runSgrRegion

 ignoreSgrFull :: Sem (SgrRegion : Sgr : r) a -> Sem r a
--- a/flake.nix
+++ b/flake.nix
@ -124,7 +124,7 @@
              thisNative.env.overrideAttrs (a: {
                nativeBuildInputs = a.nativeBuildInputs ++ [ thisNative.passthru.pkgs.fourmolu ];
              });
-            ghci =  default.overrideAttrs (_: {
+            ghci = default.overrideAttrs (_: {
              shellHook = ''
                ghci ${unwords (options ++ extensions)} ${findFiles}
                exit $?
--- a/nix/dependencies.nix
+++ b/nix/dependencies.nix
@ -160,8 +160,18 @@ with builtins; mapAttrs (_: v:
  }) {};
  compact = final.callPackage
    ({ haskell }: haskell.lib.doJailbreak
-      (prev.compact.overrideAttrs (_: { doCheck = false; doHaddock = false; doBenchmark = false; }))) {};
+      (prev.compact.overrideAttrs (_: {
+        doCheck = false;
+        doBenchmark = false;
+        doHoogle = false;
+        doHaddock = false;
+      }))) {};
  type-errors = final.callPackage
    ({ haskell }: haskell.lib.doJailbreak
-      (prev.type-errors.overrideAttrs (_: { doCheck = false; doHaddock = false; doBenchmark = false; }))) {};
+      (prev.type-errors.overrideAttrs (_: {
+        doCheck = false;
+        doBenchmark = false;
+        doHoogle = false;
+        doHaddock = false;
+      }))) {};
 }