call-stack (empty) → 0.1.0

raw patch · 9 files changed

+222/−0 lines, 9 filesdep +basedep +call-stackdep +nanospecsetup-changed

Dependencies added: base, call-stack, nanospec

Files

• LICENSE +19/−0
• Setup.lhs +3/−0
• call-stack.cabal +48/−0
• src/Data/CallStack.hs +37/−0
• src/Data/SrcLoc.hs +18/−0
• test/Data/CallStackSpec.hs +37/−0
• test/Example.hs +14/−0
• test/Spec.hs +12/−0
• test/Util.hs +34/−0

@@ -0,0 +1,19 @@+Copyright (c) 2016 Simon Hengel <sol@typeful.net>++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.

@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain

@@ -0,0 +1,48 @@+-- This file has been generated from package.yaml by hpack version 0.15.0.+--+-- see: https://github.com/sol/hpack++name:           call-stack+version:        0.1.0+synopsis:       Use GHC call-stacks in a backward compatible way+category:       Data+homepage:       https://github.com/sol/call-stack#readme+bug-reports:    https://github.com/sol/call-stack/issues+maintainer:     Simon Hengel <sol@typeful.net>+license:        MIT+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++source-repository head+  type: git+  location: https://github.com/sol/call-stack++library+  hs-source-dirs:+      src+  ghc-options: -Wall+  build-depends:+      base >= 4.5.0.0 && < 5+  exposed-modules:+      Data.CallStack+  other-modules:+      Data.SrcLoc+      Paths_call_stack+  default-language: Haskell2010++test-suite spec+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test+  ghc-options: -Wall+  build-depends:+      base >= 4.5.0.0 && < 5+    , nanospec+    , call-stack+  other-modules:+      Data.CallStackSpec+      Example+      Util+  default-language: Haskell2010

@@ -0,0 +1,37 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ImplicitParams #-}++module Data.CallStack (+  HasCallStack+, CallStack+, SrcLoc(..)+, callStack+) where++import Data.SrcLoc++#if MIN_VERSION_base(4,8,1)+import qualified GHC.Stack as GHC+#endif++#if MIN_VERSION_base(4,9,0)+import           GHC.Stack (HasCallStack)+#elif MIN_VERSION_base(4,8,1)+type HasCallStack = (?callStack :: GHC.CallStack)+#else+import GHC.Exts (Constraint)+type HasCallStack = (() :: Constraint)+#endif++type CallStack = [(String, SrcLoc)]++callStack :: HasCallStack => CallStack+#if MIN_VERSION_base(4,9,0)+callStack = drop 1 $ GHC.getCallStack GHC.callStack+#elif MIN_VERSION_base(4,8,1)+callStack = drop 2 $ GHC.getCallStack ?callStack+#else+callStack = []+#endif

@@ -0,0 +1,18 @@+{-# LANGUAGE CPP #-}+module Data.SrcLoc (SrcLoc(..)) where++#if MIN_VERSION_base(4,9,0)+import           GHC.Stack (SrcLoc(..))+#elif MIN_VERSION_base(4,8,1)+import           GHC.SrcLoc (SrcLoc(..))+#else+data SrcLoc = SrcLoc {+  srcLocPackage :: String+, srcLocModule :: String+, srcLocFile :: String+, srcLocStartLine :: Int+, srcLocStartCol :: Int+, srcLocEndLine :: Int+, srcLocEndCol :: Int+} deriving (Eq, Show)+#endif

@@ -0,0 +1,37 @@+{-# LANGUAGE CPP #-}+module Data.CallStackSpec (spec) where++import           Test.Hspec+import           Util+import           Example++spec :: Spec+spec = do+  describe "callStack" $ do+    it "returns the call stack" $ do+      mapLocations test `shouldBe` [+#if MIN_VERSION_base(4,8,1)+          ("bar"+          , SrcLoc {+              srcLocPackage = "main"+            , srcLocModule = "Example"+            , srcLocFile = "test/Example.hs"+            , srcLocStartLine = 11+            , srcLocStartCol = 7+            , srcLocEndLine = 11+            , srcLocEndCol = 10+            }+          )+        , ("foo"+          , SrcLoc {+              srcLocPackage = "main"+            , srcLocModule = "Example"+            , srcLocFile = "test/Example.hs"+            , srcLocStartLine = 8+            , srcLocStartCol = 8+            , srcLocEndLine = 8+            , srcLocEndCol = 11+            }+          )+#endif+        ]

@@ -0,0 +1,14 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ConstraintKinds #-}+module Example where++import           Data.CallStack++test :: CallStack+test = foo++foo :: HasCallStack => CallStack+foo = bar++bar :: HasCallStack => CallStack+bar = callStack

@@ -0,0 +1,12 @@+module Main where++import Test.Hspec++import qualified Data.CallStackSpec++spec :: Spec+spec = do+  describe "Data.CallStack" Data.CallStackSpec.spec++main :: IO ()+main = hspec spec

@@ -0,0 +1,34 @@+{-# LANGUAGE CPP #-}+module Util (SrcLoc(..), mapLocations) where++#if MIN_VERSION_base(4,8,1) && !MIN_VERSION_base(4,9,0)+import qualified GHC.SrcLoc as GHC+import           Data.CallStack hiding (SrcLoc(..))++data SrcLoc = SrcLoc {+  srcLocPackage :: String+, srcLocModule :: String+, srcLocFile :: String+, srcLocStartLine :: Int+, srcLocStartCol :: Int+, srcLocEndLine :: Int+, srcLocEndCol :: Int+} deriving (Eq, Show)++mapLocations :: CallStack -> [(String, SrcLoc)]+mapLocations = map (fmap mapLocation)+  where+    mapLocation location = SrcLoc {+      srcLocPackage = GHC.srcLocPackage location+    , srcLocModule = GHC.srcLocModule location+    , srcLocFile = GHC.srcLocFile location+    , srcLocStartLine = GHC.srcLocStartLine location+    , srcLocStartCol = GHC.srcLocStartCol location+    , srcLocEndLine = GHC.srcLocEndLine location+    , srcLocEndCol = GHC.srcLocEndCol location+    }+#else+import           Data.CallStack+mapLocations :: CallStack -> CallStack+mapLocations = id+#endif