Initial commit

.devcontainer/Dockerfile

@@ -0,0 +1,12 @@
+FROM haskell:8.10.2
+
+ARG LOGIN=haskell
+ARG UID=1000
+ARG GID=$UID
+
+RUN \
+  groupadd --gid "$GID" "$LOGIN" && \
+  useradd --create-home --gid "$GID" --uid "$UID" "$LOGIN" && \
+  chsh --shell "$( which bash )" "$LOGIN"
+
+USER $LOGIN

.devcontainer/devcontainer.json

@@ -0,0 +1,12 @@
+{
+  "build": {
+    "dockerfile": "Dockerfile"
+  },
+  "containerUser": "haskell",
+  "extensions": [
+    "taylorfausak.purple-yolk"
+  ],
+  "settings": {
+    "purple-yolk.ghci.command": "cabal repl"
+  }
+}

.gitignore

@@ -0,0 +1,2 @@
+/.stack-work/
+/dist-newstyle/

LICENSE.txt

@@ -0,0 +1,13 @@
+Copyright 2020 Taylor Fausak
+
+Permission to use, copy, modify, and/or distribute this software for any
+purpose with or without fee is hereby granted, provided that the above
+copyright notice and this permission notice appear in all copies.
+
+THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH
+REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT,
+INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
+LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
+OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
+PERFORMANCE OF THIS SOFTWARE.

from.cabal

@@ -0,0 +1,40 @@
+cabal-version: >= 1.8
+
+name: from
+version: 0.0.0.0
+synopsis: Convert from one type to another.
+description:
+  From converts from one type to another.
+
+build-type: Simple
+category: Data
+license-file: LICENSE.txt
+license: ISC
+maintainer: Taylor Fausak
+
+source-repository head
+  location: https://github.com/tfausak/from
+  type: git
+
+library
+  build-depends:
+    base >= 4.14.1 && < 4.15
+    , bytestring >= 0.10.10 && < 0.11
+    , containers >= 0.6.2 && < 0.7
+    , text >= 1.2.3 && < 1.3
+  exposed-modules: From
+  ghc-options:
+    -Weverything
+    -Wno-implicit-prelude
+    -Wno-missing-safe-haskell-mode
+    -Wno-prepositive-qualified-module
+    -Wno-safe
+    -Wno-unsafe
+  hs-source-dirs: src/lib
+
+test-suite test
+  build-depends: base, from
+  ghc-options: -rtsopts -threaded
+  hs-source-dirs: src/test
+  main-is: Main.hs
+  type: exitcode-stdio-1.0

src/lib/From.hs

@@ -0,0 +1,77 @@
+{-# language AllowAmbiguousTypes #-}
+{-# language DefaultSignatures #-}
+{-# language FlexibleInstances #-}
+{-# language MultiParamTypeClasses #-}
+{-# language ScopedTypeVariables #-}
+
+module From (From(from), into, via) where
+
+import qualified Data.ByteString as ByteString
+import qualified Data.ByteString.Lazy as LazyByteString
+import qualified Data.Coerce as Coerce
+import qualified Data.Foldable as Foldable
+import qualified Data.Int as Int
+import qualified Data.List.NonEmpty as NonEmpty
+import qualified Data.Map as Map
+import qualified Data.Sequence as Seq
+import qualified Data.Set as Set
+import qualified Data.Text as Text
+import qualified Data.Text.Lazy as LazyText
+import qualified Data.Tuple as Tuple
+import qualified Data.Void as Void
+import qualified Data.Word as Word
+import qualified Numeric.Natural as Natural
+
+class From a b where
+  from :: a -> b
+  default from :: Coerce.Coercible a b => a -> b
+  from = Coerce.coerce
+
+into :: forall b a . From a b => a -> b
+into = from
+
+via :: forall b a c . (From a b, From b c) => a -> c
+via = from . (\ x -> x :: b) . from
+
+instance From (a, b) (b, a) where from = Tuple.swap
+instance From (a, x) a where from = fst
+instance From (Map.Map k v) [(k, v)] where from = Map.assocs
+instance From (NonEmpty.NonEmpty a) [a] where from = NonEmpty.toList
+instance From (Seq.Seq a) [a] where from = Foldable.toList
+instance From (Set.Set a) [a] where from = Set.toList
+instance From (x, a) a where from = snd
+instance From [a] (Seq.Seq a) where from = Seq.fromList
+instance From [Word.Word8] ByteString.ByteString where from = ByteString.pack
+instance From a (Either a x) where from = Left
+instance From a (Either x a) where from = Right
+instance From a (Maybe a) where from = Just
+instance From a (x -> a) where from = const
+instance From a [a] where from = pure
+instance From a a where from = id
+instance From Bool Int where from = fromEnum
+instance From ByteString.ByteString [Word.Word8] where from = ByteString.unpack
+instance From ByteString.ByteString LazyByteString.ByteString where from = LazyByteString.fromStrict
+instance From Float Double where from = realToFrac
+instance From Int Integer where from = fromIntegral
+instance From Int.Int16 Int where from = fromIntegral
+instance From Int.Int16 Int.Int32 where from = fromIntegral
+instance From Int.Int32 Int.Int64 where from = fromIntegral
+instance From Int.Int8 Int where from = fromIntegral
+instance From Int.Int8 Int.Int16 where from = fromIntegral
+instance From Integer Rational where from = fromIntegral
+instance From LazyByteString.ByteString ByteString.ByteString where from = LazyByteString.toStrict
+instance From LazyText.Text Text.Text where from = LazyText.toStrict
+instance From Natural.Natural Integer where from = fromIntegral
+instance From String Text.Text where from = Text.pack
+instance From Text.Text LazyText.Text where from = LazyText.fromStrict
+instance From Text.Text String where from = Text.unpack
+instance From Void.Void a where from = Void.absurd
+instance From Word Integer where from = fromIntegral
+instance From Word Rational where from = fromIntegral
+instance From Word.Word16 Word where from = fromIntegral
+instance From Word.Word16 Word.Word32 where from = fromIntegral
+instance From Word.Word32 Word.Word64 where from = fromIntegral
+instance From Word.Word8 Word where from = fromIntegral
+instance From Word.Word8 Word.Word16 where from = fromIntegral
+instance Ord a => From [a] (Set.Set a) where from = Set.fromList
+instance Ord k => From [(k, v)] (Map.Map k v) where from = Map.fromList

src/test/Main.hs

@@ -0,0 +1,33 @@
+{-# language TypeApplications #-}
+
+module Main (main) where
+
+import qualified Control.Exception as Exception
+import qualified Control.Monad as Monad
+import qualified Data.Typeable as Typeable
+import From (from, into, via)
+import qualified GHC.Stack as Stack
+
+main :: Stack.HasCallStack => IO ()
+main = do
+  from 'a' ==> 'a'
+  into 'a' ==> 'a'
+  via @Char 'a' ==> 'a'
+
+  into @Int False ==> 0
+  into @Int True ==> 1
+
+(==>) :: (Stack.HasCallStack, Eq a, Show a, Typeable.Typeable a) => a -> a -> IO ()
+actual ==> expected = Monad.when (actual /= expected) . Exception.throwIO $
+  Failure expected actual Stack.callStack
+
+data Failure a = Failure a a Stack.CallStack
+
+instance Show a => Show (Failure a) where
+  show (Failure expected actual callStack) =
+    "Failure!\n"
+    <> "  expected: " <> show expected <> "\n"
+    <> "  but got:  " <> show actual <> "\n"
+    <> Stack.prettyCallStack callStack
+
+instance (Show a, Typeable.Typeable a) => Exception.Exception (Failure a)

stack.yaml

@@ -0,0 +1 @@
+resolver: ghc-8.10.2