Compare commits

...

12 Commits

Author SHA1 Message Date
voidlizard e2215bd022 backported changes from hbs2 2025-01-22 14:18:54 +03:00
Dmitry Zuikov 09c70e6694 quasiquotes 2025-01-09 15:14:27 +03:00
voidlizard ca2e824cdf suckless-script extension 2024-11-24 12:22:32 +03:00
Sergey Ivanov ff6f1a2e05 Fix `Variable not in scope: replicateM_` 2024-09-24 21:59:58 +04:00
Sergey Ivanov be80eabc1d flake.lock: Update
Flake lock file updates:

• Updated input 'fuzzy':
    'git+http://git.hbs2.net/GmcLB9gEPT4tbx9eyQiECwsu8oPyEh6qKEpQDtyBWVPA?rev=831879978213a1aed15ac70aa116c33bcbe964b8&tag=0.1.3.1' (2024-05-17)
  → 'git+http://git.hbs2.net/GmcLB9gEPT4tbx9eyQiECwsu8oPyEh6qKEpQDtyBWVPA?ref=refs/heads/master&rev=a834b152e29d632c816eefe117036e5d9330bd03' (2024-09-24)
• Updated input 'fuzzy/nixpkgs':
    'github:NixOS/nixpkgs/442d407992384ed9c0e6d352de75b69079904e4e' (2024-02-09)
  → 'github:NixOS/nixpkgs/568bfef547c14ca438c56a0bece08b8bb2b71a9c' (2024-09-23)
• Updated input 'haskell-flake-utils':
    'github:ivanovs-4/haskell-flake-utils/896219e5bde6efac72198550454e9dd9b5ed9ac9' (2022-12-30)
  → 'github:ivanovs-4/haskell-flake-utils/3cbdc5d6093e8b4464ae64097e0c8c61e4414ff2' (2024-02-13)
• Updated input 'nixpkgs':
    'github:NixOS/nixpkgs/442d407992384ed9c0e6d352de75b69079904e4e' (2024-02-09)
  → 'github:NixOS/nixpkgs/568bfef547c14ca438c56a0bece08b8bb2b71a9c' (2024-09-23)
2024-09-24 21:58:34 +04:00
Dmitry Zuikov b6c5087312 version bump 2024-08-27 09:29:15 +03:00
Dmitry Zuikov c63f7c366f fixed dependency 2024-08-27 09:27:37 +03:00
Dmitry Zuikov 6802f96076 Data.Config.Suckless.Script 2024-08-22 14:07:53 +03:00
Dmitry Zuikov 41830ea2f2 fix 2024-05-17 07:21:47 +03:00
Dmitry Zuikov 4fe7ac911a version bump 2024-05-17 06:48:39 +03:00
Dmitry Zuikov 1724499061 fix 2024-05-17 06:44:21 +03:00
Dmitry Zuikov 1f3cc7e4f9 Data instance 2024-05-17 06:23:23 +03:00
11 changed files with 1664 additions and 40 deletions

View File

@ -36,19 +36,18 @@
"nixpkgs": "nixpkgs"
},
"locked": {
"lastModified": 1715856223,
"narHash": "sha256-Q9I6YbvzGuV9yHtxGxxU10LMQf9AdcsecSszPT7PDuc=",
"ref": "sexp-parser",
"rev": "b0a7f96d6569d16b0d27c2f9477d94e5ee39df66",
"revCount": 62,
"lastModified": 1737544489,
"narHash": "sha256-prTXYnEgUIIe5nMaE3rC9g6Ej3qtAKudd8T/QA+eyW8=",
"ref": "refs/heads/master",
"rev": "9e41a735a8bdb02b2b5c405341d8b3b98242f021",
"revCount": 46,
"type": "git",
"url": "http://git.hbs2/GmcLB9gEPT4tbx9eyQiECwsu8oPyEh6qKEpQDtyBWVPA"
"url": "http://git.hbs2.net/GmcLB9gEPT4tbx9eyQiECwsu8oPyEh6qKEpQDtyBWVPA"
},
"original": {
"ref": "sexp-parser",
"rev": "b0a7f96d6569d16b0d27c2f9477d94e5ee39df66",
"rev": "9e41a735a8bdb02b2b5c405341d8b3b98242f021",
"type": "git",
"url": "http://git.hbs2/GmcLB9gEPT4tbx9eyQiECwsu8oPyEh6qKEpQDtyBWVPA"
"url": "http://git.hbs2.net/GmcLB9gEPT4tbx9eyQiECwsu8oPyEh6qKEpQDtyBWVPA"
}
},
"haskell-flake-utils": {
@ -74,11 +73,11 @@
"flake-utils": "flake-utils_2"
},
"locked": {
"lastModified": 1672412555,
"narHash": "sha256-Kaa8F7nQFR3KuS6Y9WRUxeJeZlp6CCubyrRfmiEsW4k=",
"lastModified": 1707809372,
"narHash": "sha256-wfTL9PlCSOqSSyU4eenFFI7pHrV21gba4GEILnI4nAU=",
"owner": "ivanovs-4",
"repo": "haskell-flake-utils",
"rev": "896219e5bde6efac72198550454e9dd9b5ed9ac9",
"rev": "3cbdc5d6093e8b4464ae64097e0c8c61e4414ff2",
"type": "github"
},
"original": {
@ -89,33 +88,33 @@
},
"nixpkgs": {
"locked": {
"lastModified": 1707451808,
"narHash": "sha256-UwDBUNHNRsYKFJzyTMVMTF5qS4xeJlWoeyJf+6vvamU=",
"lastModified": 1727089097,
"narHash": "sha256-ZMHMThPsthhUREwDebXw7GX45bJnBCVbfnH1g5iuSPc=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "442d407992384ed9c0e6d352de75b69079904e4e",
"rev": "568bfef547c14ca438c56a0bece08b8bb2b71a9c",
"type": "github"
},
"original": {
"owner": "NixOS",
"ref": "nixpkgs-unstable",
"repo": "nixpkgs",
"rev": "442d407992384ed9c0e6d352de75b69079904e4e",
"type": "github"
}
},
"nixpkgs_2": {
"locked": {
"lastModified": 1707451808,
"narHash": "sha256-UwDBUNHNRsYKFJzyTMVMTF5qS4xeJlWoeyJf+6vvamU=",
"lastModified": 1727089097,
"narHash": "sha256-ZMHMThPsthhUREwDebXw7GX45bJnBCVbfnH1g5iuSPc=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "442d407992384ed9c0e6d352de75b69079904e4e",
"rev": "568bfef547c14ca438c56a0bece08b8bb2b71a9c",
"type": "github"
},
"original": {
"owner": "NixOS",
"ref": "nixpkgs-unstable",
"repo": "nixpkgs",
"rev": "442d407992384ed9c0e6d352de75b69079904e4e",
"type": "github"
}
},

View File

@ -2,12 +2,12 @@
description = "suckless-cong: sexp based configs";
inputs = {
nixpkgs.url = "github:NixOS/nixpkgs?rev=442d407992384ed9c0e6d352de75b69079904e4e";
nixpkgs.url = "github:NixOS/nixpkgs/nixpkgs-unstable";
haskell-flake-utils.url = "github:ivanovs-4/haskell-flake-utils";
fuzzy.url =
# "git+http://git.hbs2/GmcLB9gEPT4tbx9eyQiECwsu8oPyEh6qKEpQDtyBWVPA?ref=sexp-parser&rev=bd3a38904864d5cc333974e7b029412607b46871";
"git+http://git.hbs2/GmcLB9gEPT4tbx9eyQiECwsu8oPyEh6qKEpQDtyBWVPA?ref=sexp-parser&rev=b0a7f96d6569d16b0d27c2f9477d94e5ee39df66";
"git+http://git.hbs2.net/GmcLB9gEPT4tbx9eyQiECwsu8oPyEh6qKEpQDtyBWVPA?rev=9e41a735a8bdb02b2b5c405341d8b3b98242f021";
};

View File

@ -9,3 +9,4 @@ import Data.Config.Suckless.Syntax
import Data.Config.Suckless.Parse
import Data.Config.Suckless.KeyValue

View File

@ -0,0 +1,47 @@
{-# Language TypeOperators #-}
module Data.Config.Suckless.Almost.RPC where
import Data.Config.Suckless
import Control.Exception
import Control.Monad
import Control.Monad.IO.Class
import Data.ByteString.Lazy as LBS
import Data.ByteString.Lazy.Char8 as LBS8
import Data.Function
import Data.Text.Encoding.Error qualified as TE
import Data.Text.Encoding qualified as TE
import Data.Text qualified as T
import Data.Typeable
import Prettyprinter
import System.Process.Typed
data CallProcException =
CallProcException ExitCode
deriving (Show,Typeable)
instance Exception CallProcException
-- FIXME: to-suckless-script
callProc :: forall m . (MonadIO m)
=> FilePath
-> [String]
-> [Syntax C]
-> m [Syntax C]
callProc name params syn = do
let input = fmap (LBS.fromStrict . TE.encodeUtf8 . T.pack . show . pretty) syn
& LBS8.unlines
& byteStringInput
let what = proc name params & setStderr closed & setStdin input
(code, i, _) <- readProcess what
unless (code == ExitSuccess) do
liftIO $ throwIO (CallProcException code)
let s = TE.decodeUtf8With TE.lenientDecode (LBS.toStrict i)
parseTop s & either (liftIO . throwIO) pure

View File

@ -0,0 +1,74 @@
{-# Language UndecidableInstances #-}
{-# Language PatternSynonyms #-}
{-# Language RecordWildCards #-}
module Data.Config.Suckless.Script
( module Exported
, module Data.Config.Suckless.Script
) where
import Data.Config.Suckless as Exported
import Data.Config.Suckless.Script.Internal as Exported
import Control.Monad
import Control.Monad.Reader
import Data.HashMap.Strict qualified as HM
import Prettyprinter
import Prettyprinter.Render.Terminal
import Data.List qualified as List
import Data.Text qualified as Text
import Data.String
import UnliftIO
{- HLINT ignore "Functor law" -}
helpList :: MonadUnliftIO m => Bool -> Maybe String -> RunM c m ()
helpList hasDoc p = do
let match = maybe (const True) (Text.isPrefixOf . Text.pack) p
d <- ask >>= readTVarIO
let ks = [k | Id k <- List.sort (HM.keys d)
, match k
, docDefined (HM.lookup (Id k) d) || not hasDoc
]
display_ $ vcat (fmap pretty ks)
where
docDefined (Just (Bind (Just Man{..}) _)) | not manHidden = True
docDefined _ = False
helpEntry :: MonadUnliftIO m => Id -> RunM c m ()
helpEntry what = do
man <- ask >>= readTVarIO
<&> HM.lookup what
<&> maybe mzero bindMan
liftIO $ hPutDoc stdout (pretty man)
pattern HelpEntryBound :: forall {c}. Id -> [Syntax c]
pattern HelpEntryBound what <- [ListVal (SymbolVal "builtin:lambda" : SymbolVal what : _ )]
splitOpts :: [(Id,Int)]
-> [Syntax C]
-> ([Syntax C], [Syntax C])
splitOpts def opts' = flip fix (mempty, opts) $ \go -> \case
(acc, []) -> acc
( (o,a), r@(StringLike x) : rs ) -> do
case HM.lookup (fromString x) omap of
Nothing -> go ((o, a <> [r]), rs)
Just n -> do
let (w, rest) = List.splitAt n rs
let result = mkList @C ( r : w )
go ( (o <> [result], a), rest )
( (o,a), r : rs ) -> do
go ((o, a <> [r]), rs)
where
omap = HM.fromList [ (p, x) | (p,x) <- def ]
opts = opts'

View File

@ -0,0 +1,87 @@
{-# Language MultiWayIf #-}
module Data.Config.Suckless.Script.File where
import Data.Config.Suckless
import Data.Config.Suckless.Script.Internal
import Control.Monad
import Control.Monad.Trans.Class
import Control.Monad.Trans.Cont
import Data.Maybe
import Data.Either
import Data.Foldable
import System.Directory
import System.FilePath
import System.FilePattern
import Data.HashSet qualified as HS
import Prettyprinter
import Lens.Micro.Platform
import UnliftIO
import Control.Concurrent.STM qualified as STM
import Streaming.Prelude qualified as S
-- FIXME: skip-symlink
glob :: forall m . MonadIO m
=> [FilePattern] -- ^ search patterns
-> [FilePattern] -- ^ ignore patterns
-> FilePath -- ^ directory
-> (FilePath -> m Bool) -- ^ file action
-> m ()
glob pat ignore dir action = do
q <- newTQueueIO
void $ liftIO (async $ go q dir >> atomically (writeTQueue q Nothing))
fix $ \next -> do
atomically (readTQueue q) >>= \case
Nothing -> pure ()
Just x -> do
r <- action x
when r next
where
matches p f = or [ i ?== f | i <- p ]
skip p = or [ i ?== p | i <- ignore ]
go q f = do
isD <- doesDirectoryExist f
if not isD then do
isF <- doesFileExist f
when (isF && matches pat f && not (skip f)) do
atomically $ writeTQueue q (Just f)
else do
co' <- (try @_ @IOError $ listDirectory f)
<&> fromRight mempty
forConcurrently_ co' $ \x -> do
let p = normalise (f </> x)
unless (skip p) (go q p)
entries :: forall c m . ( IsContext c
, Exception (BadFormException c)
, MonadUnliftIO m)
=> MakeDictM c m ()
entries = do
entry $ bindMatch "glob" $ \syn -> do
(p,i,d) <- case syn of
[] -> pure (["**/*"], ["**/.*"], ".")
s@[StringLike d, ListVal (StringLikeList i) ] -> do
pure (i, [], d)
s@[StringLike d, ListVal (StringLikeList i), ListVal (StringLikeList e) ] -> do
pure (i, e, d)
_ -> throwIO (BadFormException @c nil)
r <- S.toList_ $ glob p i d $ \fn -> do
S.yield (mkStr @c fn) -- do
pure True
pure (mkList r)

File diff suppressed because it is too large Load Diff

View File

@ -2,39 +2,65 @@
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE PatternSynonyms #-}
{-# Language ViewPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RecordWildCards #-}
module Data.Config.Suckless.Syntax
( Syntax(..)
, Id(..)
, Literal(..)
, Opaque(..)
, HasContext
, C(..)
, Context(..)
, IsContext(..)
, IsLiteral(..)
, ByteStringSorts(..)
, mkOpaque
, isOpaqueOf
, fromOpaque
, fromOpaqueThrow
, isByteString
, SyntaxTypeError(..)
, pattern SymbolVal
, pattern ListVal
, pattern LitIntVal
, pattern LitStrVal
, pattern LitBoolVal
, pattern LitScientificVal
, pattern StringLike
, pattern TextLike
, pattern StringLikeList
, pattern Nil
, pattern OpaqueVal
)
where
import Data.Data
import Data.Dynamic
import Data.Kind
import Data.String
import Data.Text (Text)
import Data.Scientific
import GHC.Generics (Generic(..))
import Data.Maybe
-- import GHC.Generics( Fixity(..) )
-- import Data.Data as Data
import Data.Aeson
import Data.Aeson.Key
import Data.Aeson.KeyMap qualified as Aeson
import Data.Vector qualified as V
import Data.Traversable (forM)
import Data.Text qualified as Text
import Data.ByteString (ByteString)
import Data.ByteString.Lazy qualified as LBS
import Data.Function
import Data.Functor
import Control.Applicative
import Control.Exception
import Type.Reflection
import Control.Monad.IO.Class
import System.IO.Unsafe (unsafePerformIO)
import Data.IORef
import Data.Word
import Prettyprinter
@ -57,9 +83,55 @@ pattern LitBoolVal v <- Literal _ (LitBool v)
pattern ListVal :: [Syntax c] -> Syntax c
pattern ListVal v <- List _ v
stringLike :: Syntax c -> Maybe String
stringLike = \case
LitStrVal s -> Just $ Text.unpack s
SymbolVal (Id s) -> Just $ Text.unpack s
_ -> Nothing
textLike :: Syntax c -> Maybe Text
textLike = \case
LitStrVal s -> Just s
SymbolVal (Id s) -> Just s
x -> Nothing
stringLikeList :: [Syntax c] -> [String]
stringLikeList syn = [ stringLike s | s <- syn ] & takeWhile isJust & catMaybes
data ByteStringSorts = ByteStringLazy LBS.ByteString | ByteStringStrict ByteString
pattern StringLike :: forall {c} . String -> Syntax c
pattern StringLike e <- (stringLike -> Just e)
pattern TextLike :: forall {c} . Text -> Syntax c
pattern TextLike e <- (textLike -> Just e)
pattern StringLikeList :: forall {c} . [String] -> [Syntax c]
pattern StringLikeList e <- (stringLikeList -> e)
pattern Nil :: forall {c} . Syntax c
pattern Nil <- ListVal []
pattern OpaqueVal :: forall {c} . Opaque -> Syntax c
pattern OpaqueVal box <- OpaqueValue box
data family Context c :: Type
isOpaqueOf :: forall a c . (Typeable a, IsContext c) => Syntax c -> Maybe a
isOpaqueOf = \case
OpaqueValue box -> fromOpaque @a box
_ -> Nothing
isByteString :: Syntax c -> Maybe ByteStringSorts
isByteString = \case
OpaqueValue box -> do
let lbs = fromOpaque @LBS.ByteString box <&> ByteStringLazy
let bs = fromOpaque @ByteString box <&> ByteStringStrict
lbs <|> bs
_ -> Nothing
class IsContext c where
noContext :: Context c
@ -75,14 +147,71 @@ class IsLiteral a where
newtype Id =
Id Text
deriving newtype (IsString,Pretty)
deriving newtype (IsString,Pretty,Semigroup,Monoid)
deriving stock (Data,Generic,Show,Eq,Ord)
type ForOpaque a = (Typeable a, Eq a)
data Opaque = forall a. ForOpaque a =>
Opaque
{ opaqueProxy :: !(Proxy a)
, opaqueId :: !Word64
, opaqueRep :: !SomeTypeRep
, opaqueDyn :: !Dynamic
}
opaqueIdIORef :: IORef Word64
opaqueIdIORef = unsafePerformIO (newIORef 1)
{-# NOINLINE opaqueIdIORef #-}
mkOpaque :: forall c a m . (MonadIO m, ForOpaque a) => a -> m (Syntax c)
mkOpaque x = do
n <- liftIO $ atomicModifyIORef opaqueIdIORef (\n -> (succ n,n))
pure $ OpaqueValue $ Opaque (Proxy :: Proxy a) n (someTypeRep (Proxy :: Proxy a)) (toDyn x)
data SyntaxTypeError =
UnexpectedType String
deriving stock (Show,Typeable)
instance Exception SyntaxTypeError
fromOpaque :: forall a. Typeable a => Opaque -> Maybe a
fromOpaque (Opaque{..}) = fromDynamic opaqueDyn
fromOpaqueThrow :: forall a m . (MonadIO m, Typeable a) => String -> Opaque -> m a
fromOpaqueThrow s (Opaque{..}) = do
let o = fromDynamic @a opaqueDyn
liftIO $ maybe (throwIO (UnexpectedType s)) pure o
instance Eq Opaque where
(Opaque p1 _ t1 d1) == (Opaque _ _ t2 d2) =
t1 == t2 && unpack p1 d1 == unpack p1 d2
where
unpack :: forall a . (Typeable a) => Proxy a -> Dynamic -> Maybe a
unpack _ = fromDynamic @a
-- Partial Data implementation for Opaque
instance Data Opaque where
gfoldl _ z (Opaque{..}) = z (Opaque{..})
-- Can not be unfolded
gunfold _ z _ = z (Opaque (Proxy :: Proxy ()) 0 (someTypeRep (Proxy :: Proxy ())) (toDyn ()))
toConstr _ = opaqueConstr
dataTypeOf _ = opaqueDataType
opaqueConstr :: Constr
opaqueConstr = mkConstr opaqueDataType "Opaque" [] Prefix
opaqueDataType :: DataType
opaqueDataType = mkDataType "Opaque" [opaqueConstr]
data Literal =
LitStr Text
| LitInt Integer
| LitScientific Scientific
| LitBool Bool
| LitBool Bool
deriving stock (Eq,Ord,Data,Generic,Show)
instance IsLiteral Text where
@ -113,23 +242,24 @@ data Syntax c
= List (Context c) [Syntax c]
| Symbol (Context c) Id
| Literal (Context c) Literal
deriving stock (Generic)
| OpaqueValue Opaque
deriving stock (Generic,Typeable)
instance Eq (Syntax c) where
(==) (Literal _ a) (Literal _ b) = a == b
(==) (Symbol _ a) (Symbol _ b) = a == b
(==) (List _ a) (List _ b) = a == b
(==) (OpaqueValue a) (OpaqueValue b) = a == b
(==) _ _ = False
deriving instance (Data (Context ())) => Data (Syntax ())
-- deriving instance (Data (Context ())) => Data (Syntax ())
deriving instance (Data c, Data (Context c)) => Data (Syntax c)
instance Pretty (Syntax c) where
pretty (Literal _ ast) = pretty ast
pretty (Symbol _ s) = pretty s
pretty (List _ (x:xs)) = parens $ align $ sep ( fmap pretty (x:xs) )
pretty (List _ []) = parens mempty
pretty (OpaqueValue v) = "#opaque:" <> viaShow (opaqueRep v) <> ":" <> pretty (opaqueId v)
instance Pretty Literal where
pretty = \case
@ -148,6 +278,7 @@ instance ToJSON Literal where
toJSON (LitBool b) = Bool b
instance ToJSON (Syntax c) where
toJSON (OpaqueValue{}) = Null
toJSON (Symbol _ (Id "#nil")) = Null
toJSON (Symbol _ (Id s)) = String s
toJSON (Literal _ l) = toJSON l

View File

@ -1,6 +1,6 @@
cabal-version: 3.0
name: suckless-conf
version: 0.1.2.1
version: 0.1.2.9
-- synopsis:
-- description:
license: BSD-3-Clause
@ -65,24 +65,41 @@ library
, Data.Config.Suckless.Syntax
, Data.Config.Suckless.Parse
, Data.Config.Suckless.KeyValue
, Data.Config.Suckless.Script
, Data.Config.Suckless.Script.File
, Data.Config.Suckless.Almost.RPC
other-modules:
Data.Config.Suckless.Types
, Data.Config.Suckless.Parse.Fuzzy
, Data.Config.Suckless.Script.Internal
-- other-extensions:
build-depends: base
, aeson
, bytestring
, containers
, directory
, filepath
, filepattern
, fuzzy-parse >= 0.1.3.1
, hashable
, interpolatedstring-perl6
, microlens-platform
, mtl
, prettyprinter
, prettyprinter-ansi-terminal
, safe
, scientific
, streaming
, stm
, text
, vector
, time
, transformers
, typed-process
, unliftio
, unordered-containers
, fuzzy-parse >= 0.1.3.0
, vector
hs-source-dirs: lib
default-language: Haskell2010
@ -109,7 +126,7 @@ test-suite spec
, aeson
, scientific
, suckless-conf
, fuzzy-parse >= 0.1.3.0
, fuzzy-parse >= 0.1.3.1
, containers
, mtl
, text
@ -125,3 +142,4 @@ test-suite spec
, OverloadedStrings
, ScopedTypeVariables
, TypeApplications

View File

@ -60,21 +60,21 @@ spec = do
it "reads int" $ do
c <- readConfig [qc|1|] <&> toJSON
c `shouldBe` toJSON [1::Int]
c `shouldBe` toJSON [[1::Int]]
it "reads scientific" $ do
c <- readConfig [qc|1.00|] <&> toJSON
c `shouldBe` toJSON [1.00 :: Scientific]
c `shouldBe` toJSON [[1.00 :: Scientific]]
it "reads bool" $ do
t <- readConfig [qc|#t|] <&> toJSON . head
t `shouldBe` toJSON (Bool True)
t `shouldBe` toJSON [Bool True]
f <- readConfig [qc|#f|] <&> toJSON . head
f `shouldBe` toJSON (Bool False)
f `shouldBe` toJSON [Bool False]
it "reads string" $ do
s <- readConfig [qc|"somestring"|] <&> toJSON
s `shouldBe` toJSON ["somestring" :: String]
s `shouldBe` toJSON [["somestring" :: String]]
it "reads array" $ do
s <- readConfig [qc|(1 2 3 4)|] <&> toJSON . head

View File

@ -20,7 +20,6 @@ import qualified Data.Set as Set
import Prettyprinter
import Data.Aeson
import Text.InterpolatedString.Perl6 (qc,q)
import Control.Monad.Identity
import Test.Hspec