packages feed

smerdyakov (empty) → 0.0.0.0

raw patch · 10 files changed

+438/−0 lines, 10 filesdep +Globdep +QuickCheckdep +basesetup-changed

Dependencies added: Glob, QuickCheck, base, doctest, exceptions, free, hspec, mtl, process, smerdyakov, text, transformers, yaml

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Julian K. Arni (c) 2015++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Julian K. Arni nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ smerdyakov.cabal view
@@ -0,0 +1,87 @@+-- This file has been generated from package.yaml by hpack version 0.14.0.+--+-- see: https://github.com/sol/hpack++name:           smerdyakov+version:        0.0.0.0+description:    Please see README.md+homepage:       http://github.com/jkarni/smerdyakov#README.md+bug-reports:    https://github.com/jkarni/hask-deps/issues+author:         Julian K. Arni+maintainer:     jkarni@gmail.com+copyright:      (c) Julian K. Arni+license:        BSD3+license-file:   LICENSE+tested-with:    GHC == 7.8.3, GHC == 7.10.2, GHC == 8.0.1+build-type:     Simple+cabal-version:  >= 1.10++source-repository head+  type: git+  location: https://github.com/jkarni/hask-deps++library+  hs-source-dirs:+      src+  default-extensions: AutoDeriveTypeable ConstraintKinds DataKinds DefaultSignatures DeriveFunctor DeriveGeneric DeriveFoldable DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes RoleAnnotations ScopedTypeVariables TypeFamilies TypeOperators+  ghc-options: -Wall+  build-depends:+      base >= 4.7 && < 4.10+    , process == 1.2.*+    , exceptions == 0.8.*+    , free == 4.12.*+    , transformers == 0.4.*+    , mtl == 2.2.*+    , text+  exposed-modules:+      Smerdyakov+      Smerdyakov.Internal.Class+      Smerdyakov.Internal.FreeIO+      Smerdyakov.System+  default-language: Haskell2010++test-suite doctest+  type: exitcode-stdio-1.0+  main-is: Doctest.hs+  hs-source-dirs:+      test+  default-extensions: AutoDeriveTypeable ConstraintKinds DataKinds DefaultSignatures DeriveFunctor DeriveGeneric DeriveFoldable DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes RoleAnnotations ScopedTypeVariables TypeFamilies TypeOperators+  ghc-options: -Wall+  build-depends:+      base >= 4.7 && < 4.10+    , process == 1.2.*+    , exceptions == 0.8.*+    , free == 4.12.*+    , transformers == 0.4.*+    , mtl == 2.2.*+    , text+    , doctest >= 0.9 && < 0.12+    , Glob >= 0.7 && < 0.8+    , yaml == 0.8.*+  other-modules:+      SmerdyakovSpec+      Spec+  default-language: Haskell2010++test-suite spec+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test+  default-extensions: AutoDeriveTypeable ConstraintKinds DataKinds DefaultSignatures DeriveFunctor DeriveGeneric DeriveFoldable DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes RoleAnnotations ScopedTypeVariables TypeFamilies TypeOperators+  ghc-options: -Wall+  build-depends:+      base >= 4.7 && < 4.10+    , process == 1.2.*+    , exceptions == 0.8.*+    , free == 4.12.*+    , transformers == 0.4.*+    , mtl == 2.2.*+    , text+    , smerdyakov+    , hspec > 2 && < 3+    , QuickCheck >= 2.8 && < 2.9+  other-modules:+      Doctest+      SmerdyakovSpec+  default-language: Haskell2010
+ src/Smerdyakov.hs view
@@ -0,0 +1,36 @@+-- | 'Smerdyakov' allows you to declare dependencies or assumptions that your+-- functions make, and have them automatically gather recursively gathered. The+-- essence of it is not unlike the tool @Make@.+module Smerdyakov+  (+  -- * Core functionality+  -- | These classes provide the core functionality of the package.+    Gives(..)+  , Needs+  , make++  -- * Actions+  -- | The actions that are to be performed in fulfilling your dependencies or+  -- assumptions are described in the monad @Action@. This is a free monad that+  -- can perform basic IO functionality.+  --+  -- The set of IO actions defined in 'Action' is still quite limited; if there+  -- is something you need that is not yet available, please open an issue or+  -- send a PR.+  , shellA+  , shellWithErrA+  , openFileA+  , hCloseA+  , interpretIO+  , throwA+  , ActionError(..)+  , Action+++  -- * Re-Exports+  , Proxy(Proxy)+  ) where++import Smerdyakov.Internal.Class as X+import Smerdyakov.Internal.FreeIO as X+import Data.Proxy as X
+ src/Smerdyakov/Internal/Class.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE IncoherentInstances #-}+module Smerdyakov.Internal.Class where++import Data.Proxy (Proxy(Proxy))+import Data.Coerce (coerce)++import Smerdyakov.Internal.FreeIO++-- | An instance of the @Gives@ class says how to generate that target.+--+-- As a general rule, you will only write instances for @Gives@, and never+-- write a function with a @Gives@ constraint. If you need something, say that+-- you 'Needs' it.+--+-- >  make                 | smerdyakov+-- > ----------------------+---------------------------------------------------+-- > target: requirement   | instance (Needs Requirement) => Gives Target where+-- >    action             |    give = action+class Gives a where+    give :: Action a++-- | @make@ gathers, recursively, all the actions needed to fulfill a+-- requirement or target. The 'Action' can then be run with 'interpretIO', or+-- inspected.+make :: forall a proxy r. Gives a => proxy a -> (Needs a => Action r) -> Action r+make _ f = unmake (Proxy :: Proxy a) f++-- We can't have @Gives@ be a superclass of @Needs'@ and still have+-- the representational type role, so we defined the @Needs@ type+-- synonym instead.+class Needs' a++-- | Use @Needs@ to describe a requirement or assumption.+type Needs a = (Needs' a, Gives a)++newtype Wrap b r = Wrap { unWrap :: Needs' b => r }++newtype Make e = Make e+instance Needs' (Make e)++type role Needs' representational++coerceWrap :: Wrap e a -> Wrap (Make e) a+coerceWrap = coerce++unmake :: proxy e -> (Needs' e => a) -> a+unmake _ = unWrap . coerceWrap . Wrap
+ src/Smerdyakov/Internal/FreeIO.hs view
@@ -0,0 +1,70 @@+module Smerdyakov.Internal.FreeIO where++import Data.Monoid ((<>))+import Control.Monad.Catch+import Control.Monad.IO.Class+import GHC.Generics (Generic)+import System.Exit (ExitCode(..))+import System.Process (readCreateProcessWithExitCode, shell)+import System.IO+import Control.Monad.Free+++-- I no longer remember why I cared enough to have a free monad here...+--+-- | Free monad with IO actions that are allowed in defining @give@.+--+-- You are quite likely to hit limitations; if so, send a PR adding new+-- constructors and helpers!+data ActionF e x+  = Shell String (ExitCode -> String -> String -> x)+  | OpenFile FilePath IOMode (Handle -> x)+  | HClose Handle x+  | Throw e+  deriving (Functor, Generic)+++-- | An error that can be thrown in the 'Action' monad.+data ActionError+  = ExpectationFailure String+  deriving (Eq, Show, Read, Generic)++instance Exception ActionError++type Action = Free (ActionF ActionError)++-- | Runs the shell command, returning the exit code, stdout, and stderr.+shellA :: String -> Action (ExitCode, String, String)+shellA cmd = liftF $ Shell cmd (,,)++throwA :: ActionError -> Action a+throwA = liftF . Throw++-- | Like 'shellA', but calls @throwA@ with stderr in case the command exited+-- unsucessfully, and otherwise returns just stdout.+shellWithErrA :: String -> Action String+shellWithErrA cmd = do+  (e, out, err) <- shellA cmd+  case e of+    ExitFailure _ -> throwA . ExpectationFailure+                   $ "Process exited non-zero: " <> err+    ExitSuccess   -> return out++-- | Like 'openFile', but for 'Action'.+openFileA :: FilePath -> IOMode -> Action Handle+openFileA file mode = liftF $ OpenFile file mode id++-- | Like 'hClose', but for 'Action'+hCloseA :: Handle -> Action ()+hCloseA hdl = liftF $ HClose hdl ()++-- | Interpret an 'Action' in a 'MonadIO'.+interpretIO :: (MonadIO m, MonadThrow m) => Action a -> m a+interpretIO (Pure a) = return a+interpretIO (Free v) = case v of+  Shell cmd r -> do+    (a,b,c) <- liftIO $ readCreateProcessWithExitCode (shell cmd) ""+    interpretIO $ r a b c+  OpenFile fp mode r -> liftIO (openFile fp mode) >>= interpretIO . r+  HClose hdl r -> liftIO (hClose hdl) >> interpretIO r+  Throw e -> throwM e
+ src/Smerdyakov/System.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE CPP #-}+module Smerdyakov.System+  {-# WARNING "This is for me, not you." #-}+  where++import Data.Monoid ((<>))+import Control.Monad+import GHC.TypeLits+import GHC.Generics (Generic)+import Data.String (IsString(..))+import System.Exit (ExitCode(..))++import Smerdyakov.Internal.Class+import Smerdyakov.Internal.FreeIO++data Executable (s :: Symbol) = Executable String+  deriving (Eq, Show, Read, Generic)++data Sudo = Sudo+  deriving (Eq, Show, Read, Generic)++instance Gives Sudo where+  give = do+    -- This is not ideal, since attempts to sudo are logged and may result in+    -- warnings+    (exitStatus, _, _) <- shellA "sudo -n true"+    case exitStatus of+      ExitFailure _ -> throwA $ ExpectationFailure "Need sudo"+      ExitSuccess   -> return Sudo++instance Gives KnownOS where+  give = do+    uname <- shellWithErrA "uname"+    case uname of+      "Darwin" -> return OSXOS+      "Linux"  -> do+        x <- shellWithErrA "lsb_release -is"+        case x of+          "Ubuntu" -> return UbuntuOS+          "Debian" -> return DebianOS+          "Arch"   -> return ArchOS+          d        -> throwA . ExpectationFailure $ "Unknown distro: " <> d+      d        -> throwA . ExpectationFailure $ "Unknown distro: " <> d++instance (Needs KnownOS, Needs Sudo) => Gives (Executable "ack") where+  give = do+    Sudo <- give+    getPackage "ack-grep"+    return $ Executable "ack-grep"+++data PackageDetails+  = PackageDetails+  { homebrew :: String+  , aptGet   :: String+  , pacman   :: String+  } deriving (Eq, Show, Read, Generic)++getPackage :: (Needs KnownOS) => PackageDetails -> Action ()+getPackage deets = do+  os <- give+  let run = void . shellWithErrA+  case os of+    OSXOS    -> run $ "brew install " <> homebrew deets+    UbuntuOS -> give >>= \Sudo -> run $ "sudo apt-get install " <> aptGet deets+    DebianOS -> give >>= \Sudo -> run $ "sudo apt-get install " <> aptGet deets+    ArchOS   -> give >>= \Sudo -> run $ "pacman -S " <> pacman deets+++instance IsString PackageDetails where+  fromString s = PackageDetails s s s+++-- * Operating systems++++data KnownOS+  = DebianOS+  | ArchOS+  | UbuntuOS+  | OSXOS+  deriving (Eq, Show, Read, Generic)++{-+data Debian = Debian+data Arch = Arch+data OSX = OSX+data Linux = Linux+data Homebrew+type family PackageManagerNeeds a where+  PackageManagerNeeds Debian = ()+  PackageManagerNeeds Arch   = ()+  PackageManagerNeeds OSX    = Homebrew+-- This function generates a @Gives@ declaration with the OS and distribution+-- of the machine in which the program is compiled.+mkOSDec :: Q Dec+mkOSDec = do+  [d| instance Gives $osT where give = return $osC |]+  [d| hostOs :: HostOS ; hostOS = $hos |]+  -}
+ test/Doctest.hs view
@@ -0,0 +1,27 @@++module Main (main) where++-- Runs doctest on all files in "src" dir. Assumes:+--   (a) You are using hpack+--   (b) The top-level "default-extensions" are the only extensions besides the+--   ones in the files.++import System.FilePath.Glob (glob)+import Test.DocTest (doctest)+import Data.Yaml++newtype Exts = Exts { getExts :: [String] }+  deriving (Eq, Show, Read)++instance FromJSON Exts where+  parseJSON (Object v) = Exts <$> v .: "default-extensions"+  parseJSON _ = fail "expecting object"++main :: IO ()+main = do+  hpack' <- decodeFile "package.yaml"+  hpack <- case hpack' of+    Nothing -> return $ Exts []+    Just v  -> return v+  files <- glob "src/**/*.hs"+  doctest $ files ++ fmap ("-X" ++) (getExts hpack)
+ test/SmerdyakovSpec.hs view
@@ -0,0 +1,37 @@+module SmerdyakovSpec (spec) where++import Smerdyakov+import Smerdyakov.System+import Test.Hspec++spec :: Spec+spec = do++  describe "sudo" $ do++    it "fails if there is no sudo" $ do+      interpretIO (give :: Action Sudo) `shouldThrow`+        \e -> e == ExpectationFailure "Need sudo"++  describe "Action" $ do++    it "allows throwing exceptions" $ do+      let e = ExpectationFailure "hi"+      interpretIO (throwA e) `shouldThrow` anyException++  describe "make" $ do++    it "provides parameters" $+      interpretIO (make (Proxy :: Proxy String) $ make (Proxy :: Proxy Int) needy)+        `shouldReturn` True++instance Gives Int where+  give = return 5++instance Gives String where+  give = return "5"++++needy :: (Needs Int, Needs String) => Action Bool+needy = (\i s -> read s == (i :: Int)) <$> give <*> give
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}