ListT (empty) → 0.1.0.0

raw patch · 4 files changed

+143/−0 lines, 4 filesdep +basedep +transformerssetup-changed

Dependencies added: base, transformers

Files

• Control/Monad/Trans/List.hs +85/−0
• LICENSE +30/−0
• ListT.cabal +26/−0
• Setup.hs +2/−0

@@ -0,0 +1,85 @@+{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}+{-# OPTIONS_GHC -Wno-missing-signatures #-}++module Control.Monad.Trans.List (ListT (..), toListM) where++import Control.Applicative+import Control.Arrow+import Control.Monad+import Control.Monad.Fix+import Control.Monad.Trans.Class+import Data.Functor.Classes+import Data.List.NonEmpty (NonEmpty (..), intersperse)+import Data.Maybe+import Data.Monoid hiding ((<>))+import Data.Semigroup++newtype ListT m a = ListT { runListT :: m (Maybe (a, ListT m a)) }+  deriving (Functor, Foldable, Traversable)++toListM :: Monad m => ListT m a -> m [a]+toListM (ListT xm) = xm >>= \ case Nothing -> pure []+                                   Just (x, xs) -> (x:) <$> toListM xs++instance MonadTrans ListT where lift = ListT . fmap (Just . flip (,) empty)++instance Eq1 m => Eq1 (ListT m) where+    liftEq (==) (ListT x) (ListT y) = (liftEq . liftEq) (\ (x, xs) (y, ys) -> x == y && liftEq (==) xs ys) x y++instance Ord1 m => Ord1 (ListT m) where+    liftCompare cmp (ListT x) (ListT y) = (liftCompare . liftCompare) (\ (x, xs) (y, ys) -> x `cmp` y <> liftCompare cmp xs ys) x y++instance Show1 m => Show1 (ListT m) where+    liftShowsPrec sp sl n (ListT x) = fst (show1Methods sp sl) n x+    liftShowList sp sl = snd (show1Methods sp sl) . fmap runListT++show1Methods sp sl =+    (l . l) (pure f,+             list id $+             between '[' ']' . appEndo . intercalate (Endo (", " ++)) . fmap (Endo . f))+  where l :: Show1 f => (Int -> a -> ShowS, [a] -> ShowS) -> (Int -> f a -> ShowS, [f a] -> ShowS)+        l (sp, sl) = (liftShowsPrec sp sl, liftShowList sp sl)++        between :: a -> a -> ([a] -> [a]) -> [a] -> [a]+        between x y f = (:) x . f . (:) y++        f (x, xs) = between '(' ')' $ sp 0 x . (++) ", " . liftShowsPrec sp sl 0 xs++instance (Eq a, Eq1 m) => Eq (ListT m a) where (==) = liftEq (==)+instance (Ord a, Ord1 m) => Ord (ListT m a) where compare = liftCompare compare+instance (Show a, Show1 m) => Show (ListT m a) where+    showsPrec = liftShowsPrec showsPrec showList+    showList = liftShowList showsPrec showList++instance Monad m => Applicative (ListT m) where+    pure x = ListT . pure . Just $ (x, ListT (pure Nothing))+    (<*>) = ap++instance Monad m => Alternative (ListT m) where+    empty = (ListT . pure) Nothing+    ListT xm <|> ys = ListT $ xm >>= \ case+        Nothing -> runListT ys+        Just (x, xs) -> (pure . Just) (x, xs <|> ys)++instance Monad m => Monad (ListT m) where+    xm >>= f = join (f <$> xm)+      where join (ListT xm) = ListT $ xm >>= \ case+                Nothing -> pure Nothing+                Just (ListT ym, xss) -> ym >>= \ case+                    Nothing -> runListT (join xss)+                    Just (y, ys) -> (pure . Just) (y, ys <|> join xss)++instance Monad m => MonadPlus (ListT m)++instance MonadFix m => MonadFix (ListT m) where+    mfix f = ListT $ (flip fmap . mfix) (runListT . f . fst . fromJust) . fmap $+             id *** (pure . mfix $+                     ListT <<< runListT . f >=> \ case Just (_, xs) -> runListT xs+                                                       Nothing -> error "Nothing")++intercalate :: Semigroup a => a -> NonEmpty a -> a+intercalate a = sconcat . intersperse a++list :: b -> (NonEmpty a -> b) -> [a] -> b+list x _ [] = x+list _ f (x:xs) = f (x:|xs)

@@ -0,0 +1,30 @@+Copyright (c) 2017, M Farkas-Dyck++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 M Farkas-Dyck 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.

@@ -0,0 +1,26 @@+name:                ListT+version:             0.1.0.0+synopsis:            List transformer+-- description:         +license:             BSD3+license-file:        LICENSE+author:              M Farkas-Dyck+maintainer:          m.farkasdyck@gmail.com+-- copyright:           +category:            Control+build-type:          Simple+--extra-source-files:  +cabal-version:       >=1.10+tested-with:         GHC ==8.0.2,+                     GHC ==8.2.1++library+  exposed-modules:     Control.Monad.Trans.List+  -- other-modules:       +  -- other-extensions:    +  build-depends:       base >=4.9 && <5+                     , transformers+  -- hs-source-dirs:      +  default-language:    Haskell2010+  default-extensions:  LambdaCase+  ghc-options:         -Wall -Wno-name-shadowing

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain