haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Remove lens (I'm afraid of hitting Cabal hell)

Browse Source
This commit is contained in:
Michael Snoyman 2012-11-05 11:41:53 +02:00
parent b9eb79068c
commit 83264153fc
3 changed files with 28 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
yesod/Options.hs
View File

@ -5,7 +5,6 @@ module Options (injectDefaults) where
import Control.Applicative
import qualified Control.Exception as E
import Control.Lens
import Control.Monad
import Data.Char (isAlphaNum, isSpace, toLower)
import Data.List (foldl')
@ -13,7 +12,6 @@ import Data.List.Split (splitOn)
import qualified Data.Map as M
import Data.Maybe (catMaybes)
import Data.Monoid
import Data.Monoid.Lens
import Options.Applicative
import Options.Applicative.Types
import System.Directory
@ -32,7 +30,7 @@ import System.FilePath ((</>))
-- for `many' arguments that generate a list of strings.
injectDefaults :: String -- ^ prefix, program name
-> [(String, Setting a a [String] [String])] -- ^ append extra options for arguments that are lists of strings
-> [(String, a -> [String] -> a)] -- ^ append extra options for arguments that are lists of strings
-> ParserInfo a -- ^ original parsers
-> IO (ParserInfo a)
injectDefaults prefix lenses parser = do
@ -45,11 +43,11 @@ injectDefaults prefix lenses parser = do
p' = parser { infoParser = injectDefaultP env [prefix] (infoParser parser) }
return $ foldl' (\p (key,l) -> fmap (updateA env key l) p) p' lenses
updateA :: M.Map [String] String -> String -> Setting a a [String] [String] -> a -> a
updateA :: M.Map [String] String -> String -> (a -> [String] -> a) -> a -> a
updateA env key upd a =
case M.lookup (splitOn "." key) env of
Nothing -> a
Just v -> upd <>~ (splitOn ":" v) $ a
Just v -> upd a (splitOn ":" v)
-- | really simple key/value file reader: x.y = z -> (["x","y"],"z")
configLines :: String -> [([String], String)]

42
yesod/main.hs
View File

@ -1,7 +1,6 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
import Control.Lens hiding (value)
import Control.Monad (unless)
import Data.Monoid
import Data.Version (showVersion)
@ -37,23 +36,23 @@ windowsWarning = " (does not work on Windows)"
data CabalPgm = Cabal | CabalDev deriving (Show, Eq)
data Options = Options
{ _optCabalPgm :: CabalPgm
, _optVerbose :: Bool
, _optCommand :: Command
{ optCabalPgm :: CabalPgm
, optVerbose :: Bool
, optCommand :: Command
}
deriving (Show, Eq)
data Command = Init
| Configure
| Build { _buildExtraArgs :: [String] }
| Build { buildExtraArgs :: [String] }
| Touch
| Devel { _develDisableApi :: Bool
, _develSuccessHook :: Maybe String
, _develFailHook :: Maybe String
, _develRescan :: Int
, _develBuildDir :: Maybe String
, _develIgnore :: [String]
, _develExtraArgs :: [String]
, develIgnore :: [String]
, develExtraArgs :: [String]
}
| Test
| AddHandler
@ -61,28 +60,37 @@ data Command = Init
| Version
deriving (Show, Eq)
makeLenses ''Options
makeLenses ''Command
cabalCommand :: Options -> String
cabalCommand mopt
| mopt^.optCabalPgm == CabalDev = "cabal-dev"
| otherwise = "cabal"
| optCabalPgm mopt == CabalDev = "cabal-dev"
| otherwise = "cabal"
main :: IO ()
main = do
o <- execParser =<< injectDefaults "yesod" [ ("yesod.devel.extracabalarg" , optCommand . develExtraArgs)
, ("yesod.devel.ignore" , optCommand . develIgnore)
, ("yesod.build.extracabalarg" , optCommand . buildExtraArgs)
o <- execParser =<< injectDefaults "yesod" [ ("yesod.devel.extracabalarg" , \o args -> o { optCommand =
case optCommand o of
d@Devel{} -> d { develExtraArgs = args }
c -> c
})
, ("yesod.devel.ignore" , \o args -> o { optCommand =
case optCommand o of
d@Devel{} -> d { develIgnore = args }
c -> c
})
, ("yesod.build.extracabalarg" , \o args -> o { optCommand =
case optCommand o of
b@Build{} -> b { buildExtraArgs = args }
c -> c
})
] optParser'
let cabal xs = rawSystem' (cabalCommand o) xs
case o^.optCommand of
case optCommand o of
Init -> scaffold
Configure -> cabal ["configure"]
Build es -> touch' >> cabal ("build":es)
Touch -> touch'
Devel da s f r b ign es -> devel (DevelOpts (o^.optCabalPgm == CabalDev) da (o^.optVerbose) r s f b) es
Devel da s f r b _ig es -> devel (DevelOpts (optCabalPgm o == CabalDev) da (optVerbose o) r s f b) es
Keter noRebuild -> keter (cabalCommand o) noRebuild
Version -> do putStrLn ("yesod-core version:" ++ yesodVersion)
putStrLn ("yesod version:" ++ showVersion Paths_yesod.version)

1
yesod/yesod.cabal
View File

@ -134,7 +134,6 @@ executable yesod
, optparse-applicative >= 0.4 && < 0.5
, fsnotify >= 0.0 && < 0.1
, split >= 0.2 && < 0.3
, lens >= 3.1 && < 4
ghc-options: -Wall -threaded
main-is: main.hs