Commit fe20d607 authored by locallycompact's avatar locallycompact
Browse files

Apply hlint and hpack

parent dc002adf
No related merge requests found
Pipeline #337 failed with stages
in 1 second
......@@ -66,7 +66,7 @@ npc = squiggles $ do
void $ char '|'
npcName <- mediafield
void $ char '|'
npcRole <- optional . try $ do
npcRole <- optional . try $ do
a <- mediafield
void $ char '|'
return a
......@@ -159,7 +159,7 @@ stripLinks [] = []
-- | Pandoc filter - delete all images.
deleteImages :: [Inline] -> [Inline]
deleteImages ((Image _ _ _ ) : xs) = deleteImages xs
deleteImages ((Image {} ) : xs) = deleteImages xs
deleteImages (x : xs) = x : deleteImages xs
deleteImages [] = []
......@@ -185,14 +185,14 @@ junkSections = [ [Str "External", Space, Str "links"]
]
isHeader :: Block -> Bool
isHeader (Header _ _ _) = True
isHeader (Header {}) = True
isHeader _ = False
splitSections :: [Block] -> [[Block]]
splitSections = split (keepDelimsL $ whenElt isHeader)
isJunkHeader :: Block -> Bool
isJunkHeader (Header _ _ a') = elem a' junkSections
isJunkHeader (Header _ _ a') = a' `elem` junkSections
isJunkHeader _ = False
isJunkSection :: [Block] -> Bool
......@@ -200,14 +200,14 @@ isJunkSection (x : xs) = isJunkHeader x
isJunkSection [] = True
stripJunkSections :: [Block] -> [Block]
stripJunkSections = join . filter (not . isJunkSection) . splitSections
stripJunkSections = join . filter (not . isJunkSection) . splitSections
stripDataBlocks :: [Inline] -> [Inline]
stripDataBlocks t@((Str x) : xs) = if "{{#data:" `T.isPrefixOf` x then [] else t
stripDataBlocks a = a
npcToPandoc :: NPC -> [Inline]
npcToPandoc NPC{..} = [Str npcName, Space] ++ (maybe [] (\k -> [Str "-", Space, Str k]) npcRole)
npcToPandoc NPC{..} = [Str npcName, Space] ++ maybe [] (\k -> [Str "-", Space, Str k]) npcRole
quoteToPandoc :: Quote -> [Inline]
quoteToPandoc Quote{..} = [Str quoteText]
......@@ -216,15 +216,15 @@ abilityToPandoc :: Ability -> [Inline]
abilityToPandoc Ability{..} = [Str $ abilityName <> "-" <> abilityEffect]
convertNPCs :: [Block] -> [Block]
convertNPCs t@(x@(RawBlock b k) : xs) = (maybe x (Plain . npcToPandoc) $ parseMaybe npc k) : xs
convertNPCs t@(x@(RawBlock b k) : xs) = maybe x (Plain . npcToPandoc) (parseMaybe npc k) : xs
convertNPCs a = a
convertQuotes :: [Block] -> [Block]
convertQuotes t@(x@(RawBlock b k) : xs) = (maybe x (Plain . quoteToPandoc) $ parseMaybe quote k) : xs
convertQuotes t@(x@(RawBlock b k) : xs) = maybe x (Plain . quoteToPandoc) (parseMaybe quote k) : xs
convertQuotes a = a
convertAbilities :: [Block] -> [Block]
convertAbilities t@(x@(RawBlock b k) : xs) = (maybe x (Plain . abilityToPandoc) $ parseMaybe ability k) : xs
convertAbilities t@(x@(RawBlock b k) : xs) = maybe x (Plain . abilityToPandoc) (parseMaybe ability k) : xs
convertAbilities a = a
stripRawInline :: [Inline] -> [Inline]
......@@ -260,20 +260,20 @@ apiType1 :: Value -> Text
apiType1 = view (key "query"
. key "pages" . values
. key "revisions" . values
. key "slots"
. key "slots"
. key "main"
. key "content" . _String)
apiType2 :: Value -> Text
apiType2 = view (_String) . fromJust . HM.lookup "*" . view (_Object) . head . toListOf (key "revisions" . values) . head . HM.elems . view (key "query" . key "pages" . _Object)
apiType2 = view _String . fromJust . HM.lookup "*" . view _Object . head . toListOf (key "revisions" . values) . head . HM.elems . view (key "query" . key "pages" . _Object)
switchContent ApiType1 = apiType1
switchContent ApiType2 = apiType2
recCollectP :: (MonadUnliftAction m, Ord a) => (a -> m (Set a)) -> Set a -> a -> m (Set a)
recCollectP g exs x = do
x' <- g x
xs' <- flip forP (recCollectP g (S.union exs x')) (toList $ S.filter (not . (`S.member` exs)) x')
xs' <- forP (toList $ S.filter (not . (`S.member` exs)) x') (recCollectP g (S.union exs x'))
return $ foldr S.union (S.union (S.singleton x) x') xs'
main :: IO ()
......@@ -281,13 +281,13 @@ main = runSimpleShakePlus $ do
jsonLookup <- addRemoteJSONOracleCache
readYaml <- newCache $ \src -> Yaml.decodeThrow =<< BS.readFile (toFilePath $ src)
readYaml <- newCache $ \src -> Yaml.decodeThrow =<< BS.readFile ( toFilePath src)
let pullJson :: Text -> RAction LogFunc Value
pullJson x = do
logInfo $ displayShow $ "Polling " <> x
k <- jsonLookup . RemoteJSONLookup $ x
logDebug $ displayShow $ "Receieved: " <> (T.pack $ show k)
logDebug $ displayShow $ "Receieved: " <> T.pack (show k)
return k
let subcatRequest u a x = pullJson $ "https://" <> u <> "/" <> a <> "?action=query&list=categorymembers&cmtitle=" <> x <> "&cmlimit=500&cmtype=subcat&format=json"
......@@ -298,7 +298,7 @@ main = runSimpleShakePlus $ do
"out/trainingset.txt" %> \out -> do
xs <- getDirectoryFiles $(mkRelDir ".") ["processed/markdown//*.md"]
xs' <- forM xs $ (evaluate <=< readFile')
xs' <- forM xs (evaluate <=< readFile')
let ys = map (T.unlines . (\x -> ["<|startoftext|>"] ++ T.lines x ++ ["<|endoftext|>"])) xs'
writeFile' out $ T.unlines ys
......@@ -311,7 +311,7 @@ main = runSimpleShakePlus $ do
(x, _) <- splitExtension . filename $ out
y <- contentRequest k api (T.pack . toFilePath $ x)
let (y' :: Text) = switchContent apiType y
writeFile' out $ y'
writeFile' out y'
("*/*.md" `within` $(mkRelDir "processed/markdown")) %^> \out -> do
logInfo $ displayShow $ "Processing " <> (toFilePath . fromWithin $ out)
......@@ -324,20 +324,20 @@ main = runSimpleShakePlus $ do
Right x -> do
logDebug $ displayShow x
let x' = walk stripJunkSections . walk (convertAbilities . convertQuotes . convertNPCs) . walk (stripDataBlocks . stripLinks . deleteImages . deleteNotes) $ x
let y = Pandoc mempty [(Header 1 nullAttr [Str (T.pack $ toFilePath $ f)])] <> x'
k <- runPandocA $ writeMarkdown myMDWriterOptions $ y
let y = Pandoc mempty [Header 1 nullAttr [Str (T.pack $ toFilePath $ f)]] <> x'
k <- runPandocA $ writeMarkdown myMDWriterOptions y
logDebug $ displayShow k
writeFile' (fromWithin out) k
("*" `within` $(mkRelDir "manifests/derived/")) %^> \out -> do
let src = blinkLocalDir $(mkRelDir "manifests/original/") out
needP [fromWithin $ src]
needP [ fromWithin src]
(WikiManifest{..}) <- readYaml (fromWithin src)
ys <- forP includeCategories $ recSubcats (T.pack $ toFilePath $ extract out) api
let ys' = foldr S.union S.empty ys
logDebug $ displayShow $ ys'
logDebug $ displayShow ys'
zs <- forP (includeCategories <> toList ys') $ pagesRequest (T.pack $ toFilePath $ extract out) api
let zs' = filter (not . (\x -> any (`T.isInfixOf` x) ["/","&","%","+","+"])) $ join $ viewCmTitles <$> zs
let zs' = filter (not . (\x -> any (`T.isInfixOf` x) ["/","&","%","+","+"])) $ viewCmTitles =<< zs
BS.writeFile (toFilePath . fromWithin $ out) $ Yaml.encode $ WikiManifest {includeCategories = [], includePages = zs', .. }
let wikiManifest x = do
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment