├── Generate.hs
└── README.md


/Generate.hs:
--------------------------------------------------------------------------------
  1 | #!/usr/bin/env stack
  2 | {- stack --resolver lts-10.7 --install-ghc runghc
  3 |     --package base
  4 |     --package bytestring
  5 |     --package lens
  6 |     --package megaparsec
  7 |     --package prettyprinter
  8 |     --package text
  9 |     --package wreq
 10 |     --
 11 |     -hide-all-packages
 12 | -}
 13 | 
 14 | {-# LANGUAGE DeriveGeneric     #-}
 15 | {-# LANGUAGE OverloadedStrings #-}
 16 | {-# OPTIONS_GHC -Wall #-}
 17 | 
 18 | module Main (main) where
 19 | 
 20 | 
 21 | 
 22 | import           Control.Applicative
 23 | import           Control.Lens
 24 | import qualified Data.ByteString.Lazy                  as BSL
 25 | import           Data.Semigroup
 26 | import           Data.Text                             (Text)
 27 | import qualified Data.Text                             as T
 28 | import qualified Data.Text.Encoding                    as T
 29 | import qualified Data.Text.IO                          as T
 30 | import           Data.Text.Prettyprint.Doc
 31 | import           Data.Text.Prettyprint.Doc.Render.Text
 32 | import           Data.Void
 33 | import           Network.Wreq
 34 | import           System.Environment
 35 | import           System.Exit
 36 | import           System.IO
 37 | import           Text.Megaparsec                       as P
 38 | import           Text.Megaparsec.Char                  as P
 39 | import           Text.Read                             (readMaybe)
 40 | 
 41 | 
 42 | 
 43 | data LtsVersion = LtsVersion Int Int deriving (Eq, Ord, Show)
 44 | ltsTextVersion :: LtsVersion -> Text
 45 | ltsTextVersion (LtsVersion major minor) = T.pack (show major) <> "." <> T.pack (show minor)
 46 | 
 47 | newtype Name = Name Text deriving (Eq, Ord, Show)
 48 | data Version = Version Text | NoVersion deriving (Eq, Ord, Show)
 49 | 
 50 | main :: IO ()
 51 | main = do
 52 |     args <- getArgs
 53 |     case args of
 54 |         ltsFlag : ltsVersion : _ | ltsFlag == "--lts"
 55 |             -> case parseLtsVersion (T.pack ltsVersion) of
 56 |                 Left err -> do
 57 |                     T.hPutStrLn stderr "Invalid version specified"
 58 |                     T.hPutStrLn stderr err
 59 |                     exitWith (ExitFailure 1)
 60 |                 Right v -> generateScript v
 61 |         _other -> do
 62 |             T.hPutStrLn stderr "Usage: ./Generate.hs --lts <version>"
 63 |             T.hPutStrLn stderr "Version: e.g. 10.5 for LTS-10.5"
 64 |             exitWith (ExitFailure 1)
 65 | 
 66 | parseLtsVersion :: Text -> Either Text LtsVersion
 67 | parseLtsVersion input = case parse version "<LTS version>" input of
 68 |     Left err -> Left (T.pack (parseErrorPretty err))
 69 |     Right r  -> Right r
 70 |   where
 71 |     version :: Parsec Void Text LtsVersion
 72 |     version = do
 73 |         (major', minor') <- (,) <$> some digitChar <* char '.' <*> some digitChar <* eof
 74 |         case liftA2 (,) (readMaybe major') (readMaybe minor') of
 75 |             Nothing -> fail (T.unpack ("Error: " <> input <> " is not a valid LTS version number. Format: 12.3"))
 76 |             Just (major, minor) -> pure (LtsVersion major minor)
 77 | 
 78 | downloadCabalConstraints :: LtsVersion -> IO Text
 79 | downloadCabalConstraints ltsVersion = do
 80 |     response <- get ("https://www.stackage.org/lts-" ++ T.unpack (ltsTextVersion ltsVersion) ++ "/cabal.config")
 81 |     pure (T.decodeUtf8 (BSL.toStrict (view responseBody response)))
 82 | 
 83 | generateScript :: LtsVersion -> IO ()
 84 | generateScript ltsVersion = do
 85 |     T.hPutStrLn stderr ("Downloading constraints for LTS-" <> ltsTextVersion ltsVersion)
 86 |     contents <- downloadCabalConstraints ltsVersion
 87 |     T.hPutStrLn stderr "Parsing constraints file"
 88 |     case parse cabalConstraintFileP "" contents of
 89 |         Left err       -> T.putStrLn "Parse error: " >> print err
 90 |         Right packages -> renderScript ltsVersion packages
 91 | 
 92 | renderScript :: LtsVersion -> Packages -> IO ()
 93 | renderScript ltsVersion (Packages packages) = (render . layout . vcat)
 94 |     [ "#!/usr/bin/env bash"
 95 |     , ""
 96 |     , "set -euo pipefail"
 97 |     , ""
 98 |     , hang 4 (backslashedLineBreaks
 99 |         (pretty ("stack build --dry-run --prefetch --resolver lts-" <> ltsTextVersion ltsVersion)
100 |         : [pretty pkgName | (Name pkgName, _) <- packages
101 |                           , pkgName /= "ghc" -- Tends to misbehave so we exclude it here
102 |                           , pkgName /= "rts" -- Dito
103 |                           ]))
104 |     , ""
105 |     ]
106 |   where
107 |     render = renderIO stdout
108 |     layout = layoutPretty defaultLayoutOptions
109 |     backslashedLineBreaks = concatWith (\x y -> x <> " \\" <> line <> y)
110 | 
111 | -- | A list of packages and their respective versions.
112 | newtype Packages = Packages [(Name, Version)]
113 |     deriving (Eq, Ord, Show)
114 | 
115 | -- | Ad-hoc parser for handling Stackage provided Cabal constraint files.
116 | cabalConstraintFileP :: Parsec Void Text Packages
117 | cabalConstraintFileP = manyTill anyChar (try (string "constraints:"))
118 |      *> P.space
119 |      *> packagesP
120 |      <* manyTill anyChar eof
121 | 
122 |   where
123 | 
124 |     packagesP :: Parsec Void Text Packages
125 |     packagesP = fmap Packages (sepBy packageP comma')
126 |       where
127 |         comma' = char ',' *> P.space
128 | 
129 |     packageP :: Parsec Void Text (Name, Version)
130 |     packageP = do
131 |         name <- do n <- some (alphaNumChar <|> char '-')
132 |                    (pure . Name . T.pack) n
133 |         P.space
134 |         version <- do
135 |             let versionNumber = do
136 |                     _ <- string "=="
137 |                     v <- some (digitChar <|> char '.')
138 |                     pure (Version (T.pack v) )
139 |                 merelyInstalled = NoVersion <$ string "installed"
140 |             versionNumber <|> merelyInstalled
141 |         P.space
142 |         pure (name, version)
143 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
 1 | Stackage-Everything generator
 2 | =============================
 3 | 
 4 | tl;dr: »I want Stackage on an airplane and I have only 3 minutes until takeoff«
 5 | 
 6 | This small script generates a script to download all the sources of a Stackage
 7 | LTS release, so they can later be built/installed (including documentation) even
 8 | when no internet connection is available.
 9 | 
10 | A full download takes only a couple of minutes and around 60 megabytes of
11 | traffic at the time of writing this.
12 | 
13 | So if you’ve got a long flight ahead of you, or a weekend with your Granny in
14 | Siberia, or a dive into the Mariana Trench, or even worse – a trip through the
15 | German countryside by train – this is for you.
16 | 
17 | Usage
18 | -----
19 | 
20 | ```bash
21 | ./Generate.hs --lts 10.6 > everything # Generate install script
22 | chmod u+x everything                  # Make it runnable
23 | ./everything                          # Run it
24 | ```
25 | 
26 | Afterwards, you’ll be able to compile packages via the usual means (`stack
27 | build` or as dependencies) without internet access, because Stack first searches
28 | the local folders for source files before attempting to download them.
29 | 


--------------------------------------------------------------------------------