{-# LANGUAGE OverloadedStrings #-}
module Elm2Nix.PackagesSnapshot
( snapshot
) where
import Control.Monad (liftM2, liftM3)
import qualified Data.Aeson as Aeson
import qualified Data.Binary as Binary
import Data.Binary (Binary, put, get, putWord8, getWord8)
import qualified Data.Map as Map
import Data.Default (def)
import Data.Map (Map)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Word (Word16)
import qualified Network.HTTP.Req as Req
import System.FilePath ((</>))
data Name =
Name
{ _author :: !Text
, _project :: !Text
}
deriving (Eq, Ord)
data Package =
Package
{ _name :: !Name
, _version :: !Version
}
deriving (Eq, Ord)
data Version =
Version
{ _major :: {-# UNPACK #-} !Word16
, _minor :: {-# UNPACK #-} !Word16
, _patch :: {-# UNPACK #-} !Word16
}
deriving (Eq, Ord)
data PackageRegistry =
PackageRegistry Int (Map Name [Version])
instance Binary Name where
get =
liftM2 Name get get
put (Name author project) =
do put author
put project
instance Binary Package where
get =
liftM2 Package get get
put (Package name version) =
do put name
put version
instance Binary Version where
get =
do word <- getWord8
if word == 0
then liftM3 Version get get get
else
do minor <- fmap fromIntegral getWord8
patch <- fmap fromIntegral getWord8
return (Version (fromIntegral word) minor patch)
put (Version major minor patch) =
if major < 256 && minor < 256 && patch < 256 then
do putWord8 (fromIntegral major)
putWord8 (fromIntegral minor)
putWord8 (fromIntegral patch)
else
do putWord8 0
put major
put minor
put patch
instance Binary PackageRegistry where
get = liftM2 PackageRegistry get get
put (PackageRegistry a b) = put a >> put b
snapshot :: String -> IO ()
snapshot dir = do
r <- Req.runReq def $
Req.req
Req.POST
(Req.https "package.elm-lang.org" Req./: "all-packages")
Req.NoReqBody
Req.jsonResponse
mempty
let packages = unwrap $ case Aeson.fromJSON (Req.responseBody r) of
Aeson.Error s -> error s
Aeson.Success val -> val
size = Map.foldr ((+) . length) 0 packages
registry = PackageRegistry size packages
Binary.encodeFile (dir </> "versions.dat") registry
newtype Packages = Packages { unwrap :: Map.Map Name [Version] }
instance Aeson.FromJSON Packages where
parseJSON v = Packages <$> Aeson.parseJSON v
instance Aeson.FromJSON Version where
parseJSON = Aeson.withText "string" $ \x ->
case Text.splitOn "." x of
[major, minor, patch] ->
return $ Version
(read (Text.unpack major))
(read (Text.unpack minor))
(read (Text.unpack patch))
_ ->
fail "failure parsing version"
instance Aeson.FromJSON Name where
parseJSON = Aeson.withText "string" $ \x ->
case Text.splitOn "/" x of
[author, package] -> return $ Name author package
lst -> fail $ "wrong package name: " <> show lst
instance Aeson.FromJSONKey Name where
fromJSONKey = Aeson.FromJSONKeyTextParser $ \x ->
case Text.splitOn "/" x of
[author, package] -> return $ Name author package
lst -> fail $ "wrong package name: " <> show lst