Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
haskell
shake-gpt2-experiments
Commits
fe20d607
Commit
fe20d607
authored
3 years ago
by
locallycompact
Browse files
Options
Download
Email Patches
Plain Diff
Apply hlint and hpack
parent
dc002adf
master
No related merge requests found
Pipeline
#337
failed with stages
in 1 second
Changes
1
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
22 additions
and
22 deletions
+22
-22
Shakefile.hs
Shakefile.hs
+22
-22
No files found.
Shakefile.hs
View file @
fe20d607
...
...
@@ -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
...
...
This diff is collapsed.
Click to expand it.
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment
Menu
Projects
Groups
Snippets
Help