Use fourmolu instead of stylish-haskell
This commit is contained in:
+31
-23
@@ -14,7 +14,7 @@ module Yore.DB
|
||||
, getNumberOfIssues
|
||||
, Table (..)
|
||||
, getTables
|
||||
) where
|
||||
) where
|
||||
|
||||
import Data.Functor.Identity (Identity (..))
|
||||
import Data.Text (Text)
|
||||
@@ -25,38 +25,44 @@ import qualified Database.PostgreSQL.Opium as Opium
|
||||
|
||||
data Table = Table
|
||||
{ schema :: String
|
||||
, name :: String
|
||||
} deriving (Show, Generic, Opium.FromRow)
|
||||
, name :: String
|
||||
}
|
||||
deriving (Show, Generic, Opium.FromRow)
|
||||
|
||||
getTables :: Opium.Connection -> IO (Either Opium.Error [Table])
|
||||
getTables = Opium.fetch_ "SELECT table_schema AS schema, table_name AS name FROM information_schema.tables"
|
||||
|
||||
data DayIndex = DayIndex
|
||||
{ day_index_id :: Int
|
||||
, day :: Day
|
||||
} deriving (Show, Generic, Opium.FromRow)
|
||||
, day :: Day
|
||||
}
|
||||
deriving (Show, Generic, Opium.FromRow)
|
||||
|
||||
data DayFile = DayFile
|
||||
{ day_file_id :: Int
|
||||
, day_index_id :: Int
|
||||
, label :: Text
|
||||
{ day_file_id :: Int
|
||||
, day_index_id :: Int
|
||||
, label :: Text
|
||||
, relative_path :: FilePath
|
||||
} deriving (Show, Generic, Opium.FromRow)
|
||||
}
|
||||
deriving (Show, Generic, Opium.FromRow)
|
||||
|
||||
newtype CountResult = CountResult
|
||||
{ count :: Int
|
||||
} deriving (Show, Generic, Opium.FromRow)
|
||||
}
|
||||
deriving (Show, Generic, Opium.FromRow)
|
||||
|
||||
createDayIndex :: Day -> Opium.Connection -> IO (Either Opium.Error DayIndex)
|
||||
createDayIndex date = ex runIdentity .
|
||||
Opium.fetch
|
||||
"INSERT INTO yore.day_index (day) VALUES ($1) RETURNING *"
|
||||
(Identity date)
|
||||
createDayIndex date =
|
||||
ex runIdentity
|
||||
. Opium.fetch
|
||||
"INSERT INTO yore.day_index (day) VALUES ($1) RETURNING *"
|
||||
(Identity date)
|
||||
|
||||
createDayFile :: Int -> Text -> FilePath -> Opium.Connection -> IO (Either Opium.Error ())
|
||||
createDayFile dayId label path =
|
||||
Opium.execute
|
||||
"INSERT INTO yore.day_file (day_index_id, label, relative_path) VALUES ($1, $2, $3)" (dayId, label, path)
|
||||
"INSERT INTO yore.day_file (day_index_id, label, relative_path) VALUES ($1, $2, $3)"
|
||||
(dayId, label, path)
|
||||
|
||||
readDayIndex :: Day -> Opium.Connection -> IO (Either Opium.Error (Maybe DayIndex))
|
||||
readDayIndex date =
|
||||
@@ -71,16 +77,18 @@ readDayPaths date =
|
||||
(Identity date)
|
||||
|
||||
getDayFileByIssue :: Day -> Int -> Opium.Connection -> IO (Either Opium.Error DayFile)
|
||||
getDayFileByIssue date issue = ex runIdentity .
|
||||
Opium.fetch
|
||||
"SELECT yore.day_file.* FROM yore.day_index LEFT JOIN yore.day_file USING (day_index_id) WHERE day = $1 ORDER BY day_file_id LIMIT 1 OFFSET $2"
|
||||
(date, issue)
|
||||
getDayFileByIssue date issue =
|
||||
ex runIdentity
|
||||
. Opium.fetch
|
||||
"SELECT yore.day_file.* FROM yore.day_index LEFT JOIN yore.day_file USING (day_index_id) WHERE day = $1 ORDER BY day_file_id LIMIT 1 OFFSET $2"
|
||||
(date, issue)
|
||||
|
||||
getNumberOfIssues :: Day -> Opium.Connection -> IO (Either Opium.Error Int)
|
||||
getNumberOfIssues date = ex (count . runIdentity) .
|
||||
Opium.fetch
|
||||
"SELECT count(*) FROM yore.day_index LEFT JOIN yore.day_file USING (day_index_id) WHERE day = $1"
|
||||
(Identity date)
|
||||
getNumberOfIssues date =
|
||||
ex (count . runIdentity)
|
||||
. Opium.fetch
|
||||
"SELECT count(*) FROM yore.day_index LEFT JOIN yore.day_file USING (day_index_id) WHERE day = $1"
|
||||
(Identity date)
|
||||
|
||||
ex :: (a -> b) -> IO (Either e a) -> IO (Either e b)
|
||||
ex = fmap . fmap
|
||||
|
||||
@@ -17,8 +17,10 @@ import qualified Text.URI as URI
|
||||
-- | Download a URL and save it to a directory.
|
||||
-- Returns the path of the downloaded file relative to the directory.
|
||||
downloadInto
|
||||
:: FilePath -- ^ Directory where to store the file.
|
||||
-> Text -- ^ The URL to download.
|
||||
:: FilePath
|
||||
-- ^ Directory where to store the file.
|
||||
-> Text
|
||||
-- ^ The URL to download.
|
||||
-> IO FilePath
|
||||
downloadInto downloadDir textUrl = download >>= save
|
||||
where
|
||||
|
||||
+1
-1
@@ -20,5 +20,5 @@ createEntries date urls conn = do
|
||||
confidently $ DB.createDayFile dayIndex.day_index_id text url conn
|
||||
confidently $ Opium.execute_ "COMMIT" conn
|
||||
|
||||
confidently :: Exception e => IO (Either e a) -> IO a
|
||||
confidently :: (Exception e) => IO (Either e a) -> IO a
|
||||
confidently action = action >>= either throwIO pure
|
||||
|
||||
+57
-50
@@ -15,20 +15,20 @@ import Data.Maybe (listToMaybe, mapMaybe)
|
||||
import Data.Text (Text)
|
||||
import Data.Time (Day, MonthOfYear, Year, fromGregorian, toGregorian)
|
||||
import Network.HTTP.Req
|
||||
( BsResponse
|
||||
, GET (..)
|
||||
, NoReqBody (..)
|
||||
, Req
|
||||
, bsResponse
|
||||
, defaultHttpConfig
|
||||
, formToQuery
|
||||
, https
|
||||
, req
|
||||
, responseBody
|
||||
, responseStatusCode
|
||||
, runReq
|
||||
, (/:)
|
||||
)
|
||||
( BsResponse
|
||||
, GET (..)
|
||||
, NoReqBody (..)
|
||||
, Req
|
||||
, bsResponse
|
||||
, defaultHttpConfig
|
||||
, formToQuery
|
||||
, https
|
||||
, req
|
||||
, responseBody
|
||||
, responseStatusCode
|
||||
, runReq
|
||||
, (/:)
|
||||
)
|
||||
import Text.HTML.Parser (Attr (..), Token (..), parseTokens)
|
||||
import Text.Printf (printf)
|
||||
import Text.URI (URI)
|
||||
@@ -41,18 +41,20 @@ import qualified Text.URI as URI
|
||||
|
||||
-- | A single issue of a newspaper. There may be multiple isses per day.
|
||||
data Issue = Issue
|
||||
{ day :: Day
|
||||
{ day :: Day
|
||||
, label :: Text
|
||||
-- ^ A human-readable label for the issue, e.g. @1. Blatt@, @Sportblatt@ or @Handelsblatt@.
|
||||
, url :: Text
|
||||
, url :: Text
|
||||
-- ^ Where to fetch the PDF file for this issue.
|
||||
} deriving (Eq, Show)
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
data Target = Target
|
||||
{ day :: Day
|
||||
, label :: Text
|
||||
{ day :: Day
|
||||
, label :: Text
|
||||
, params :: Params
|
||||
} deriving (Eq, Show)
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
type Params = (Text, Text, Text)
|
||||
|
||||
@@ -80,37 +82,42 @@ getIssueByTarget target = do
|
||||
let mbRefreshTarget = listToMaybe $ mapMaybe getRefreshTarget htmlTokens
|
||||
refreshTarget <-
|
||||
maybe (error "couldnt find refresh target") pure mbRefreshTarget
|
||||
pure $ Issue
|
||||
{ day = target.day
|
||||
, label = target.label
|
||||
, url = refreshTarget
|
||||
}
|
||||
pure $
|
||||
Issue
|
||||
{ day = target.day
|
||||
, label = target.label
|
||||
, url = refreshTarget
|
||||
}
|
||||
|
||||
showmonthRequest :: Year -> MonthOfYear -> Req BsResponse
|
||||
showmonthRequest year month = req
|
||||
GET
|
||||
(https "fz.ub.uni-freiburg.de" /: "show" /: "fz.cgi")
|
||||
NoReqBody
|
||||
bsResponse
|
||||
(formToQuery
|
||||
[ ("cmd", "showmonth") :: (String, String)
|
||||
, ("year", printf "%04d" year)
|
||||
, ("month", printf "%02d" month)
|
||||
, ("project", "3")
|
||||
])
|
||||
showmonthRequest year month =
|
||||
req
|
||||
GET
|
||||
(https "fz.ub.uni-freiburg.de" /: "show" /: "fz.cgi")
|
||||
NoReqBody
|
||||
bsResponse
|
||||
( formToQuery
|
||||
[ ("cmd", "showmonth") :: (String, String)
|
||||
, ("year", printf "%04d" year)
|
||||
, ("month", printf "%02d" month)
|
||||
, ("project", "3")
|
||||
]
|
||||
)
|
||||
|
||||
showpdfRequest :: Params -> Req BsResponse
|
||||
showpdfRequest (y, m, d) = req
|
||||
GET
|
||||
(https "fz.ub.uni-freiburg.de" /: "show" /: "fz.cgi")
|
||||
NoReqBody
|
||||
bsResponse
|
||||
(formToQuery
|
||||
[ ("cmd" :: Text, "showpdf")
|
||||
, ("year", y)
|
||||
, ("month", m)
|
||||
, ("day", d)
|
||||
])
|
||||
showpdfRequest (y, m, d) =
|
||||
req
|
||||
GET
|
||||
(https "fz.ub.uni-freiburg.de" /: "show" /: "fz.cgi")
|
||||
NoReqBody
|
||||
bsResponse
|
||||
( formToQuery
|
||||
[ ("cmd" :: Text, "showpdf")
|
||||
, ("year", y)
|
||||
, ("month", m)
|
||||
, ("day", d)
|
||||
]
|
||||
)
|
||||
|
||||
parseTargets :: [Token] -> [Target]
|
||||
parseTargets = q0 []
|
||||
@@ -147,7 +154,7 @@ getShowday t = do
|
||||
|
||||
getAHref :: Token -> Maybe Text
|
||||
getAHref (TagOpen "a" attrs) = getAttr "href" attrs
|
||||
getAHref _ = Nothing
|
||||
getAHref _ = Nothing
|
||||
|
||||
getRefreshTarget :: Token -> Maybe Text
|
||||
getRefreshTarget (TagOpen "meta" attrs) = do
|
||||
@@ -180,9 +187,9 @@ getParam param uri =
|
||||
decodeDecimalEntities :: Text -> Text
|
||||
decodeDecimalEntities = Text.pack . q0 . Text.unpack
|
||||
where
|
||||
q0 "" = ""
|
||||
q0 "" = ""
|
||||
q0 ('&' : '#' : r) = q1 0 r
|
||||
q0 (c : r) = c : q0 r
|
||||
q0 (c : r) = c : q0 r
|
||||
|
||||
-- Silently swallows broken entities at the end of the string...
|
||||
q1 _ "" = ""
|
||||
|
||||
+12
-13
@@ -1,24 +1,23 @@
|
||||
module Yore.Time (addYears, getCurrentDay, getSecondsUntilMidnight) where
|
||||
|
||||
import Data.Time
|
||||
( Day
|
||||
, addGregorianYearsClip
|
||||
, getZonedTime
|
||||
, isLeapYear
|
||||
, localDay
|
||||
, localTimeOfDay
|
||||
, sinceMidnight
|
||||
, toGregorian
|
||||
, zonedTimeToLocalTime
|
||||
)
|
||||
( Day
|
||||
, addGregorianYearsClip
|
||||
, getZonedTime
|
||||
, isLeapYear
|
||||
, localDay
|
||||
, localTimeOfDay
|
||||
, sinceMidnight
|
||||
, toGregorian
|
||||
, zonedTimeToLocalTime
|
||||
)
|
||||
|
||||
addYears :: Integer -> Day -> Maybe Day
|
||||
addYears yearOffset date
|
||||
| isFebruary29th && not (isLeapYear year') =
|
||||
Nothing
|
||||
Nothing
|
||||
| otherwise =
|
||||
Just $ addGregorianYearsClip yearOffset date
|
||||
|
||||
Just $ addGregorianYearsClip yearOffset date
|
||||
where
|
||||
(year, month, day) = toGregorian date
|
||||
year' = year + yearOffset
|
||||
|
||||
Reference in New Issue
Block a user