binoculars-ng/src/Hkl/Orphan.hs

   1 {-# LANGUAGE FlexibleInstances #-}
   2 {-# LANGUAGE OverloadedStrings #-}
   3 {-# LANGUAGE TemplateHaskell   #-}
   4
   5 {-# OPTIONS_GHC -fno-warn-orphans #-}
   6
   7 module Hkl.Orphan where
   8
   9 import           Data.Aeson            (FromJSON (..), ToJSON (..), Value (..))
  10 import           Data.ByteString.Char8 (ByteString)
  11 import           Data.Text.Encoding    (decodeUtf8, encodeUtf8)
  12 import           Foreign.C             (CDouble (..))
  13 import           Foreign.Storable      (Storable)
  14 import           GHC.Base              (Alternative (..))
  15 import           Path                  (Abs, Dir, Path, mkAbsDir)
  16 import           Test.QuickCheck       (Arbitrary (..), elements)
  17
  18 import           Prelude               hiding (unwords)
  19
  20 import           Hkl.C.Binoculars
  21 import           Hkl.Repa
  22
  23 ---------------
  24 -- Arbitrary --
  25 ---------------
  26
  27 instance Arbitrary (Path Abs Dir) where
  28   arbitrary = pure $(mkAbsDir "/toto")
  29
  30 instance Arbitrary HklBinocularsSurfaceOrientationEnum where
  31   arbitrary = elements ([minBound .. maxBound] :: [HklBinocularsSurfaceOrientationEnum])
  32
  33 instance Arbitrary HklBinocularsQCustomSubProjectionEnum where
  34   arbitrary = elements ([minBound .. maxBound] :: [HklBinocularsQCustomSubProjectionEnum])
  35
  36 -----------------
  37 -- From/ToJSON --
  38 -----------------
  39
  40 instance ToJSON ByteString where
  41     toJSON = String . decodeUtf8
  42     {-# INLINE toJSON #-}
  43
  44 instance FromJSON ByteString where
  45     parseJSON (String t) = pure . encodeUtf8 $ t
  46     parseJSON _          = GHC.Base.empty
  47     {-# INLINE parseJSON #-}
  48
  49 instance ToJSON CDouble where
  50     toJSON (CDouble d) = toJSON d
  51
  52 instance FromJSON CDouble where
  53     parseJSON = parseJSON
  54     {-# INLINE parseJSON #-}
  55
  56 ----------
  57 -- Show --
  58 ----------
  59
  60 instance (Shape sh, Storable e) => Show (Array F sh e) where
  61     show = showShape . extent