Basic version of 'downloadURL'

2020-01-16 23:27:38 +01:00 · 2020-01-16 23:27:38 +01:00 · 92531045f8
commit 92531045f8
parent 3fb5c612c1
12 changed files with 355 additions and 238 deletions
--- a/README.md
+++ b/README.md
@ -1 +1,34 @@
 # ghcup
+
+A rewrite of ghcup in haskell. This can be used as a library
+and may be redistributed as a binary in the future.
+
+## Motivation
+
+ghcup has increasingly become difficult to maintain. A few reasons:
+
+* few maintainers
+* increasing LOC
+* platform incompatibilities regularly causing breaking bugs:
+	* [Mktemp not working properly on macOS](https://gitlab.haskell.org/haskell/ghcup/issues/130)
+	* [ln: illegal option -- T on macOS Catalina](https://gitlab.haskell.org/haskell/ghcup/issues/123)
+	* [Wrong tar flag on darwin](https://gitlab.haskell.org/haskell/ghcup/issues/119))
+* refactoring being difficult due to POSIX sh
+
+More benefits of a rewrite:
+
+* Features such as installing [release candidates](https://gitlab.haskell.org/haskell/ghcup/issues/94) or [HEAD builds](https://gitlab.haskell.org/haskell/ghcup/issues/65) can be more conveniently implemented in a rewrite
+* Refactoring will be easier
+* Better tool support (such as linting the downloads file)
+* saner downloads file format (such as JSON)
+
+However, the downside will be:
+
+* building static binaries for all platforms (and possibly causing SSL/DNS problems)
+* still bootstrapping those binaries via a POSIX sh script
+
+## Goals
+
+* Correct low-level code
+* Good exception handling
+* Easier user interface (possibly interactive and non-interactive ones)
--- a/TODO.md
+++ b/TODO.md
@ -0,0 +1,12 @@
+# TODOs and Remarks
+
+* handling of SIGTERM and SIGUSR
+* add support for RC/alpha/HEAD versions
+* redo/rethink how tool tags works
+* installing multiple versions in parallel?
+
+* exception handling (checked exception library? Maybe effects system all the way?)
+* how to version and extend the format of the downloads file? Compatibility?
+* how to propagate updates? Automatically? Might solve the versioning problem
+
+
--- a/cabal.project
+++ b/cabal.project
@ -1,2 +1,9 @@
 packages: ./ghcup.cabal

+optimization: 2
+
+package streamly
+    ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
+
+package ghcup
+    ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
--- a/ghcup.cabal
+++ b/ghcup.cabal
@ -20,6 +20,7 @@ source-repository head
  type: git
  location: https://github.com/hasufell/ghcup-hs

+common aeson { build-depends: aeson >= 1.4 }
 common ascii-string { build-depends: ascii-string >= 1.0 }
 common base { build-depends: base >= 4.12.0.0 && < 5 }
 common bytestring { build-depends: bytestring >= 0.10 }
@ -36,12 +37,16 @@ common streamly { build-depends: streamly >= 0.7 }
 common strict-base { build-depends: strict-base >= 0.4 }
 common template-haskell { build-depends: template-haskell >= 2.7 }
 common text { build-depends: text >= 1.2 }
+common text-icu { build-depends: text-icu >= 0.7 }
 common transformers { build-depends: transformers >= 0.5 }
 common unix { build-depends: unix >= 2.7 }
 common url { build-depends: url >= 2.1 }
 common utf8-string { build-depends: utf8-string >= 1.0 }
 common vector { build-depends: vector >= 0.12 }
 common waargonaut { build-depends: waargonaut >= 0.8 }
+common async { build-depends: async >= 0.8 }
+common mtl { build-depends: mtl >= 2.2 }
+common versions { build-depends: versions >= 3.5 }


 common config
@ -53,7 +58,9 @@ library
  import:              config
                     , base
                       -- deps
+                     , aeson
                     , ascii-string
+                     , async
                     , bytestring
                     , containers
                     , generics-sop
@ -61,6 +68,7 @@ library
                     , hpath-filepath
                     , hpath-io
                     , language-bash
+                     , mtl
                     , optics
                     , parsec
                     , safe-exceptions
@ -68,12 +76,13 @@ library
                     , strict-base
                     , template-haskell
                     , text
+                     , text-icu
                     , transformers
                     , unix
                     , url
                     , utf8-string
                     , vector
-                     , waargonaut
+                     , versions
  exposed-modules:     GHCup
                       GHCup.Bash
                       GHCup.File
--- a/lib/GHCup.hs
+++ b/lib/GHCup.hs
@ -10,44 +10,46 @@
 -- TODO: handle SIGTERM, SIGUSR
 module GHCup where

+
 import           Control.Applicative
-import           Data.Strict.Maybe
-import           Data.Version
-import           GHCup.Prelude
+import           Control.Monad
+import           Data.Foldable                  ( asum )
+import           Data.Text                      ( Text )
+import           Data.Versions
 import           GHCup.Bash
 import           GHCup.File
+import           GHCup.Prelude
 import           GHCup.Types
 import           GHCup.Types.Optics
 import           HPath
 import           HPath.IO
 import           Network.URL
-import qualified Data.ByteString.Lazy.UTF8     as UTF8
 import           Optics
 import           Prelude                 hiding ( abs
-                                                , Maybe
-                                                , Just
-                                                , Nothing
+                                                , readFile
                                                )
 import           System.Info
-
+import qualified Data.Text                     as T
+import qualified Data.Text.ICU                 as ICU
+import           Data.Maybe                     ( isJust )
 import qualified Data.Map.Strict               as Map
-import qualified GHC.Exts                      as GE
-import qualified Prelude                       as P
-import qualified System.Posix.Process.ByteString
-                                               as SPPB
-


 availableDownloads :: AvailableDownloads
 availableDownloads = Map.fromList
  [ ( GHC
    , Map.fromList
-      [ ( mkV [8, 6, 5]
+      [ ( (\(Right x) -> x) $ version (fS "8.6.5")
        , Map.fromList
          [ ( A_64
            , Map.fromList
              [ ( Linux UnknownLinux
-                , mkGHCUrl "~ghc/8.6.5/ghc-8.6.5-x86_64-fedora27-linux.tar.xz"
+                , Map.fromList
+                  [ ( Nothing
+                    , mkGHCUrl
+                      "~ghc/8.6.5/ghc-8.6.5-x86_64-fedora27-linux.tar.xz"
+                    )
+                  ]
                )
              ]
            )
@ -57,101 +59,170 @@ availableDownloads = Map.fromList
    )
  ]
 where
-  mkV = makeVersion
  mkGHCUrl path = URL
-    { url_type   = Absolute $ Host (HTTP True) "downloads.haskell.org" P.Nothing
+    { url_type   = Absolute $ Host (HTTP True) "downloads.haskell.org" Nothing
    , url_path   = path
    , url_params = []
    }

-downloadURL :: Tool
+
+downloadURL :: ToolRequest
+            -> Maybe PlatformRequest
+            -> URLSource
+            -> IO (Maybe URL) -- TODO: better error handling
+downloadURL (ToolRequest t v) mpfReq urlSource = do
+  (PlatformRequest arch plat ver) <- case mpfReq of
+    Just x  -> pure x
+    Nothing -> do
+      (PlatformResult rp rv) <- getPlatform
+      let ar = (\(Right x) -> x) getArchitecture
+      pure $ PlatformRequest ar rp rv
+
+  dls <- case urlSource of
+    GHCupURL      -> fail "Not implemented"
+    OwnSource url -> fail "Not implemented"
+    OwnSpec   dls -> pure dls
+
+  pure $ downloadURL' t v arch plat ver dls
+
+
+downloadURL' :: Tool
             -> Version
+             -- ^ tool version
             -> Architecture
+             -- ^ user arch
             -> Platform
+             -- ^ user platform
+             -> Maybe Versioning
+             -- ^ optional version of the platform
             -> AvailableDownloads
             -> Maybe URL
-downloadURL t v a p dls = with_distro <|> without_ver <|> without_distro
+downloadURL' t v a p mv dls =
+  with_distro <|> without_distro_ver <|> without_distro

 where
-  with_distro    = distro_preview id
-  without_distro = distro_preview withoutDistro
-  without_ver    = distro_preview withoutVer
+  with_distro        = distro_preview id id
+  without_distro     = distro_preview (set _Linux UnknownLinux) id
+  without_distro_ver = distro_preview id (const Nothing)

-  distro_preview f =
-    toStrictMaybe $ preview (atJust t % atJust v % atJust a % atJust (f p)) dls
+  distro_preview f g =
+    preview (atJust t % atJust v % atJust a % atJust (f p) % atJust (g mv)) dls
  atJust x = at x % _Just

-  -- | If we can't find a version with the given distro,
-  -- then just try with the platform.
-  withoutDistro :: Platform -> Platform
-  withoutDistro (Linux _)   = Linux UnknownLinux
-  withoutDistro Darwin      = Darwin
-  withoutDistro (FreeBSD _) = FreeBSD Nothing

-  -- | If we can't find a match with the given distro version,
-  -- we gotta try without it.
-  withoutVer :: Platform -> Platform
-  withoutVer (Linux (Debian _)  ) = Linux $ Debian Nothing
-  withoutVer (Linux (Ubuntu _)  ) = Linux $ Ubuntu Nothing
-  withoutVer (Linux (Mint   _)  ) = Linux $ Mint Nothing
-  withoutVer (Linux (Fedora _)  ) = Linux $ Fedora Nothing
-  withoutVer (Linux UnknownLinux) = Linux $ UnknownLinux
-  withoutVer Darwin               = Darwin
-  withoutVer (FreeBSD _)          = FreeBSD Nothing
-
-
-getArchitecture :: IO Architecture
+getArchitecture :: Either String Architecture
 getArchitecture = case arch of
  "x86_64" -> pure A_64
  "i386"   -> pure A_32
-  what     -> fail ("Could not find compatible architecture. Was: " <> what)
+  what     -> Left ("Could not find compatible architecture. Was: " <> what)



-getPlatform :: IO Platform
+getPlatform :: IO PlatformResult
 getPlatform = case os of
  "linux" -> do
-    distro <- getLinuxDistro
-    pure $ Linux distro
+    (distro, ver) <- getLinuxDistro
+    pure $ PlatformResult { _platform = Linux distro, _distroVersion = ver }
  -- TODO: these are not verified
-  "darwin"  -> pure $ Darwin
+  "darwin" ->
+    pure $ PlatformResult { _platform = Darwin, _distroVersion = Nothing }
  "freebsd" -> do
    ver <- getFreeBSDVersion
-    pure $ FreeBSD ver
+    pure $ PlatformResult { _platform = FreeBSD, _distroVersion = ver }
  what -> fail ("Could not find compatible platform. Was: " <> what)
+  where getFreeBSDVersion = pure Nothing

+
+getLinuxDistro :: IO (LinuxDistro, Maybe Versioning)
+getLinuxDistro = do
+  (name, ver) <- asum
+    [ try_os_release
+    , try_lsb_release_cmd
+    , try_lsb_release
+    , try_redhat_release
+    , try_debian_version
+    ]
+  let parsedVer = ver >>= either (const Nothing) Just . versioning
+      distro    = if
+        | hasWord name (T.pack <$> ["debian"])  -> Debian
+        | hasWord name (T.pack <$> ["ubuntu"])  -> Ubuntu
+        | hasWord name (T.pack <$> ["linuxmint", "Linux Mint"]) -> Mint
+        | hasWord name (T.pack <$> ["fedora"])  -> Fedora
+        | hasWord name (T.pack <$> ["centos"])  -> CentOS
+        | hasWord name (T.pack <$> ["Red Hat"]) -> RedHat
+        | hasWord name (T.pack <$> ["alpine"])  -> Alpine
+        | hasWord name (T.pack <$> ["exherbo"]) -> Exherbo
+        | hasWord name (T.pack <$> ["gentoo"])  -> Gentoo
+        | otherwise                             -> UnknownLinux
+  pure (distro, parsedVer)
 where
-  getLinuxDistro :: IO LinuxDistro
-  getLinuxDistro = do
-    let os_release     = [abs|/etc/os-release|]
+  hasWord t matches = foldr
+    (\x y ->
+      ( isJust
+        . ICU.find (ICU.regex [ICU.CaseInsensitive] (fS "\\b" <> x <> fS "\\b"))
+        $ t
+        )
+        || y
+    )
+    False
+    matches
+
+  os_release :: Path Abs
+  os_release = [abs|/etc/os-release|]
+  lsb_release :: Path Abs
  lsb_release = [abs|/etc/lsb-release|]
+  lsb_release_cmd :: Path Fn
+  lsb_release_cmd = [fn|lsb-release|]
+  redhat_release :: Path Abs
  redhat_release = [abs|/etc/redhat-release|]
+  debian_version :: Path Abs
  debian_version = [abs|/etc/debian_version|]

-    pure undefined
+  try_os_release :: IO (Text, Maybe Text)
+  try_os_release = do
+    (Just name) <- getAssignmentValueFor os_release "NAME"
+    ver         <- getAssignmentValueFor os_release "VERSION_ID"
+    pure (T.pack name, fmap T.pack ver)

-  getFreeBSDVersion = pure Nothing
+  try_lsb_release_cmd :: IO (Text, Maybe Text)
+  try_lsb_release_cmd = do
+    (Just _        ) <- findExecutable lsb_release_cmd
+    (Just (name, _)) <- executeOut lsb_release_cmd [fS "-si"]
+    ver              <- executeOut lsb_release_cmd [fS "-sr"]
+    pure (lBS2sT name, fmap (lBS2sT . fst) ver)

-  -- Try various methods for getting distro name and version.
-  -- Failure is signalled with an IO exception.
-try_os_release :: IO (String, P.Maybe String)
-try_os_release = do
-  name <- getAssignmentValueFor [abs|/etc/os-release|] "NAME" >>= \case
-    P.Just s  -> pure $ s
-    P.Nothing -> fail "No value found"
-  version <- getAssignmentValueFor [abs|/etc/os-release|] "VERSION_ID"
-  pure (name, version)
+  try_lsb_release :: IO (Text, Maybe Text)
+  try_lsb_release = do
+    (Just name) <- getAssignmentValueFor lsb_release "DISTRIB_ID"
+    ver         <- getAssignmentValueFor lsb_release "DISTRIB_RELEASE"
+    pure (T.pack name, fmap T.pack ver)
+
+  try_redhat_release :: IO (Text, Maybe Text)
+  try_redhat_release = do
+    t <- fmap lBS2sT $ readFile redhat_release
+    let nameRe n =
+          join
+            . fmap (ICU.group 0)
+            . ICU.find
+                (ICU.regex [ICU.CaseInsensitive] (fS "\\b" <> fS n <> fS "\\b")
+                )
+            $ t
+        verRe =
+          join
+            . fmap (ICU.group 0)
+            . ICU.find
+                (ICU.regex [ICU.CaseInsensitive] (fS "\\b(\\d)+(.(\\d)+)*\\b"))
+            $ t
+    (Just name) <- pure
+      (nameRe "CentOS" <|> nameRe "Fedora" <|> nameRe "Red Hat")
+    pure (name, verRe)
+
+  try_debian_version :: IO (Text, Maybe Text)
+  try_debian_version = do
+    True <- doesFileExist debian_version
+    ver  <- readFile debian_version
+    pure (T.pack "debian", Just $ lBS2sT ver)

-try_lsb_release_cmd :: IO (String, P.Maybe String)
-try_lsb_release_cmd = findExecutable ([fn|lsb_release|] :: Path Fn) >>= \case
-  P.Nothing   -> fail "lsb_release not found"
-  P.Just path -> do
-    name <- executeOut ([fn|lsb_release|] :: Path Fn) [fS "-si"] >>= \case
-      P.Just (out, _) -> pure out
-      _               -> fail "Barfed output of lsb_release"
-    version <- (fmap . fmap) (UTF8.toString . fst)
-      $ executeOut ([fn|lsb_release|] :: Path Fn) [fS "-si"]
-    pure (UTF8.toString name, version)



--- a/lib/GHCup/Bash.hs
+++ b/lib/GHCup/Bash.hs
@ -1,58 +1,47 @@
-module GHCup.Bash where
+module GHCup.Bash
+  ( findAssignment
+  , equalsAssignmentWith
+  , getRValue
+  , getAssignmentValueFor
+  )
+where

-import           Data.ByteString
-import           Language.Bash.Parse.Word
+import           Language.Bash.Parse
 import           Language.Bash.Word
 import           Language.Bash.Syntax
-import           Text.Parsec
 import           HPath
+import           HPath.IO
 import           Data.ByteString.UTF8           ( toString )
-import           Streamly
-import           GHCup.File
-import           GHCup.Prelude                  ( internalError )
-import qualified Streamly.Prelude              as S
 import           Control.Monad
 import           Data.Maybe
+import qualified Data.ByteString.Lazy.UTF8     as UTF8
+import           Prelude                 hiding ( readFile )
+import           Data.List


-- | Parse a single assignment of the given line.
-parseAssignment :: SourceName -- ^ file/location of the parser
-                -> ByteString -- ^ the line as a bytestring
-                -> Either ParseError Assign
-parseAssignment = runParser assign ()
+extractAssignments :: List -> [Assign]
+extractAssignments (List stms) = join $ fmap getAssign $ getCommands stms
+ where
+  getCommands :: [Statement] -> [Command]
+  getCommands = join . fmap commands . catMaybes . fmap findPipes
+   where
+    findPipes (Statement (Last p@(Pipeline{})) Sequential) = Just p
+    findPipes _ = Nothing

-
-- | Parse assignments in a stream.
-parseAssignments :: Monad m
-                 => SourceName -- ^ file/location of the parser
-                 -> SerialT m (ByteString)
-                 -> SerialT m (Either ParseError Assign)
-parseAssignments sn = fmap (parseAssignment sn)
+  getAssign :: Command -> [Assign]
+  getAssign (Command (SimpleCommand ass _) _) = ass
+  getAssign _ = []


 -- | Find an assignment matching the predicate in the given file.
-findAssignment :: Path b
-               -> (Assign -> Bool) -- ^ predicate
-               -> IO (Maybe Assign)
+findAssignment :: Path b -> (Assign -> Bool) -> IO (Maybe Assign)
 findAssignment p predicate = do
-  let fn' = toString . toFilePath $ p
-  stream <- fmap (parseAssignments fn') $ readFileLines p
-  res    <-
-    S.find -- empties the stream on first match, but doesn't terminate it
-        (\case
-          Right ass -> predicate ass
-          Left  _   -> False
-        )
-        stream
-      >>= \case
-            Just (Right x) -> pure (Just x)
-            Just (Left _) ->
-              internalError "unexpected Left in findAssignment"
-            Nothing -> pure Nothing
-  -- Closes the file handle. Because if there was a match, then
-  -- the stream is not terminated.
-  when (isJust res) $ S.drain stream
-  pure res
+  fileContents <- readFile p
+  -- TODO: this should accept bytestring:
+  --       https://github.com/knrafto/language-bash/issues/37
+  case parse (toString . toFilePath $ p) (UTF8.toString fileContents) of
+    Left  e -> fail $ show e
+    Right l -> pure $ find predicate (extractAssignments $ l)


 -- | Check that the assignment is of the form Foo= ignoring the
--- a/lib/GHCup/File.hs
+++ b/lib/GHCup/File.hs
@ -1,6 +1,6 @@
 module GHCup.File where

-import           Data.ByteString hiding (putStrLn)
+import           Data.ByteString
 import qualified Data.ByteString.Lazy          as L
 import           Data.Char
 import           Data.Maybe
@ -14,7 +14,9 @@ import           Control.Monad
 import           Control.Exception.Safe
 import           Data.Functor
 import           System.Posix.Files.ByteString
-import           System.Posix.IO.ByteString hiding (openFd)
+import           System.IO
+import           System.Posix.IO.ByteString
+                                         hiding ( openFd )
 import qualified System.Posix.Process.ByteString
                                               as SPPB
 import           System.Posix.Types
@ -24,19 +26,11 @@ import qualified Streamly.Internal.Memory.ArrayStream
 import qualified Streamly.FileSystem.Handle    as FH
 import qualified Streamly.Internal.Data.Unfold as SU
 import qualified Streamly.Prelude              as S
-import           System.IO
 import           System.Exit
 import qualified Streamly.Data.Fold            as FL
 import           Data.ByteString.Builder
 import           Foreign.C.Error
 import           GHCup.Prelude
-import Control.Monad.Trans.Maybe
-import HPath.Internal
-import System.Posix.FD
-  (
-    openFd
-  )
-


 -- |Checks whether a file is executable. Follows symlinks.
@ -66,20 +60,12 @@ readFd fd = do
 -- terminates (either through exception or because it's drained).
 readFileLines :: Path b -> IO (SerialT IO ByteString)
 readFileLines p = do
-  stream <- readFileStream' p
+  stream <- readFileStream p
  pure
    . (>>= arrayToByteString)
    . AS.splitOn (fromIntegral $ ord '\n')
    . (>>= byteStringToArray)
    $ stream
-  where
-    readFileStream' :: Path b
-                   -> IO (SerialT IO ByteString)
-    readFileStream' (MkPath fp) = do
-      fd <- openFd fp ReadOnly [] Nothing
-      handle' <- fdToHandle fd
-      let stream = (S.unfold (SU.finally (\x -> putStrLn "hClose" >> hClose x) FH.readChunks) handle') >>= arrayToByteString
-      pure stream


 -- | Find the given executable by searching all *absolute* PATH components.
@ -92,42 +78,32 @@ findExecutable ex = do
  sPaths <- fmap catMaybes . (fmap . fmap) parseAbs $ getSearchPath
  -- We don't want exceptions to mess up our result. If we can't
  -- figure out if a file exists, then treat it as a negative result.
-  asum $ fmap (handleIOError (\_ -> pure  Nothing)) $ fmap
+  asum $ fmap (handleIO (\_ -> pure Nothing)) $ fmap
    -- asum for short-circuiting behavior
    (\s -> (isExecutable (s </> ex) >>= guard) $> (Just (s </> ex)))
    sPaths


-findExecutablee :: RelC r => Path r -> IO (Maybe (Path Abs))
-findExecutablee ex = do
-  sPaths <- mapMaybe parseAbs <$> getSearchPath
-  runMaybeT $ asum (MaybeT . eExists <$> sPaths)
-  where
-    eExists sp = let path = sp </> ex in handleIOError (pure $ pure Nothing) $ Just path <$ doesFileExist path
-
-
-- TODO: fd leak
 -- | Execute the given command and collect the stdout and the exit code.
 executeOut :: Path Fn -- ^ command as filename, e.g. 'ls'
           -> [ByteString] -- ^ arguments to the command
           -> IO (Maybe (L.ByteString, ExitCode)) -- ^ fst of the tuple is the stdout
 executeOut path args = withFnPath path $ \fp -> do
-  (readE, writeE) <- createPipe
+  (parentRead, childWrite) <- createPipe
  pid                      <- SPPB.forkProcess $ do
    whileM_
-      (dupTo writeE stdOutput)
+      (dupTo childWrite stdOutput)
      (\r ->
        getErrno >>= \e -> pure $ r == fromIntegral (-1 :: Int) && e == eINTR
      )
-    closeFd writeE
-    closeFd readE
+    closeFd childWrite
+    closeFd parentRead
+    closeFd stdInput
    SPPB.executeFile fp True args Nothing

-  closeFd writeE
+  closeFd childWrite

-  -- readFd will take care of closing the fd
  SPPB.getProcessStatus True True pid >>= \case
-    Just (SPPB.Exited es) -> do
-      out <- readFd readE
-      pure $ Just (out, es)
-    _ -> pure Nothing
+    -- readE will take care of closing the fd
+    Just (SPPB.Exited es) -> readFd parentRead <&> Just . (, es)
+    _                     -> closeFd parentRead $> Nothing
--- a/lib/GHCup/Prelude.hs
+++ b/lib/GHCup/Prelude.hs
@ -5,16 +5,21 @@
 module GHCup.Prelude where

 import           Control.Applicative
+import           Control.Monad
 import           Data.Strict.Maybe
 import           Data.Monoid                    ( (<>) )
 import           Prelude                        ( Monad
                                                , Bool
                                                , return
                                                , (.)
-                                                , (>>=)
                                                )
 import qualified Prelude                       as P
 import           Data.String
+import qualified Data.Text.Lazy.Encoding       as TLE
+import qualified Data.Text.Lazy                as TL
+import           Data.Text                      ( Text )
+import qualified Data.ByteString.Lazy          as L
+


 fS :: IsString a => P.String -> a
@ -23,9 +28,15 @@ fS = fromString
 fromStrictMaybe :: Maybe a -> P.Maybe a
 fromStrictMaybe = maybe P.Nothing P.Just

+fSM :: Maybe a -> P.Maybe a
+fSM = fromStrictMaybe
+
 toStrictMaybe :: P.Maybe a -> Maybe a
 toStrictMaybe = P.maybe Nothing Just

+tSM :: P.Maybe a -> Maybe a
+tSM = toStrictMaybe
+
 instance Applicative Maybe where
  pure = Just

@ -61,6 +72,17 @@ ifM ~b ~t ~f = do
  b' <- b
  if b' then t else f

-whileM_ :: Monad m => m a -> (a -> m Bool) -> m ()
-whileM_ action f = whenM (action >>= f) (whileM_ action f)
+whileM :: Monad m => m a -> (a -> m Bool) -> m a
+whileM ~action ~f = do
+  a  <- action
+  b' <- f a
+  if b' then whileM action f else pure a

+whileM_ :: Monad m => m a -> (a -> m Bool) -> m ()
+whileM_ ~action = void . whileM action
+
+guardM :: (Monad m, Alternative m) => m Bool -> m ()
+guardM f = guard =<< f
+
+lBS2sT :: L.ByteString -> Text
+lBS2sT = TL.toStrict . TLE.decodeUtf8
--- a/lib/GHCup/Types.hs
+++ b/lib/GHCup/Types.hs
@ -2,50 +2,66 @@

 module GHCup.Types where

-import Data.Map.Strict (Map)
-import Data.Strict.Maybe
-import Data.Text
-import Data.Version
+import           Data.Map.Strict                ( Map )
 import           Network.URL
-import Prelude hiding (
-    Maybe
-  , Just
-  , Nothing)
-
 import qualified GHC.Generics                  as GHC
+import           Data.Versions


-- | Requested tool to be installed. User input.
 data Tool = GHC
          | Cabal
          | Stack
  deriving (Eq, Ord, Show)

-- | Architecture we run on.
+data ToolRequest = ToolRequest {
+    _tool :: Tool
+  , _toolVersion :: Version
+} deriving (Eq, Show)
+
 data Architecture = A_64
                  | A_32
  deriving (Eq, Ord, Show)

-data LinuxDistro = Debian (Maybe CustomVersion)
-                 | Ubuntu (Maybe CustomVersion)
-                 | Mint   (Maybe CustomVersion)
-                 | Fedora (Maybe CustomVersion)
+data LinuxDistro = Debian
+                 | Ubuntu
+                 | Mint
+                 | Fedora
+                 | CentOS
+                 | RedHat
+                 | Alpine
+                 -- rolling
+                 | Gentoo
+                 | Exherbo
                 -- not known
                 | UnknownLinux
                 -- ^ must exit
  deriving (Eq, GHC.Generic, Ord, Show)

-
 data Platform = Linux LinuxDistro
              -- ^ must exit
              | Darwin
              -- ^ must exit
-              | FreeBSD (Maybe CustomVersion)
+              | FreeBSD
  deriving (Eq, GHC.Generic, Ord, Show)

-type CustomVersion = Text
-type PlatformSpec = Map Platform URL
-type ArchitectureSpec = Map Architecture PlatformSpec
-type VersionSpec = Map Version ArchitectureSpec
-type AvailableDownloads = Map Tool VersionSpec
+data PlatformResult = PlatformResult {
+    _platform :: Platform
+  , _distroVersion :: Maybe Versioning
+} deriving (Eq, Show)

+data PlatformRequest = PlatformRequest {
+    _rArch :: Architecture
+  , _rPlatform :: Platform
+  , _rVersion :: Maybe Versioning
+} deriving (Eq, Show)
+
+type PlatformVersionSpec = Map (Maybe Versioning) URL
+type PlatformSpec = Map Platform PlatformVersionSpec
+type ArchitectureSpec = Map Architecture PlatformSpec
+type ToolVersionSpec = Map Version ArchitectureSpec
+type AvailableDownloads = Map Tool ToolVersionSpec
+
+
+data URLSource = GHCupURL
+               | OwnSource URL
+               | OwnSpec AvailableDownloads
--- a/lib/GHCup/Types/Foo.hs
+++ b/lib/GHCup/Types/Foo.hs
@ -1,18 +0,0 @@
-encToJsonNoSpaces
-  :: ( Monoid t
-     , Applicative f
-     )
-  => AReview Json (b, t)
-  -> (a -> b)
-  -> Encoder f a
-encToJsonNoSpaces c f =
-  encodeA (pure . review c . (, mempty) . f)
-
-bytestring :: Applicative f => Encoder f ByteString
-bytestring = encToJsonNoSpaces _JStr (_JStringBS #)
-
-_JStringBS :: (Profunctor p, Applicative f)
-             => p ByteString (f ByteString)
-             -> p JString (f JString)
-_JStringBS = iso (C.pack . review _JString)
-                 (JString' . V.fromList . fmap utf8CharToJChar . C.unpack)
--- a/lib/GHCup/Types/JSON.hs
+++ b/lib/GHCup/Types/JSON.hs
@ -11,30 +11,19 @@ module GHCup.Types.JSON where

 import           Data.Strict.Maybe
 import           GHCup.Types
-import Generics.SOP.TH
-import Prelude hiding (
-    Maybe
-  , Just
-  , Nothing)
-import Waargonaut.Generic (
-    JsonEncode
-  , JsonDecode
-  , GWaarg)
+import           Prelude                 hiding ( Maybe )
+import           Data.Versions
+import           Data.Aeson
+import           Data.Aeson.TH


-deriveGeneric ''Maybe
-instance JsonEncode GWaarg a => JsonEncode GWaarg (Maybe a)
-instance JsonDecode GWaarg a => JsonDecode GWaarg (Maybe a)
-
-deriveGeneric ''Tool
-instance JsonEncode GWaarg Tool
-instance JsonDecode GWaarg Tool
-
-deriveGeneric ''Architecture
-instance JsonEncode GWaarg Architecture
-instance JsonDecode GWaarg Architecture
-
-deriveGeneric ''LinuxDistro
-instance JsonEncode GWaarg LinuxDistro
-instance JsonDecode GWaarg LinuxDistro
-
+deriveJSON defaultOptions ''Architecture
+deriveJSON defaultOptions ''LinuxDistro
+deriveJSON defaultOptions ''Maybe
+deriveJSON defaultOptions ''Mess
+deriveJSON defaultOptions ''SemVer
+deriveJSON defaultOptions ''Tool
+deriveJSON defaultOptions ''VSep
+deriveJSON defaultOptions ''VUnit
+deriveJSON defaultOptions ''Version
+deriveJSON defaultOptions ''Versioning
--- a/lib/GHCup/Types/Optics.hs
+++ b/lib/GHCup/Types/Optics.hs
@ -2,4 +2,15 @@

 module GHCup.Types.Optics where

+import GHCup.Types
+import Optics
+
+makePrisms ''Tool
+makePrisms ''Architecture
+makePrisms ''LinuxDistro
+makePrisms ''Platform
+
+makeLenses ''PlatformResult
+makeLenses ''ToolRequest
+